diff --git a/basis/compiler/cfg/stack-frame/stack-frame.factor b/basis/compiler/cfg/stack-frame/stack-frame.factor index 8d79a85b8f..ec9ffaba49 100644 --- 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 index 0000000000..156fdfff02 --- /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 675e0cbc0f..de87ad8c00 100644 --- 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 ad6c63b8c9..b60fd47b89 100644 --- 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 + ; +M: ppc %spill-integer ( src n -- ) spill-integer@ 1 swap STW ; +M: ppc %reload-integer ( dst n -- ) spill-integer@ 1 swap LWZ ; -: 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-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 ;