Merge branch 'master' of git://factorcode.org/git/factor
commit
2d6622e5e9
|
@ -23,7 +23,11 @@ GENERIC# compute-in-set 2 ( bb out-sets dfa -- set )
|
||||||
M: kill-block compute-in-set 3drop f ;
|
M: kill-block compute-in-set 3drop f ;
|
||||||
|
|
||||||
M:: basic-block compute-in-set ( bb out-sets dfa -- set )
|
M:: basic-block compute-in-set ( bb out-sets dfa -- set )
|
||||||
bb dfa predecessors [ out-sets at ] map bb dfa join-sets ;
|
! Only consider initialized sets.
|
||||||
|
bb dfa predecessors
|
||||||
|
[ out-sets key? ] filter
|
||||||
|
[ out-sets at ] map
|
||||||
|
bb dfa join-sets ;
|
||||||
|
|
||||||
:: update-in-set ( bb in-sets out-sets dfa -- ? )
|
:: update-in-set ( bb in-sets out-sets dfa -- ? )
|
||||||
bb out-sets dfa compute-in-set
|
bb out-sets dfa compute-in-set
|
||||||
|
|
|
@ -267,7 +267,7 @@ M: ##alien-global generate-insn
|
||||||
%alien-global ;
|
%alien-global ;
|
||||||
|
|
||||||
! ##alien-invoke
|
! ##alien-invoke
|
||||||
GENERIC: next-fastcall-param ( reg-class -- )
|
GENERIC: next-fastcall-param ( rep -- )
|
||||||
|
|
||||||
: ?dummy-stack-params ( rep -- )
|
: ?dummy-stack-params ( rep -- )
|
||||||
dummy-stack-params? [ rep-size cell align stack-params +@ ] [ drop ] if ;
|
dummy-stack-params? [ rep-size cell align stack-params +@ ] [ drop ] if ;
|
||||||
|
@ -300,7 +300,7 @@ M: reg-class reg-class-full?
|
||||||
stack-params dup ;
|
stack-params dup ;
|
||||||
|
|
||||||
: alloc-fastcall-param ( rep -- n reg-class rep )
|
: alloc-fastcall-param ( rep -- n reg-class rep )
|
||||||
[ reg-class-of [ get ] [ inc ] [ ] tri ] keep ;
|
[ [ reg-class-of get ] [ reg-class-of ] [ next-fastcall-param ] tri ] keep ;
|
||||||
|
|
||||||
: alloc-parameter ( parameter -- reg rep )
|
: alloc-parameter ( parameter -- reg rep )
|
||||||
c-type-rep dup reg-class-of reg-class-full?
|
c-type-rep dup reg-class-of reg-class-full?
|
||||||
|
|
|
@ -89,11 +89,8 @@ HOOK: reserved-area-size os ( -- n )
|
||||||
: local@ ( n -- x )
|
: local@ ( n -- x )
|
||||||
reserved-area-size param-save-size + + ; inline
|
reserved-area-size param-save-size + + ; inline
|
||||||
|
|
||||||
: spill-integer@ ( n -- offset )
|
: spill@ ( n -- offset )
|
||||||
spill-integer-offset local@ ;
|
spill-offset local@ ;
|
||||||
|
|
||||||
: spill-float@ ( n -- offset )
|
|
||||||
spill-float-offset local@ ;
|
|
||||||
|
|
||||||
! Some FP intrinsics need a temporary scratch area in the stack
|
! 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
|
! frame, 8 bytes in size. This is in the param-save area so it
|
||||||
|
@ -275,9 +272,11 @@ M:: ppc %float>integer ( dst src -- )
|
||||||
fp-scratch-reg 1 0 scratch@ STFD
|
fp-scratch-reg 1 0 scratch@ STFD
|
||||||
dst 1 4 scratch@ LWZ ;
|
dst 1 4 scratch@ LWZ ;
|
||||||
|
|
||||||
M: ppc %copy ( dst src -- ) MR ;
|
M: ppc %copy ( dst src rep -- )
|
||||||
|
{
|
||||||
M: ppc %copy-float ( dst src -- ) FMR ;
|
{ int-rep [ MR ] }
|
||||||
|
{ double-float-rep [ FMR ] }
|
||||||
|
} case ;
|
||||||
|
|
||||||
M: ppc %unbox-float ( dst src -- ) float-offset LFD ;
|
M: ppc %unbox-float ( dst src -- ) float-offset LFD ;
|
||||||
|
|
||||||
|
@ -478,11 +477,29 @@ M: ppc %compare-branch (%compare) %branch ;
|
||||||
M: ppc %compare-imm-branch (%compare-imm) %branch ;
|
M: ppc %compare-imm-branch (%compare-imm) %branch ;
|
||||||
M: ppc %compare-float-branch (%compare-float) %branch ;
|
M: ppc %compare-float-branch (%compare-float) %branch ;
|
||||||
|
|
||||||
M: ppc %spill-integer ( src n -- ) spill-integer@ 1 swap STW ;
|
: load-from-frame ( dst n rep -- )
|
||||||
M: ppc %reload-integer ( dst n -- ) spill-integer@ 1 swap LWZ ;
|
{
|
||||||
|
{ int-rep [ [ 1 ] dip LWZ ] }
|
||||||
|
{ single-float-rep [ [ 1 ] dip LFS ] }
|
||||||
|
{ double-float-rep [ [ 1 ] dip LFD ] }
|
||||||
|
{ stack-params [ [ 0 1 ] dip LWZ [ 0 1 ] dip param@ STW ] }
|
||||||
|
} case ;
|
||||||
|
|
||||||
M: ppc %spill-float ( src n -- ) spill-float@ 1 swap STFD ;
|
: next-param@ ( n -- x ) param@ stack-frame get total-size>> + ;
|
||||||
M: ppc %reload-float ( dst n -- ) spill-float@ 1 swap LFD ;
|
|
||||||
|
: store-to-frame ( src n rep -- )
|
||||||
|
{
|
||||||
|
{ int-rep [ [ 1 ] dip STW ] }
|
||||||
|
{ single-float-rep [ [ 1 ] dip STFS ] }
|
||||||
|
{ double-float-rep [ [ 1 ] dip STFD ] }
|
||||||
|
{ stack-params [ [ [ 0 1 ] dip next-param@ LWZ 0 1 ] dip STW ] }
|
||||||
|
} case ;
|
||||||
|
|
||||||
|
M: ppc %spill ( src n rep -- )
|
||||||
|
[ spill@ ] dip store-to-frame ;
|
||||||
|
|
||||||
|
M: ppc %reload ( dst n rep -- )
|
||||||
|
[ spill@ ] dip load-from-frame ;
|
||||||
|
|
||||||
M: ppc %loop-entry ;
|
M: ppc %loop-entry ;
|
||||||
|
|
||||||
|
@ -490,26 +507,11 @@ M: int-regs return-reg drop 3 ;
|
||||||
M: int-regs param-regs drop { 3 4 5 6 7 8 9 10 } ;
|
M: int-regs param-regs drop { 3 4 5 6 7 8 9 10 } ;
|
||||||
M: float-regs return-reg drop 1 ;
|
M: float-regs return-reg drop 1 ;
|
||||||
|
|
||||||
M: int-regs %save-param-reg drop 1 rot local@ STW ;
|
M:: ppc %save-param-reg ( stack reg rep -- )
|
||||||
M: int-regs %load-param-reg drop 1 rot local@ LWZ ;
|
reg stack local@ rep store-to-frame ;
|
||||||
|
|
||||||
M: single-float-rep %save-param-reg drop 1 rot local@ STFS ;
|
M:: ppc %load-param-reg ( stack reg rep -- )
|
||||||
M: single-float-rep %load-param-reg 1 rot local@ LFS ;
|
reg stack local@ rep load-from-frame ;
|
||||||
|
|
||||||
M: double-float-rep %save-param-reg drop 1 rot local@ STFD ;
|
|
||||||
M: double-float-rep %load-param-reg 1 rot local@ LFD ;
|
|
||||||
|
|
||||||
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 rep -- )
|
|
||||||
#! Funky. Read the parameter from the caller's stack frame.
|
|
||||||
#! This word is used in callbacks
|
|
||||||
drop
|
|
||||||
[ 0 1 ] dip next-param@ LWZ
|
|
||||||
[ 0 1 ] dip local@ STW ;
|
|
||||||
|
|
||||||
M: ppc %prepare-unbox ( -- )
|
M: ppc %prepare-unbox ( -- )
|
||||||
! First parameter is top of stack
|
! First parameter is top of stack
|
||||||
|
|
Loading…
Reference in New Issue