PowerPC backend work

library/compiler/intrinsics.factor

@@ -215,7 +215,7 @@ sequences words ;
 \ fixnum-bitnot [
     drop
     in-1
-    0 %fixnum-bitnot ,
+    0 <vreg> 0 <vreg> %fixnum-bitnot ,
     out-1
 ] "intrinsic" set-word-prop
 
@@ -225,7 +225,7 @@ sequences words ;
     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>> ,

library/compiler/ppc/assembler.factor

@@ -99,8 +99,8 @@ USING: compiler errors kernel math memory words ;
 : NOR 0 (NOR) ;
 : NOR. 1 (NOR) ;
 
-: NOT over NOR ;
+: NOT dup NOR ;
-: NOT. over NOR. ;
+: NOT. dup NOR. ;
 
 : ORI d-form 24 insn ;
 : ORIS d-form 25 insn ;
@@ -181,6 +181,9 @@ USING: compiler errors kernel math memory words ;
 : 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 ;

library/compiler/ppc/fixnum.factor

@@ -16,11 +16,30 @@ namespaces words ;
         >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
@@ -59,18 +78,17 @@ M: %fixnum-bitxor generate-node ( vop -- )
     \ XORI \ XOR maybe-immediate ;
 
 M: %fixnum-bitnot generate-node ( vop -- )
-    dup vop-in-1 v>operand swap vop-out-1 v>operand
+    dest/src dupd NOT dup untag ;
-    2dup NOT 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) ;

library/compiler/ppc/generator.factor

@@ -76,7 +76,7 @@ M: %return-to generate-node ( vop -- )
 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 ;
@@ -84,7 +84,7 @@ M: %untag generate-node ( vop -- )
 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
@@ -92,8 +92,7 @@ M: %tag-fixnum generate-node ( vop -- )
 
 M: %dispatch generate-node ( vop -- )
     0 <vreg> check-src
-    2 18 LI
+    17 17 2 SLWI
-    17 17 18 SLW
     ! 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

library/compiler/vops.factor

@@ -191,7 +191,7 @@ VOP: %fixnum/mod    : %fixnum/mod f <%fixnum/mod> ;
 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<> ;
@@ -211,7 +211,7 @@ 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

library/test/compiler/intrinsics.factor

@@ -151,6 +151,9 @@ math-internals test words ;
 [ 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
@@ -158,9 +161,6 @@ math-internals test words ;
 [ -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