\ fixnum-bitnot [
drop
in-1
- 0 %fixnum-bitnot ,
+ 0 <vreg> 0 <vreg> %fixnum-bitnot ,
out-1
] "intrinsic" set-word-prop
1 %dec-d ,
in-1
dup cell -8 * <= [
- drop 0 <vreg> 2 <vreg> 2 <vreg> %fixnum-sgn ,
+ drop 0 <vreg> 2 <vreg> %fixnum-sgn ,
2 0 %replace-d ,
] [
neg 0 <vreg> 0 <vreg> %fixnum>> ,
: NOR 0 (NOR) ;
: NOR. 1 (NOR) ;
-: NOT over NOR ;
-: NOT. over NOR. ;
+: NOT dup NOR ;
+: NOT. dup NOR. ;
: ORI d-form 24 insn ;
: ORIS d-form 25 insn ;
: RLWINM 0 (RLWINM) ;
: RLWINM. 1 (RLWINM) ;
+: SLWI 0 31 pick - RLWINM ;
+: SLWI. 0 31 pick - RLWINM. ;
+
: LBZ d-form 34 insn ; : LBZU d-form 35 insn ;
: LHA d-form 42 insn ; : LHAU d-form 43 insn ;
: LHZ d-form 40 insn ; : LHZU d-form 41 insn ;
>r >r >3-vop< v>operand swap r> drop r> execute
] ifte ; inline
+: simple-overflow ( vop inv word -- )
+ >r >r
+ <label> "end" set
+ "end" get BNO
+ dup >3-vop< v>operand 3dup swapd r> execute
+ 2dup
+ dup tag-bits SRAWI
+ dup tag-bits SRAWI
+ drop
+ 3 -rot r> execute
+ "s48_long_to_bignum" f compile-c-call
+ ! An untagged pointer to the bignum is now in r3; tag it
+ 3 swap vop-out-1 v>operand bignum-tag ORI
+ "end" get save-xt ; inline
+
M: %fixnum+ generate-node ( vop -- )
- \ ADDI \ ADD maybe-immediate ;
+ 0 MTXER
+ dup \ ADDI \ ADDO. maybe-immediate
+ \ SUBF \ ADD simple-overflow ;
M: %fixnum- generate-node ( vop -- )
- \ SUBI \ SUBF maybe-immediate ;
+ 0 MTXER
+ dup \ SUBI \ SUBFO. maybe-immediate
+ \ ADD \ SUBF simple-overflow ;
M: %fixnum* generate-node ( vop -- )
dup \ MULLI \ MULLW maybe-immediate
\ XORI \ XOR maybe-immediate ;
M: %fixnum-bitnot generate-node ( vop -- )
- dup vop-in-1 v>operand swap vop-out-1 v>operand
- 2dup NOT untag ;
+ dest/src dupd NOT dup untag ;
M: %fixnum<< generate-node ( vop -- )
dup vop-in-1 20 LI
dup vop-out-1 v>operand swap vop-in-2 v>operand 20 SLW ;
M: %fixnum>> generate-node ( vop -- )
- >3-vop< >r 2dup r> SRAWI untag ;
+ >3-vop< >r dupd r> SRAWI dup untag ;
M: %fixnum-sgn generate-node ( vop -- )
- >3-vop< >r 2dup r> drop 31 SRAWI untag ;
+ dest/src dupd 31 SRAWI dup untag ;
: MULLW 0 0 (MULLW) ;
: MULLW. 0 1 (MULLW) ;
M: %return generate-node ( vop -- )
drop compile-epilogue BLR ;
-: untag ( dest src -- ) 0 0 28 RLWINM ;
+: untag ( dest src -- ) 0 0 31 tag-bits - RLWINM ;
M: %untag generate-node ( vop -- )
dest/src untag ;
M: %untag-fixnum generate-node ( vop -- )
dest/src tag-bits SRAWI ;
-: tag-fixnum ( dest src -- ) 3 21 LI 21 SLW ;
+: tag-fixnum ( dest src -- ) tag-bits SLWI ;
M: %tag-fixnum generate-node ( vop -- )
! todo: formalize scratch register usage
M: %dispatch generate-node ( vop -- )
0 <vreg> check-src
- 2 18 LI
- 17 17 18 SLW
+ 17 17 2 SLWI
! The value 24 is a magic number. It is the length of the
! instruction sequence that follows to be generated.
0 1 rel-address compiled-offset 24 + 18 LOAD32
VOP: %fixnum-bitand : %fixnum-bitand 3-vop <%fixnum-bitand> ;
VOP: %fixnum-bitor : %fixnum-bitor 3-vop <%fixnum-bitor> ;
VOP: %fixnum-bitxor : %fixnum-bitxor 3-vop <%fixnum-bitxor> ;
-VOP: %fixnum-bitnot : %fixnum-bitnot <vreg> dest-vop <%fixnum-bitnot> ;
+VOP: %fixnum-bitnot : %fixnum-bitnot 2-vop <%fixnum-bitnot> ;
VOP: %fixnum<= : %fixnum<= 3-vop <%fixnum<=> ;
VOP: %fixnum< : %fixnum< 3-vop <%fixnum<> ;
VOP: %fixnum>> : %fixnum>> 3-vop <%fixnum>>> ;
! due to x86 limitations the destination of this VOP must be
! vreg 2 (EDX), and the source must be vreg 0 (EAX).
-VOP: %fixnum-sgn : %fixnum-sgn 3-vop <%fixnum-sgn> ;
+VOP: %fixnum-sgn : %fixnum-sgn src/dest-vop <%fixnum-sgn> ;
! Integer comparison followed by a conditional branch is
! optimized
[ HEX: 10000000 ] [ HEX: -10000000 >fixnum [ 0 swap fixnum- ] compile-1 ] unit-test
[ HEX: 10000000 ] [ HEX: -fffffff >fixnum [ 1 swap fixnum- ] compile-1 ] unit-test
+[ t ] [ 1 27 fixnum-shift dup [ fixnum+ ] compile-1 1 28 fixnum-shift = ] unit-test
+[ -268435457 ] [ 1 28 shift neg >fixnum [ -1 fixnum+ ] compile-1 ] unit-test
+
[ 4294967296 ] [ 1 32 [ fixnum-shift ] compile-1 ] unit-test
[ 4294967296 ] [ 1 [ 32 fixnum-shift ] compile-1 ] unit-test
[ 4294967296 ] [ 1 [ 16 fixnum-shift 16 fixnum-shift ] compile-1 ] unit-test
[ -4294967296 ] [ -1 [ 32 fixnum-shift ] compile-1 ] unit-test
[ -4294967296 ] [ -1 [ 16 fixnum-shift 16 fixnum-shift ] compile-1 ] unit-test
-[ t ] [ 1 27 fixnum-shift dup [ fixnum+ ] compile-1 1 28 fixnum-shift = ] unit-test
-[ -268435457 ] [ 1 28 shift neg >fixnum [ -1 fixnum+ ] compile-1 ] unit-test
-
[ t ] [ 1 20 shift 1 20 shift [ fixnum* ] compile-1 1 40 shift = ] unit-test
[ t ] [ 1 20 shift neg 1 20 shift [ fixnum* ] compile-1 1 40 shift neg = ] unit-test
[ t ] [ 1 20 shift neg 1 20 shift neg [ fixnum* ] compile-1 1 40 shift = ] unit-test