Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / cpu / ppc / ppc.factor

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 7ce73d2c4b07a81f56ce76a4349fc27ef13c96ac..a169982445848870581b6883b1df12cd535bdada 100644 (file)
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -4,10 +4,10 @@ USING: accessors assocs sequences kernel combinators make math
 math.order math.ranges system namespaces locals layouts words
 alien alien.accessors alien.c-types literals cpu.architecture
 cpu.ppc.assembler cpu.ppc.assembler.backend compiler.cfg.registers
-compiler.cfg.instructions compiler.constants compiler.codegen
+compiler.cfg.instructions compiler.cfg.comparisons
 compiler.codegen.fixup compiler.cfg.intrinsics
 compiler.cfg.stack-frame compiler.cfg.build-stack-frame
-compiler.units ;
+compiler.units compiler.constants compiler.codegen ;
 FROM: cpu.ppc.assembler => B ;
 IN: cpu.ppc
 
@@ -32,7 +32,7 @@ enable-float-intrinsics
 M: ppc machine-registers
     {
         { int-regs $[ 2 12 [a,b] 15 29 [a,b] append ] }
-        { double-float-regs $[ 0 29 [a,b] ] }
+        { float-regs $[ 0 29 [a,b] ] }
     } ;
 
 CONSTANT: scratch-reg 30
@@ -90,14 +90,14 @@ HOOK: reserved-area-size os ( -- n )
     reserved-area-size param-save-size + + ; inline
 
 : spill-integer@ ( n -- offset )
-    spill-integer-offset param@ ;
+    spill-integer-offset local@ ;
 
 : spill-float@ ( n -- offset )
-    spill-float-offset param@ ;
+    spill-float-offset local@ ;
 
 ! Some FP intrinsics need a temporary scratch area in the stack
 ! frame, 8 bytes in size. This is in the param-save area so it
-! should not overlap with spill slots.
+! does not overlap with spill slots.
 : scratch@ ( n -- offset )
     stack-frame get total-size>>
     factor-area-size -
@@ -106,7 +106,7 @@ HOOK: reserved-area-size os ( -- n )
 
 ! GC root area
 : gc-root@ ( n -- offset )
-    gc-root-offset param@ ;
+    gc-root-offset local@ ;
 
 ! Finally we have the linkage area
 HOOK: lr-save os ( -- n )
@@ -180,7 +180,7 @@ M: ppc %xor     XOR ;
 M: ppc %xor-imm XORI ;
 M: ppc %shl     SLW ;
 M: ppc %shl-imm swapd SLWI ;
-M: ppc %shr-imm SRW ;
+M: ppc %shr     SRW ;
 M: ppc %shr-imm swapd SRWI ;
 M: ppc %sar     SRAW ;
 M: ppc %sar-imm SRAWI ;
@@ -190,7 +190,7 @@ M: ppc %not     NOT ;
     0 0 LI
     0 MTXER
     dst src2 src1 insn call
-    label BNO ; inline
+    label BO ; inline
 
 M: ppc %fixnum-add ( label dst src1 src2 -- )
     [ ADDO. ] overflow-template ;
@@ -198,7 +198,7 @@ M: ppc %fixnum-add ( label dst src1 src2 -- )
 M: ppc %fixnum-sub ( label dst src1 src2 -- )
     [ SUBFO. ] overflow-template ;
 
-M:: ppc %fixnum-mul ( label dst src1 src2 -- )
+M: ppc %fixnum-mul ( label dst src1 src2 -- )
     [ MULLWO. ] overflow-template ;
 
 : bignum@ ( n -- offset ) cells bignum tag-number - ; inline
@@ -217,7 +217,7 @@ M:: ppc %integer>bignum ( dst src temp -- )
         temp dst 1 bignum@ STW
         ! Compute sign
         temp src MR
-        temp temp cell-bits 1- SRAWI
+        temp temp cell-bits 1 - SRAWI
         temp temp 1 ANDI
         ! Store sign
         temp dst 2 bignum@ STW
@@ -415,10 +415,9 @@ M:: ppc %load-gc-root ( gc-root register -- )
 
 M:: ppc %call-gc ( gc-root-count -- )
     %prepare-alien-invoke
-    3 1 gc-root-base param@ ADDI
+    3 1 gc-root-base local@ ADDI
     gc-root-count 4 LI
-    "inline_gc" f %alien-invoke
-    "end" resolve-label ;
+    "inline_gc" f %alien-invoke ;
 
 M: ppc %prologue ( n -- )
     0 11 LOAD32 rc-absolute-ppc-2/2 rel-this
@@ -494,26 +493,18 @@ M: float-regs return-reg drop 1 ;
 M: int-regs %save-param-reg drop 1 rot local@ STW ;
 M: int-regs %load-param-reg drop 1 rot local@ LWZ ;
 
-GENERIC: STF ( src dst off reg-class -- )
+M: single-float-rep %save-param-reg drop 1 rot local@ STFS ;
+M: single-float-rep %load-param-reg 1 rot local@ LFS ;
 
-M: single-float-regs STF drop STFS ;
-M: double-float-regs STF drop STFD ;
+M: double-float-rep %save-param-reg drop 1 rot local@ STFD ;
+M: double-float-rep %load-param-reg 1 rot local@ LFD ;
 
-M: float-regs %save-param-reg [ 1 rot local@ ] dip STF ;
-
-GENERIC: LF ( dst src off reg-class -- )
-
-M: single-float-regs LF drop LFS ;
-M: double-float-regs LF drop LFD ;
-
-M: float-regs %load-param-reg [ 1 rot local@ ] dip LF ;
-
-M: stack-params %load-param-reg ( stack reg reg-class -- )
+M: stack-params %load-param-reg ( stack reg rep -- )
     drop [ 0 1 rot local@ LWZ 0 1 ] dip param@ STW ;
 
 : next-param@ ( n -- x ) param@ stack-frame get total-size>> + ;
 
-M: stack-params %save-param-reg ( stack reg reg-class -- )
+M: stack-params %save-param-reg ( stack reg rep -- )
     #! Funky. Read the parameter from the caller's stack frame.
     #! This word is used in callbacks
     drop
@@ -525,12 +516,12 @@ M: ppc %prepare-unbox ( -- )
     3 ds-reg 0 LWZ
     ds-reg dup cell SUBI ;
 
-M: ppc %unbox ( n reg-class func -- )
+M: ppc %unbox ( n rep func -- )
     ! Value must be in r3
     ! Call the unboxer
     f %alien-invoke
     ! Store the return value on the C stack
-    over [ [ return-reg ] keep %save-param-reg ] [ 2drop ] if ;
+    over [ [ reg-class-of return-reg ] keep %save-param-reg ] [ 2drop ] if ;
 
 M: ppc %unbox-long-long ( n func -- )
     ! Value must be in r3:r4
@@ -549,11 +540,11 @@ M: ppc %unbox-large-struct ( n c-type -- )
     ! Call the function
     "to_value_struct" f %alien-invoke ;
 
-M: ppc %box ( n reg-class func -- )
+M: ppc %box ( n rep func -- )
     ! If the source is a stack location, load it into freg #0.
     ! If the source is f, then we assume the value is already in
     ! freg #0.
-    [ over [ 0 over param-reg swap %load-param-reg ] [ 2drop ] if ] dip
+    [ over [ 0 over reg-class-of param-reg swap %load-param-reg ] [ 2drop ] if ] dip
     f %alien-invoke ;
 
 M: ppc %box-long-long ( n func -- )