Register allocation fixes

slava 2006-04-23 05:40:49 +00:00
parent 0842bd6a01
commit ac678bceb0
5 changed files with 37 additions and 36 deletions

View File

@ -17,7 +17,7 @@ namespaces sequences words ;
{ } [ { } [
"obj" get %untag , "obj" get %untag ,
"val" get "obj" get "slot" get %set-slot , "val" get "obj" get "slot" get %set-slot ,
end-basic-block finalize-contents
"obj" get %write-barrier , "obj" get %write-barrier ,
] with-template ] with-template
] "intrinsic" set-word-prop ] "intrinsic" set-word-prop
@ -36,7 +36,7 @@ namespaces sequences words ;
\ type [ \ type [
{ { any-reg "in" } } { "in" } { { any-reg "in" } } { "in" }
[ end-basic-block "in" get %type , ] with-template [ finalize-contents "in" get %type , ] with-template
] "intrinsic" set-word-prop ] "intrinsic" set-word-prop
\ tag [ \ tag [
@ -46,7 +46,7 @@ namespaces sequences words ;
: binary-op ( op -- ) : binary-op ( op -- )
{ { 0 "x" } { 1 "y" } } { "x" } [ { { 0 "x" } { 1 "y" } } { "x" } [
end-basic-block >r "y" get "x" get dup r> execute , finalize-contents >r "y" get "x" get dup r> execute ,
] with-template ; inline ] with-template ; inline
{ {
@ -83,7 +83,7 @@ namespaces sequences words ;
! hard-coded to put its output in vreg 2, which happends to ! hard-coded to put its output in vreg 2, which happends to
! be EDX there. ! be EDX there.
{ { 0 "x" } { 1 "y" } } { "out" } [ { { 0 "x" } { 1 "y" } } { "out" } [
end-basic-block finalize-contents
T{ vreg f 2 } "out" set T{ vreg f 2 } "out" set
"y" get "x" get "out" get %fixnum-mod , "y" get "x" get "out" get %fixnum-mod ,
] with-template ] with-template
@ -92,7 +92,7 @@ namespaces sequences words ;
\ fixnum/mod [ \ fixnum/mod [
! See the remark on fixnum-mod for vreg usage ! See the remark on fixnum-mod for vreg usage
{ { 0 "x" } { 1 "y" } } { "quo" "rem" } [ { { 0 "x" } { 1 "y" } } { "quo" "rem" } [
end-basic-block finalize-contents
T{ vreg f 0 } "quo" set T{ vreg f 0 } "quo" set
T{ vreg f 2 } "rem" set T{ vreg f 2 } "rem" set
"y" get "x" get 2array "y" get "x" get 2array

View File

@ -98,20 +98,6 @@ M: #call linearize* ( node -- next )
M: #call-label linearize* ( node -- next ) M: #call-label linearize* ( node -- next )
node-param renamed-label linearize-call ; node-param renamed-label linearize-call ;
: ensure-vregs ( n -- )
sufficient-vregs?
[ end-basic-block compute-free-vregs ] unless ;
: linearize-push ( node -- )
compute-free-vregs
>#push< dup length dup ensure-vregs
alloc-reg# [ <vreg> ] map
[ [ load-literal ] 2each ] keep
phantom-d get phantom-append ;
M: #push linearize* ( #push -- )
linearize-push iterate-next ;
M: #if linearize* ( node -- next ) M: #if linearize* ( node -- next )
{ { 0 "flag" } } { } [ { { 0 "flag" } } { } [
end-basic-block end-basic-block

View File

@ -20,18 +20,24 @@ namespaces prettyprint sequences vectors words ;
dup shuffle-in-d length neg phantom-d get adjust-phantom dup shuffle-in-d length neg phantom-d get adjust-phantom
shuffle-in-r length neg phantom-r get adjust-phantom ; shuffle-in-r length neg phantom-r get adjust-phantom ;
: sufficient-shuffle-vregs? ( shuffle -- ? ) : shuffle-vregs# ( shuffle -- n )
dup shuffle-in-d length phantom-d get length - 0 max dup shuffle-in-d swap shuffle-in-r additional-vregs# ;
over shuffle-in-r length phantom-r get length - 0 max +
free-vregs get length <= ;
: phantom-shuffle ( shuffle -- ) : phantom-shuffle ( shuffle -- )
compute-free-vregs sufficient-shuffle-vregs? [ dup shuffle-vregs# ensure-vregs
end-basic-block compute-free-vregs
] unless
[ phantom-shuffle-inputs ] keep [ phantom-shuffle-inputs ] keep
[ shuffle* ] keep adjust-shuffle [ shuffle* ] keep adjust-shuffle
(template-outputs) ; (template-outputs) ;
M: #shuffle linearize* ( #shuffle -- ) M: #shuffle linearize* ( #shuffle -- )
node-shuffle phantom-shuffle iterate-next ; node-shuffle phantom-shuffle iterate-next ;
: linearize-push ( node -- )
compute-free-vregs
>#push< dup length dup ensure-vregs
alloc-reg# [ <vreg> ] map
[ [ load-literal ] 2each ] keep
phantom-d get phantom-append ;
M: #push linearize* ( #push -- )
linearize-push iterate-next ;

View File

@ -127,6 +127,8 @@ SYMBOL: phantom-r
2drop 2drop
] if ; ] if ;
: phantoms ( -- phantom phantom ) phantom-d get phantom-r get ;
: flush-locs ( phantom phantom -- ) : flush-locs ( phantom phantom -- )
[ [
2dup live-locs \ live-locs set 2dup live-locs \ live-locs set
@ -134,8 +136,7 @@ SYMBOL: phantom-r
] with-scope ; ] with-scope ;
: finalize-contents ( -- ) : finalize-contents ( -- )
phantom-d get phantom-r get phantoms 2dup flush-locs [ vregs>stack ] 2apply ;
2dup flush-locs vregs>stack vregs>stack ;
: end-basic-block ( -- ) : end-basic-block ( -- )
finalize-contents finalize-heights ; finalize-contents finalize-heights ;
@ -143,8 +144,7 @@ SYMBOL: phantom-r
SYMBOL: any-reg SYMBOL: any-reg
: used-vregs ( -- seq ) : used-vregs ( -- seq )
phantom-d get phantom-r get append phantoms append [ vreg? ] subset [ vreg-n ] map ;
[ vreg? ] subset [ vreg-n ] map ;
: compute-free-vregs ( -- ) : compute-free-vregs ( -- )
used-vregs vregs length reverse diff used-vregs vregs length reverse diff
@ -153,8 +153,6 @@ SYMBOL: any-reg
: requested-vregs ( template -- n ) : requested-vregs ( template -- n )
[ any-reg eq? ] subset length ; [ any-reg eq? ] subset length ;
: sufficient-vregs? ( n -- ? ) free-vregs get length <= ;
: template-vreg# ( template template -- n ) : template-vreg# ( template template -- n )
[ requested-vregs ] 2apply + ; [ requested-vregs ] 2apply + ;
@ -164,6 +162,18 @@ SYMBOL: any-reg
: alloc-reg# ( n -- regs ) : alloc-reg# ( n -- regs )
free-vregs [ cut ] change ; free-vregs [ cut ] change ;
: additional-vregs# ( seq seq -- n )
2array phantoms 2array [ [ length ] map ] 2apply v-
0 [ 0 max + ] reduce ;
: free-vregs* ( -- n )
free-vregs get length
phantoms [ [ loc? ] subset length ] 2apply + - ;
: ensure-vregs ( n -- )
compute-free-vregs free-vregs* <=
[ finalize-contents compute-free-vregs ] unless ;
: lazy-load ( value loc -- value ) : lazy-load ( value loc -- value )
over loc? over loc?
[ dupd = [ drop f ] [ stack>new-vreg ] if ] [ drop ] if ; [ dupd = [ drop f ] [ stack>new-vreg ] if ] [ drop ] if ;
@ -227,15 +237,12 @@ SYMBOL: any-reg
used-vregs free-vregs [ diff ] change ; used-vregs free-vregs [ diff ] change ;
: template-inputs ( template template -- ) : template-inputs ( template template -- )
compute-free-vregs 2dup additional-vregs# ensure-vregs
match-templates fast-input match-templates fast-input
adjust-free-vregs adjust-free-vregs
finalize-contents finalize-contents
slow-input ; slow-input ;
: drop-phantom ( -- )
end-basic-block -1 phantom-d get adjust-phantom ;
: phantom-append ( seq stack -- ) : phantom-append ( seq stack -- )
over length over adjust-phantom swap nappend ; over length over adjust-phantom swap nappend ;

View File

@ -16,6 +16,8 @@ math-internals namespaces test ;
[ 2 3 ] [ 3 [ 2 swap ] compile-1 ] unit-test [ 2 3 ] [ 3 [ 2 swap ] compile-1 ] unit-test
[ 2 1 3 4 ] [ 1 2 [ swap 3 4 ] compile-1 ] unit-test
[ 2 3 4 ] [ 3 [ 2 swap 4 ] compile-1 ] unit-test [ 2 3 4 ] [ 3 [ 2 swap 4 ] compile-1 ] unit-test
[ { 1 2 3 } { 1 4 3 } 3 3 ] [ { 1 2 3 } { 1 4 3 } 3 3 ]