Merge branch 'slots' of git://factorcode.org/git/factor into slots

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

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index 4ae92e72301281aa6fcbc787df5e04a95cd9c1f2..5461002dc86a3465a371fd2384010714d6990989 100644 (file)
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -40,9 +40,6 @@ enable-float-intrinsics
 
 M: ppc %vm-field-ptr ( dst field -- ) %load-vm-field-addr ;
 
-M: ppc %vm-invoke-1st-arg ( function -- ) f %alien-invoke ;
-M: ppc %vm-invoke-3rd-arg ( function -- ) f %alien-invoke ;
-
 M: ppc machine-registers
     {
         { int-regs $[ 2 12 [a,b] 15 29 [a,b] append ] }
@@ -280,10 +277,12 @@ M:: ppc %float>integer ( dst src -- )
     dst 1 4 scratch@ LWZ ;
 
 M: ppc %copy ( dst src rep -- )
-    {
-        { int-rep [ MR ] }
-        { double-rep [ FMR ] }
-    } case ;
+    2over eq? [ 3drop ] [
+        {
+            { int-rep [ MR ] }
+            { double-rep [ FMR ] }
+        } case
+    ] if ;
 
 M: ppc %unbox-float ( dst src -- ) float-offset LFD ;
 
@@ -295,7 +294,7 @@ M:: ppc %box-float ( dst src temp -- )
     [ float-regs param-regs nth 1 ] [ n>> spill@ ] bi* LFD ;
 
 : float-function-return ( reg -- )
-    float-regs return-reg 2dup = [ 2drop ] [ FMR ] if ;
+    float-regs return-reg double-rep %copy ;
 
 M:: ppc %unary-float-function ( dst src func -- )
     0 src float-function-param
@@ -309,9 +308,31 @@ M:: ppc %binary-float-function ( dst src1 src2 func -- )
     dst float-function-return ;
 
 ! Internal format is always double-precision on PowerPC
-M: ppc %single>double-float FMR ;
-
-M: ppc %double>single-float FMR ;
+M: ppc %single>double-float double-rep %copy ;
+M: ppc %double>single-float double-rep %copy ;
+
+! VMX/AltiVec not supported yet
+M: ppc %broadcast-vector-reps { } ;
+M: ppc %gather-vector-2-reps { } ;
+M: ppc %gather-vector-4-reps { } ;
+M: ppc %add-vector-reps { } ;
+M: ppc %saturated-add-vector-reps { } ;
+M: ppc %add-sub-vector-reps { } ;
+M: ppc %sub-vector-reps { } ;
+M: ppc %saturated-sub-vector-reps { } ;
+M: ppc %mul-vector-reps { } ;
+M: ppc %saturated-mul-vector-reps { } ;
+M: ppc %div-vector-reps { } ;
+M: ppc %min-vector-reps { } ;
+M: ppc %max-vector-reps { } ;
+M: ppc %sqrt-vector-reps { } ;
+M: ppc %horizontal-add-vector-reps { } ;
+M: ppc %abs-vector-reps { } ;
+M: ppc %and-vector-reps { } ;
+M: ppc %or-vector-reps { } ;
+M: ppc %xor-vector-reps { } ;
+M: ppc %shl-vector-reps { } ;
+M: ppc %shr-vector-reps { } ;
 
 M: ppc %unbox-alien ( dst src -- )
     alien-offset LWZ ;
@@ -485,7 +506,7 @@ M:: ppc %save-gc-root ( gc-root register -- )
 M:: ppc %load-gc-root ( gc-root register -- )
     register 1 gc-root gc-root@ LWZ ;
 
-M:: ppc %call-gc ( gc-root-count -- )
+M:: ppc %call-gc ( gc-root-count temp -- )
     3 1 gc-root-base local@ ADDI
     gc-root-count 4 LI
     "inline_gc" f %alien-invoke ;
@@ -753,6 +774,12 @@ M: ppc %box-small-struct ( c-type -- )
     4 3 4 LWZ
     3 3 0 LWZ ;
 
+M: ppc %nest-stacks ( -- )
+    "nest_stacks" f %alien-invoke ;
+
+M: ppc %unnest-stacks ( -- )
+    "unnest_stacks" f %alien-invoke ;
+
 M: ppc %unbox-small-struct ( size -- )
     #! Alien must be in EAX.
     heap-size cell align cell /i {