Fixing PowerPC backend: prolog register clobberage, spilling, and general stack frame...

diff --git a/basis/compiler/cfg/stack-frame/stack-frame.factor b/basis/compiler/cfg/stack-frame/stack-frame.factor
index 8d79a85b8f13f868dd9c7b6957a6a60242812ce5..ec9ffaba49a5b30292f6b4c5d082d374a6904166 100644 (file)
--- a/basis/compiler/cfg/stack-frame/stack-frame.factor
+++ b/basis/compiler/cfg/stack-frame/stack-frame.factor
@@ -1,8 +1,8 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces accessors math.order assocs kernel sequences
-combinators make cpu.architecture compiler.cfg.instructions
-compiler.cfg.registers ;
+combinators make classes words cpu.architecture
+compiler.cfg.instructions compiler.cfg.registers ;
 IN: compiler.cfg.stack-frame
 
 SYMBOL: frame-required?
@@ -24,16 +24,16 @@ M: ##stack-frame compute-stack-frame*
 M: ##call compute-stack-frame*
     word>> sub-primitive>> [ frame-required? on ] unless ;
 
-M: _gc compute-stack-frame*
-    drop frame-required? on ;
-
-M: _spill compute-stack-frame*
-    drop frame-required? on ;
-
 M: _spill-counts compute-stack-frame*
     counts>> stack-frame get (>>spill-counts) ;
 
-M: insn compute-stack-frame* drop ;
+M: insn compute-stack-frame*
+    class frame-required? word-prop [
+        frame-required? on
+    ] when ;
+
+\ _gc t frame-required? set-word-prop
+\ _spill t frame-required? set-word-prop
 
 : compute-stack-frame ( insns -- )
     frame-required? off

diff --git a/basis/compiler/tests/spilling.factor b/basis/compiler/tests/spilling.factor
new file mode 100644 (file)
index 0000000..156fdff
--- /dev/null
+++ b/basis/compiler/tests/spilling.factor
@@ -0,0 +1,343 @@
+USING: math.private kernel combinators accessors arrays
+generalizations float-arrays tools.test ;
+IN: compiler.tests
+
+: float-spill-bug ( a -- b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b )
+    {
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+        [ dup float+ ]
+    } cleave ;
+
+[ 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 ]
+[ 1.0 float-spill-bug ] unit-test
+
+[ t ] [ \ float-spill-bug compiled>> ] unit-test
+
+: float-fixnum-spill-bug ( object -- object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object )
+    {
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+        [ dup float+ ]
+        [ float>fixnum dup fixnum+fast ]
+    } cleave ;
+
+[ 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 ]
+[ 1.0 float-fixnum-spill-bug ] unit-test
+
+[ t ] [ \ float-fixnum-spill-bug compiled>> ] unit-test
+
+: resolve-spill-bug ( a b -- c )
+    [ 1 fixnum+fast ] bi@ dup 10 fixnum< [
+        nip 2 fixnum+fast
+    ] [
+        drop {
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+            [ dup fixnum+fast ]
+        } cleave
+        16 narray
+    ] if ;
+
+[ t ] [ \ resolve-spill-bug compiled>> ] unit-test
+
+[ 4 ] [ 1 1 resolve-spill-bug ] unit-test
+
+! The above don't really test spilling...
+: spill-test-1 ( a -- b )
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast
+    dup 1 fixnum+fast fixnum>float
+    3array
+    3array [ 8 narray ] dip 2array
+    [ 8 narray [ 8 narray ] dip 2array ] dip 2array
+    2array ;
+
+[
+    {
+        1
+        {
+            { { 2 3 4 5 6 7 8 9 } { 10 11 12 13 14 15 16 17 } }
+            {
+                { 18 19 20 21 22 23 24 25 }
+                { 26 27 { 28 29 30.0 } }
+            }
+        }
+    }
+] [ 1 spill-test-1 ] unit-test
+
+: spill-test-2 ( a -- b )
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    dup 1.0 float+
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float*
+    float* ;
+
+[ t ] [ 1.0 spill-test-2 1.0 \ spill-test-2 def>> call = ] unit-test

diff --git a/basis/compiler/tests/templates.factor b/basis/compiler/tests/templates.factor
index 675e0cbc0ff13852c8cbde76e053c4897c652127..de87ad8c0055abbf42afdeaa1e4462a85546b3af 100644 (file)
--- a/basis/compiler/tests/templates.factor
+++ b/basis/compiler/tests/templates.factor
@@ -3,7 +3,7 @@ kernel.private math hashtables.private math.private namespaces
 sequences sequences.private tools.test namespaces.private
 slots.private sequences.private byte-arrays alien
 alien.accessors layouts words definitions compiler.units io
-combinators vectors ;
+combinators vectors float-arrays ;
 IN: compiler.tests
 
 ! Originally, this file did black box testing of templating
@@ -206,167 +206,6 @@ TUPLE: my-tuple ;
     ] compile-call
 ] unit-test
 
-: float-spill-bug ( a -- b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b b )
-    {
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-        [ dup float+ ]
-    } cleave ;
-
-[ 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 ]
-[ 1.0 float-spill-bug ] unit-test
-
-[ t ] [ \ float-spill-bug compiled>> ] unit-test
-
-: float-fixnum-spill-bug ( object -- object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object )
-    {
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-        [ dup float+ ]
-        [ float>fixnum dup fixnum+fast ]
-    } cleave ;
-
-[ 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 ]
-[ 1.0 float-fixnum-spill-bug ] unit-test
-
-[ t ] [ \ float-fixnum-spill-bug compiled>> ] unit-test
-
-: resolve-spill-bug ( a b -- c )
-    [ 1 fixnum+fast ] bi@ dup 10 fixnum< [
-        nip 2 fixnum+fast
-    ] [
-        drop {
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-            [ dup fixnum+fast ]
-        } cleave
-        16 narray
-    ] if ;
-
-[ t ] [ \ resolve-spill-bug compiled>> ] unit-test
-
-[ 4 ] [ 1 1 resolve-spill-bug ] unit-test
-
 ! Regression
 : dispatch-alignment-regression ( -- c )
     { tuple vector } 3 slot { word } declare

diff --git a/basis/cpu/ppc/ppc.factor b/basis/cpu/ppc/ppc.factor
index ad6c63b8c9ccc133277f4576b2e73b48cd86557c..b60fd47b89849db63afc5630450aa5b16c6ccaa6 100644 (file)
--- a/basis/cpu/ppc/ppc.factor
+++ b/basis/cpu/ppc/ppc.factor
@@ -4,7 +4,8 @@ USING: accessors assocs sequences kernel combinators make math
 math.order math.ranges system namespaces locals layouts words
 alien alien.c-types cpu.architecture cpu.ppc.assembler
 compiler.cfg.registers compiler.cfg.instructions
-compiler.constants compiler.codegen compiler.codegen.fixup ;
+compiler.constants compiler.codegen compiler.codegen.fixup
+compiler.cfg.intrinsics compiler.cfg.stack-frame ;
 IN: cpu.ppc
 
 ! PowerPC register assignments:
@@ -25,17 +26,21 @@ IN: cpu.ppc
         t "longlong" c-type (>>stack-align?)
         t "ulonglong" c-type (>>stack-align?)
     ] }
-} cond >>
+} cond
+
+enable-float-intrinsics
+
+\ ##integer>float t frame-required? set-word-prop
+\ ##float>integer t frame-required? set-word-prop >>
 
 M: ppc machine-registers
     {
         { int-regs T{ range f 2 26 1 } }
-        { double-float-regs T{ range f 0 28 1 } }
+        { double-float-regs T{ range f 0 29 1 } }
     } ;
 
 : scratch-reg 28 ; inline
-: fp-scratch-reg-1 29 ; inline
-: fp-scratch-reg-2 30 ; inline
+: fp-scratch-reg 30 ; inline
 
 M: ppc two-operand? f ;
 
@@ -71,12 +76,15 @@ M: ppc %inc-r ( n -- ) rs-reg (%inc) ;
         { macosx [ 6 ] }
     } case cells ; foldable
 
-: lr-save ( -- n )
-    os {
-        { linux [ 1 ] }
-        { macosx [ 2 ] }
-    } case cells ; foldable
+! The start of the stack frame contains the size of this frame
+! as well as the currently executing XT
+: factor-area-size ( -- n ) 2 cells ; foldable
+: next-save ( n -- i ) cell - ;
+: xt-save ( n -- i ) 2 cells - ;
 
+! Next, we have the spill area as well as the FFI parameter area.
+! They overlap, since basic blocks with FFI calls will never
+! spill.
 : param@ ( n -- x ) reserved-area-size + ; inline
 
 : param-save-size ( -- n ) 8 cells ; foldable
@@ -84,19 +92,38 @@ M: ppc %inc-r ( n -- ) rs-reg (%inc) ;
 : local@ ( n -- x )
     reserved-area-size param-save-size + + ; inline
 
-: factor-area-size ( -- n ) 2 cells ; foldable
+: spill-integer-base ( -- n )
+    stack-frame get spill-counts>> double-float-regs swap at
+    double-float-regs reg-size * ;
 
-: next-save ( n -- i ) cell - ;
+: spill-integer@ ( n -- offset )
+    cells spill-integer-base + param@ ;
 
-: xt-save ( n -- i ) 2 cells - ;
+: spill-float@ ( n -- offset )
+    double-float-regs reg-size * param@ ;
+
+! Some FP intrinsics need a temporary scratch area in the stack
+! frame, 8 bytes in size
+: scratch@ ( n -- offset )
+   stack-frame get total-size>>
+   factor-area-size -
+   param-save-size -
+   + ;
+
+! Finally we have the linkage area
+: lr-save ( -- n )
+    os {
+        { linux [ 1 ] }
+        { macosx [ 2 ] }
+    } case cells ; foldable
 
 M: ppc stack-frame-size ( stack-frame -- i )
     [ spill-counts>> [ swap reg-size * ] { } assoc>map sum ]
     [ params>> ]
     [ return>> ]
     tri + +
-    reserved-area-size +
     param-save-size +
+    reserved-area-size +
     factor-area-size +
     4 cells align ;
 
@@ -219,19 +246,19 @@ M: ppc %div-float FDIV ;
 
 M:: ppc %integer>float ( dst src -- )
     HEX: 4330 scratch-reg LIS
-    scratch-reg 1 0 param@ STW
+    scratch-reg 1 0 scratch@ STW
     scratch-reg src MR
     scratch-reg dup HEX: 8000 XORIS
-    scratch-reg 1 cell param@ STW
-    fp-scratch-reg-2 1 0 param@ LFD
+    scratch-reg 1 4 scratch@ STW
+    dst 1 0 scratch@ LFD
     scratch-reg 4503601774854144.0 %load-indirect
-    fp-scratch-reg-2 scratch-reg float-offset LFD
-    fp-scratch-reg-2 fp-scratch-reg-2 fp-scratch-reg-2 FSUB ;
+    fp-scratch-reg scratch-reg float-offset LFD
+    dst dst fp-scratch-reg FSUB ;
 
 M:: ppc %float>integer ( dst src -- )
-    fp-scratch-reg-1 src FCTIWZ
-    fp-scratch-reg-2 1 0 param@ STFD
-    dst 1 4 param@ LWZ ;
+    fp-scratch-reg src FCTIWZ
+    fp-scratch-reg 1 0 scratch@ STFD
+    dst 1 4 scratch@ LWZ ;
 
 M: ppc %copy ( dst src -- ) MR ;
 
@@ -239,6 +266,10 @@ M: ppc %copy-float ( dst src -- ) FMR ;
 
 M: ppc %unbox-float ( dst src -- ) float-offset LFD ;
 
+M:: ppc %box-float ( dst src temp -- )
+    dst 16 float temp %allot
+    src dst float-offset STFD ;
+
 M:: ppc %unbox-any-c-ptr ( dst src temp -- )
     [
         { "is-byte-array" "end" "start" } [ define-label ] each
@@ -370,12 +401,12 @@ M: ppc %gc
     "end" resolve-label ;
 
 M: ppc %prologue ( n -- )
-    0 scratch-reg LOAD32 rc-absolute-ppc-2/2 rel-this
+    0 11 LOAD32 rc-absolute-ppc-2/2 rel-this
     0 MFLR
     1 1 pick neg ADDI
-    scratch-reg 1 pick xt-save STW
-    dup scratch-reg LI
-    scratch-reg 1 pick next-save STW
+    11 1 pick xt-save STW
+    dup 11 LI
+    11 1 pick next-save STW
     0 1 rot lr-save + STW ;
 
 M: ppc %epilogue ( n -- )
@@ -426,32 +457,11 @@ M: ppc %compare-branch (%compare) %branch ;
 M: ppc %compare-imm-branch (%compare-imm) %branch ;
 M: ppc %compare-float-branch (%compare-float) %branch ;
 
-: spill-integer-base ( stack-frame -- n )
-    [ params>> ] [ return>> ] bi + ;
-
-: stack@ 1 swap ; inline
-
-: spill-integer@ ( n -- reg offset )
-    cells
-    stack-frame get spill-integer-base
-    + stack@ ;
-
-: spill-float-base ( stack-frame -- n )
-    [ spill-counts>> int-regs swap at int-regs reg-size * ]
-    [ params>> ]
-    [ return>> ]
-    tri + + ;
-
-: spill-float@ ( n -- reg offset )
-    double-float-regs reg-size *
-    stack-frame get spill-float-base
-    + stack@ ;
-
-M: ppc %spill-integer ( src n -- ) spill-integer@ STW ;
-M: ppc %reload-integer ( dst n -- ) spill-integer@ LWZ ;
+M: ppc %spill-integer ( src n -- ) spill-integer@ 1 swap STW ;
+M: ppc %reload-integer ( dst n -- ) spill-integer@ 1 swap LWZ ;
 
-M: ppc %spill-float ( src n -- ) spill-float@ STFD ;
-M: ppc %reload-float ( dst n -- ) spill-float@ LFD ;
+M: ppc %spill-float ( src n -- ) spill-float@ 1 swap STFD ;
+M: ppc %reload-float ( dst n -- ) spill-float@ 1 swap LFD ;
 
 M: ppc %loop-entry ;