steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

compiler.cfg.*: changing height-state from a 2-el array to a tuple 

This way, it is a little easier to see what is going on in the local
analysis phase.
char-rename
Björn Lindqvist 2016-09-06 15:44:07 +02:00
parent 11ec120c2d
commit c640e3b8c1
8 changed files with 88 additions and 63 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
basis/compiler/cfg/builder/blocks/blocks-tests.factor
View File

@ -22,9 +22,10 @@ IN: compiler.cfg.builder.blocks.tests
! emit-call-block ! emit-call-block
{ {
V{ T{ ##call { word 2drop } } } V{ T{ ##call { word 2drop } } }
{ { -2 -2 } { 0 0 } } T{ height-state f 0 0 -2 0 }
} [ } [
\ 2drop -2 <basic-block> [ emit-call-block ] V{ } make height-state get \ 2drop -2 <basic-block> [ emit-call-block ] V{ } make
height-state get
] cfg-unit-test ] cfg-unit-test
! emit-trivial-block ! emit-trivial-block

4
basis/compiler/cfg/builder/blocks/blocks.factor
View File

@ -38,13 +38,13 @@ SLOT: out-d
[ word>> ] [ call-height ] bi emit-trivial-call ; [ word>> ] [ call-height ] bi emit-trivial-call ;
: begin-branch ( block -- block' ) : begin-branch ( block -- block' )
height-state [ clone-height-state ] change (begin-basic-block) ; height-state [ clone ] change (begin-basic-block) ;
: end-branch ( block/f -- pair/f ) : end-branch ( block/f -- pair/f )
dup [ dup [
##branch, ##branch,
end-local-analysis end-local-analysis
height-state get clone-height-state 2array height-state get clone 2array
] when* ; ] when* ;
: with-branch ( block quot: ( ..a block -- ..b block' ) -- pair/f ) : with-branch ( block quot: ( ..a block -- ..b block' ) -- pair/f )

7
basis/compiler/cfg/builder/builder-tests.factor
View File

@ -367,7 +367,7 @@ SYMBOL: foo
! ! #shuffle ! ! #shuffle
{ {
{ { 1 1 } { 0 0 } } T{ height-state f 0 0 1 0 }
H{ { D: -1 4 } { D: 0 4 } } H{ { D: -1 4 } { D: 0 4 } }
} [ } [
4 D: 0 replace-loc 4 D: 0 replace-loc
@ -398,6 +398,11 @@ SYMBOL: foo
<basic-block> dup set-basic-block end-word instructions>> <basic-block> dup set-basic-block end-word instructions>>
] unit-test ] unit-test
! height-changes
{ { -2 0 } } [
T{ #shuffle { in-d { 37 81 92 } } { out-d { 20 } } } height-changes
] unit-test
! make-input-map ! make-input-map
{ {
{ { 37 D: 2 } { 81 D: 1 } { 92 D: 0 } } { { 37 D: 2 } { 81 D: 1 } { 92 D: 0 } }

36
basis/compiler/cfg/stacks/local/local-docs.factor
View File

@ -12,7 +12,29 @@ HELP: end-local-analysis
{ $description "Called to end the local analysis of a block. The word fills in the blocks slots " { $slot "replaces" } ", " { $slot "peeks" } " and " { $slot "kills" } " with what the blocks replaces, peeks and kill locations are." } ; { $description "Called to end the local analysis of a block. The word fills in the blocks slots " { $slot "replaces" } ", " { $slot "peeks" } " and " { $slot "kills" } " with what the blocks replaces, peeks and kill locations are." } ;
HELP: height-state HELP: height-state
{ $var-description "A two-tuple used to keep track of the heights of the data and retain stacks in a " { $link basic-block } " The idea is that if the stack change instructions are tracked, then multiple changes can be folded into one. The first item is the datastacks current height and queued up height change. The second item is the same for the retain stack." } ; { $description "A tuple which keeps track of the stacks heights and increments of a " { $link basic-block } " during local analysis. The idea is that if the stack change instructions are tracked, then multiple changes can be folded into one. It has the following slots:"
{ $table
{
{ $slot "ds-begin" }
"Datastack height at the beginning of the block."
}
{
{ $slot "rs-begin" }
"Retainstack height at the beginning of the block."
}
{
{ $slot "ds-inc" }
"Datastack change during the block."
}
{
{ $slot "rs-inc" }
"Retainstack change during the block."
}
}
}
{ $see-also inc-stack reset-incs } ;
! { $var-description "A two-tuple used to keep track of the heights of the data and retain stacks in a " { $link basic-block } " The idea is that if the stack change instructions are tracked, then multiple changes can be folded into one. The first item is the datastacks current height and queued up height change. The second item is the same for the retain stack." } ;
HELP: height-state>insns HELP: height-state>insns
{ $values { "state" sequence } { "insns" sequence } } { $values { "state" sequence } { "insns" sequence } }
@ -21,7 +43,7 @@ HELP: height-state>insns
"In this example the datastacks height is increased by 4 and the retainstacks decreased by 2." "In this example the datastacks height is increased by 4 and the retainstacks decreased by 2."
{ $example { $example
"USING: compiler.cfg.stacks.local prettyprint ;" "USING: compiler.cfg.stacks.local prettyprint ;"
"{ { 0 4 } { 0 -2 } } height-state>insns ." "T{ height-state f 0 0 4 -2 } height-state>insns ."
"{ T{ ##inc { loc D: 4 } } T{ ##inc { loc R: -2 } } }" "{ T{ ##inc { loc D: 4 } } T{ ##inc { loc R: -2 } } }"
} }
} ; } ;
@ -64,13 +86,13 @@ HELP: replaces
{ $var-description "An " { $link assoc } " that maps from stack locations to virtual registers that were put on the stack during the local analysis phase. " { $link ds-push } " and similar words writes to it." } { $var-description "An " { $link assoc } " that maps from stack locations to virtual registers that were put on the stack during the local analysis phase. " { $link ds-push } " and similar words writes to it." }
{ $see-also replace-loc } ; { $see-also replace-loc } ;
HELP: translate-local-loc HELP: global-loc>local
{ $values { "loc" loc } { "state" "height state" } { "loc'" loc } } { $values { "loc" loc } { "height-state" height-state } { "loc'" loc } }
{ $description "Translates an absolute stack location to one that is relative to the given height state." } { $description "Translates an absolute stack location to one that is relative to the given height state." }
{ $examples { $examples
{ $example { $example
"USING: compiler.cfg.stacks.local compiler.cfg.registers namespaces prettyprint ;" "USING: compiler.cfg.stacks.local compiler.cfg.registers namespaces prettyprint ;"
"D: 7 { { 3 0 } { 0 0 } } translate-local-loc ." "D: 7 T{ height-state f 3 0 0 0 } global-loc>local ."
"D: 4" "D: 4"
} }
} }
@ -88,11 +110,11 @@ $nl
"Words for reading the stack state:" "Words for reading the stack state:"
{ $subsections { $subsections
peek-loc peek-loc
translate-local-loc } global-loc>local
}
"Words for writing the stack state:" "Words for writing the stack state:"
{ $subsections { $subsections
inc-stack inc-stack
modify-height
replace-loc replace-loc
} }
"Beginning and ending analysis:" "Beginning and ending analysis:"

27
basis/compiler/cfg/stacks/local/local-tests.factor
View File

@ -85,46 +85,41 @@ IN: compiler.cfg.stacks.local.tests
] cfg-unit-test ] cfg-unit-test
! compute-local-kill-set ! compute-local-kill-set
{ 0 } [ { HS{ } } [
V{ } 0 insns>block 0 0 pick record-stack-heights 0 0 0 0 height-state boa compute-local-kill-set
compute-local-kill-set sets:cardinality
] unit-test ] unit-test
{ HS{ R: -4 } } [ { HS{ R: -4 } } [
V{ } 0 insns>block 4 4 pick record-stack-heights 0 4 0 -1 height-state boa compute-local-kill-set
{ { 8 0 } { 3 0 } } height-state set
compute-local-kill-set
] unit-test ] unit-test
{ HS{ D: -1 D: -2 } } [ { HS{ D: -1 D: -2 } } [
V{ } 0 insns>block [ 2 0 rot record-stack-heights ] keep 2 0 -2 0 height-state boa compute-local-kill-set
{ { 0 0 } { 0 0 } } height-state set ] unit-test
compute-local-kill-set
] cfg-unit-test
! translate-local-loc ! global-loc>local
{ D: 2 } [ { D: 2 } [
D: 3 { { 1 2 } { 3 4 } } translate-local-loc D: 3 1 0 0 0 height-state boa global-loc>local
] unit-test ] unit-test
! height-state ! height-state
{ {
{ { 3 3 } { 0 0 } } T{ height-state f 0 0 3 0 }
} [ } [
D: 3 inc-stack height-state get D: 3 inc-stack height-state get
] cfg-unit-test ] cfg-unit-test
{ {
{ { 5 3 } { 0 0 } } T{ height-state f 2 0 3 0 }
} [ } [
{ { 2 0 } { 0 0 } } height-state set 2 0 0 0 height-state boa height-state set
D: 3 inc-stack height-state get D: 3 inc-stack height-state get
] cfg-unit-test ] cfg-unit-test
{ {
{ T{ ##inc { loc D: 4 } } T{ ##inc { loc R: -2 } } } { T{ ##inc { loc D: 4 } } T{ ##inc { loc R: -2 } } }
} [ } [
{ { 0 4 } { 0 -2 } } height-state>insns 0 0 4 -2 height-state boa height-state>insns
] unit-test ] unit-test
{ H{ { D: -1 40 } } } [ { H{ { D: -1 40 } } } [

66
basis/compiler/cfg/stacks/local/local.factor
View File

@ -1,47 +1,46 @@
! Copyright (C) 2009 Slava Pestov. ! Copyright (C) 2009 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs compiler.cfg.instructions USING: accessors arrays assocs combinators compiler.cfg.instructions
compiler.cfg.parallel-copy compiler.cfg.registers hash-sets kernel compiler.cfg.parallel-copy compiler.cfg.registers fry hash-sets kernel
make math math.order namespaces sequences sets ; make math math.order namespaces sequences sets ;
IN: compiler.cfg.stacks.local IN: compiler.cfg.stacks.local
: current-height ( state -- ds rs ) TUPLE: height-state ds-begin rs-begin ds-inc rs-inc ;
first2 [ first ] bi@ ;
: >loc< ( loc -- n ds? ) : >loc< ( loc -- n ds? )
[ n>> ] [ ds-loc? ] bi ; [ n>> ] [ ds-loc? ] bi ;
: modify-height ( state loc -- ) : ds-height ( height-state -- n )
>loc< 0 1 ? rot nth [ + ] with map! drop ; [ ds-begin>> ] [ ds-inc>> ] bi + ;
: reset-emits ( state -- ) : rs-height ( height-state -- n )
[ 0 1 rot set-nth ] each ; [ rs-begin>> ] [ rs-inc>> ] bi + ;
: height-state>insns ( state -- insns ) : global-loc>local ( loc height-state -- loc' )
[ second ] map { ds-loc rs-loc } [ new swap >>n ] 2map [ clone dup >loc< ] dip swap [ ds-height ] [ rs-height ] if - >>n ;
: inc-stack ( loc -- )
>loc< height-state get swap
[ [ + ] change-ds-inc ] [ [ + ] change-rs-inc ] if drop ;
: height-state>insns ( height-state -- insns )
[ ds-inc>> ds-loc ] [ rs-inc>> rs-loc ] bi [ new swap >>n ] 2bi@ 2array
[ n>> 0 = ] reject [ ##inc new swap >>loc ] map ; [ n>> 0 = ] reject [ ##inc new swap >>loc ] map ;
: translate-local-loc ( loc state -- loc' ) : reset-incs ( height-state -- )
[ clone ] dip over >loc< 0 1 ? rot nth first - >>n ; dup ds-inc>> '[ _ + ] change-ds-begin
dup rs-inc>> '[ _ + ] change-rs-begin
0 >>ds-inc 0 >>rs-inc drop ;
: clone-height-state ( state -- state' ) : kill-locations ( begin-height current-height -- seq )
[ clone ] map ;
: initial-height-state ( -- state )
{ { 0 0 } { 0 0 } } clone-height-state ;
: kill-locations ( saved-height height -- seq )
dupd [-] iota [ swap - ] with map ; dupd [-] iota [ swap - ] with map ;
: local-kill-set ( ds-height rs-height state -- set ) : local-kill-set ( ds-begin rs-begin ds-current rs-current -- set )
current-height swapd [ kill-locations ] 2bi@ swapd [ kill-locations ] 2bi@
[ [ <ds-loc> ] map ] [ [ <rs-loc> ] map ] bi* [ [ <ds-loc> ] map ] [ [ <rs-loc> ] map ] bi*
append >hash-set ; append >hash-set ;
SYMBOLS: height-state locs>vregs local-peek-set replaces ; SYMBOLS: locs>vregs local-peek-set replaces ;
: inc-stack ( loc -- )
height-state get swap modify-height ;
: loc>vreg ( loc -- vreg ) locs>vregs get [ drop next-vreg ] cache ; : loc>vreg ( loc -- vreg ) locs>vregs get [ drop next-vreg ] cache ;
: vreg>loc ( vreg -- loc/f ) locs>vregs get value-at ; : vreg>loc ( vreg -- loc/f ) locs>vregs get value-at ;
@ -56,21 +55,24 @@ SYMBOLS: height-state locs>vregs local-peek-set replaces ;
building get pop -rot changes>insns % , ; building get pop -rot changes>insns % , ;
: peek-loc ( loc -- vreg ) : peek-loc ( loc -- vreg )
height-state get translate-local-loc dup replaces get at height-state get global-loc>local
dup replaces get at
[ ] [ dup local-peek-set get adjoin loc>vreg ] ?if ; [ ] [ dup local-peek-set get adjoin loc>vreg ] ?if ;
: replace-loc ( vreg loc -- ) : replace-loc ( vreg loc -- )
height-state get translate-local-loc replaces get set-at ; height-state get global-loc>local
replaces get set-at ;
: record-stack-heights ( ds-height rs-height bb -- ) : record-stack-heights ( ds-height rs-height bb -- )
[ rs-height<< ] keep ds-height<< ; [ rs-height<< ] keep ds-height<< ;
: compute-local-kill-set ( basic-block -- set ) : compute-local-kill-set ( height-state -- set )
[ ds-height>> ] [ rs-height>> ] bi height-state get local-kill-set ; { [ ds-begin>> ] [ rs-begin>> ] [ ds-height ] [ rs-height ] } cleave
local-kill-set ;
: begin-local-analysis ( basic-block -- ) : begin-local-analysis ( basic-block -- )
height-state get dup reset-emits height-state get reset-incs
current-height rot record-stack-heights height-state get [ ds-height ] [ rs-height ] bi rot record-stack-heights
HS{ } clone local-peek-set namespaces:set HS{ } clone local-peek-set namespaces:set
H{ } clone replaces namespaces:set ; H{ } clone replaces namespaces:set ;
@ -84,4 +86,4 @@ SYMBOLS: height-state locs>vregs local-peek-set replaces ;
] unless ] unless
keys >hash-set >>replaces keys >hash-set >>replaces
local-peek-set get >>peeks local-peek-set get >>peeks
dup compute-local-kill-set >>kills drop ; height-state get compute-local-kill-set >>kills drop ;

4
basis/compiler/cfg/stacks/stacks-tests.factor
View File

@ -6,7 +6,7 @@ IN: compiler.cfg.stacks.tests
! store-vregs ! store-vregs
{ {
H{ { D: 1 4 } { D: 2 3 } { D: 0 5 } } H{ { D: 1 4 } { D: 2 3 } { D: 0 5 } }
{ { 0 0 } { 0 0 } } T{ height-state f 0 0 0 0 }
} [ } [
{ 3 4 5 } ds-loc store-vregs { 3 4 5 } ds-loc store-vregs
replaces get replaces get
@ -29,7 +29,7 @@ IN: compiler.cfg.stacks.tests
{ {
1 1
2 2
{ { -2 -2 } { 0 0 } } T{ height-state f 0 0 -2 0 }
} [ } [
2inputs height-state get 2inputs height-state get
] cfg-unit-test ] cfg-unit-test

2
basis/compiler/cfg/stacks/stacks.factor
View File

@ -8,7 +8,7 @@ IN: compiler.cfg.stacks
: begin-stack-analysis ( -- ) : begin-stack-analysis ( -- )
<bihash> locs>vregs set <bihash> locs>vregs set
initial-height-state height-state set ; 0 0 0 0 height-state boa height-state set ;
: end-stack-analysis ( cfg -- ) : end-stack-analysis ( cfg -- )
{ {