Register allocation cleanup
parent
1964164664
commit
4af21da845
|
@ -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 -- )
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue