Fixing PowerPC backend: prolog register clobberage, spilling, and general stack frame usage. Add some lame tests for spilling
sheeple
parent
b7dc7296db
commit
d1f248dac6
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue