Register allocation cleanup

slava 2006-05-04 22:19:39 +00:00
parent 1964164664
commit 4af21da845
2 changed files with 10 additions and 16 deletions

View File

@ -193,9 +193,8 @@ M: #dispatch generate-node ( node -- next )
UNION: immediate fixnum POSTPONE: f ; UNION: immediate fixnum POSTPONE: f ;
: generate-push ( node -- ) : generate-push ( node -- )
>#push< dup length dup ensure-vregs >#push< dup length ensure-vregs
alloc-reg# [ <int-vreg> ] map [ T{ int-regs } alloc-reg [ load-literal ] keep ] map
[ [ load-literal ] 2each ] keep
phantom-d get phantom-append ; phantom-d get phantom-append ;
M: #push generate-node ( #push -- ) M: #push generate-node ( #push -- )

View File

@ -5,13 +5,12 @@ USING: arrays generic hashtables inference io kernel math
namespaces prettyprint sequences vectors words ; namespaces prettyprint sequences vectors words ;
! Register allocation ! Register allocation
! Hash mapping reg-classes to mutable vectors
SYMBOL: free-vregs SYMBOL: free-vregs
: alloc-reg ( -- n ) : alloc-reg ( reg-class -- vreg )
free-vregs get pop ; >r free-vregs get pop r> <vreg> ;
: alloc-reg# ( n -- regs )
free-vregs [ cut ] change ;
: requested-vregs ( template -- n ) : requested-vregs ( template -- n )
0 [ [ 1+ ] unless ] reduce ; 0 [ [ 1+ ] unless ] reduce ;
@ -20,7 +19,7 @@ SYMBOL: free-vregs
[ requested-vregs ] 2apply + ; [ requested-vregs ] 2apply + ;
: alloc-vregs ( template -- template ) : alloc-vregs ( template -- template )
[ first [ alloc-reg ] unless* ] map ; [ first [ <int-vreg> ] [ T{ int-regs } alloc-reg ] if* ] map ;
: adjust-free-vregs ( seq -- ) : adjust-free-vregs ( seq -- )
free-vregs [ diff ] change ; free-vregs [ diff ] change ;
@ -105,11 +104,8 @@ SYMBOL: phantom-r
: finalize-heights ( -- ) : finalize-heights ( -- )
phantoms [ finalize-height ] 2apply ; phantoms [ finalize-height ] 2apply ;
: stack>vreg ( vreg# loc -- operand )
>r <int-vreg> dup r> %peek ;
: stack>new-vreg ( loc -- vreg ) : stack>new-vreg ( loc -- vreg )
alloc-reg swap stack>vreg ; T{ int-regs } alloc-reg [ swap %peek ] keep ;
: vreg>stack ( value loc -- ) : vreg>stack ( value loc -- )
over loc? [ over loc? [
@ -182,7 +178,7 @@ SYMBOL: phantom-r
: stack>vregs ( phantom template -- values ) : stack>vregs ( phantom template -- values )
[ [
alloc-vregs dup length rot phantom-locs alloc-vregs dup length rot phantom-locs
[ stack>vreg ] 2map [ dupd %peek ] 2map
] 2keep length neg swap adjust-phantom ; ] 2keep length neg swap adjust-phantom ;
: compatible-values? ( value template -- ? ) : compatible-values? ( value template -- ? )
@ -257,8 +253,7 @@ SYMBOL: +clobber
+input get { } additional-vregs# +scratch get length + ; +input get { } additional-vregs# +scratch get length + ;
: alloc-scratch ( -- ) : alloc-scratch ( -- )
+scratch get [ alloc-vregs [ <int-vreg> ] map ] keep +scratch get [ alloc-vregs ] keep phantom-vregs ;
phantom-vregs ;
: template-inputs ( -- ) : template-inputs ( -- )
! Ensure we have enough to hold any new stack elements we ! Ensure we have enough to hold any new stack elements we