core layouts, remove hardcoded tag width

109aa88b06 showed the places were it was hardcoded
char-rename
Jon Harper 2017-01-03 17:56:29 +01:00 committed by John Benediktsson
parent 740c258b66
commit ccbf1c1429
3 changed files with 18 additions and 15 deletions

View File

@ -286,8 +286,8 @@ cell 8 = [
! 64-bit overflow
cell 8 = [
[ t ] [ 1 58 fixnum-shift dup [ fixnum+ ] compile-call 1 59 fixnum-shift = ] unit-test
[ -576460752303423489 ] [ 1 59 shift neg >fixnum [ -1 fixnum+ ] compile-call ] unit-test
[ t ] [ 1 fixnum-bits 2 - fixnum-shift dup [ fixnum+ ] compile-call 1 fixnum-bits 1 - fixnum-shift = ] unit-test
[ t ] [ most-negative-fixnum [ -1 fixnum+ ] compile-call first-bignum 1 + neg = ] unit-test
[ t ] [ 1 40 shift 1 40 shift [ fixnum* ] compile-call 1 80 shift = ] unit-test
[ t ] [ 1 40 shift neg 1 40 shift [ fixnum* ] compile-call 1 80 shift neg = ] unit-test
@ -302,9 +302,9 @@ cell 8 = [
[ -18446744073709551616 ] [ -1 [ 64 fixnum-shift ] compile-call ] unit-test
[ -18446744073709551616 ] [ -1 [ 32 fixnum-shift 32 fixnum-shift ] compile-call ] unit-test
[ 576460752303423488 ] [ -576460752303423488 >fixnum -1 [ fixnum/i ] compile-call ] unit-test
[ t ] [ most-negative-fixnum -1 [ fixnum/i ] compile-call first-bignum = ] unit-test
[ 576460752303423488 0 ] [ -576460752303423488 >fixnum -1 [ fixnum/mod ] compile-call ] unit-test
[ t ] [ most-negative-fixnum -1 [ fixnum/mod ] compile-call [ first-bignum = ] [ zero? ] bi* and ] unit-test
[ -268435457 ] [ 28 2^ [ fixnum-bitnot ] compile-call ] unit-test
] when

View File

@ -77,17 +77,17 @@ IN: compiler.tests.low-level-ir
dup first eq?
] unit-test
[ 4 ] [
[ $[ tag-bits get ] ] [
V{
T{ ##load-tagged f 0 4 }
T{ ##load-tagged f 0 $[ tag-bits get ] }
T{ ##shl f 0 0 0 }
} compile-test-bb
] unit-test
[ 4 ] [
[ $[ tag-bits get ] ] [
V{
T{ ##load-tagged f 0 4 }
T{ ##shl-imm f 0 0 4 }
T{ ##load-tagged f 0 $[ tag-bits get ] }
T{ ##shl-imm f 0 0 $[ tag-bits get ] }
} compile-test-bb
] unit-test
@ -96,14 +96,14 @@ IN: compiler.tests.low-level-ir
T{ ##load-reference f 1 B{ 31 67 52 } }
T{ ##unbox-any-c-ptr f 2 1 }
T{ ##load-memory-imm f 3 2 0 int-rep uchar }
T{ ##shl-imm f 0 3 4 }
T{ ##shl-imm f 0 3 $[ tag-bits get ] }
} compile-test-bb
] unit-test
[ 1 ] [
V{
T{ ##load-tagged f 0 32 }
T{ ##add-imm f 0 0 -16 }
T{ ##load-tagged f 0 $[ 2 tag-fixnum ] }
T{ ##add-imm f 0 0 $[ -1 tag-fixnum ] }
} compile-test-bb
] unit-test

View File

@ -60,6 +60,9 @@ SYMBOL: header-bits
: fixnum-bits ( -- n )
cell-bits (fixnum-bits) ; inline
: bootstrap-fixnum-bits ( -- n )
bootstrap-cell-bits (fixnum-bits) ; inline
: most-positive-fixnum ( -- n )
first-bignum 1 - >fixnum ; inline
@ -67,10 +70,10 @@ SYMBOL: header-bits
first-bignum neg >fixnum ; inline
: (max-array-capacity) ( b -- n )
6 - 2^ 1 - ; inline
2 - 2^ 1 - ; inline
: max-array-capacity ( -- n )
cell-bits (max-array-capacity) ; inline
fixnum-bits (max-array-capacity) ; inline
: bootstrap-first-bignum ( -- n )
bootstrap-cell-bits (first-bignum) ;
@ -82,7 +85,7 @@ SYMBOL: header-bits
bootstrap-first-bignum neg ;
: bootstrap-max-array-capacity ( -- n )
bootstrap-cell-bits (max-array-capacity) ;
bootstrap-fixnum-bits (max-array-capacity) ;
M: bignum >integer
dup most-negative-fixnum most-positive-fixnum between?