compiler.cfg.linearization: number-blocks can set the number>> accessor
instead of using the numbers dynamic variabledb4
parent
614595bd9a
commit
d0aae5cc20
|
@ -59,11 +59,11 @@ M: insn insn. tuple>array but-last [
|
||||||
] interleave nl ;
|
] interleave nl ;
|
||||||
|
|
||||||
: block. ( bb -- )
|
: block. ( bb -- )
|
||||||
"=== Basic block #" write dup block-number . nl
|
"=== Basic block #" write dup number>> . nl
|
||||||
dup instructions>> [ insn. ] each nl
|
dup instructions>> [ insn. ] each nl
|
||||||
successors>> [
|
successors>> [
|
||||||
"Successors: " write
|
"Successors: " write
|
||||||
[ block-number unparse ] map ", " join print nl
|
[ number>> unparse ] map ", " join print nl
|
||||||
] unless-empty ;
|
] unless-empty ;
|
||||||
|
|
||||||
: cfg. ( cfg -- )
|
: cfg. ( cfg -- )
|
||||||
|
|
|
@ -10,10 +10,6 @@ HELP: linearization-order
|
||||||
{ $description "Lists the basic blocks in linearization order. That is, the order in which they will be written in the generated assembly code." }
|
{ $description "Lists the basic blocks in linearization order. That is, the order in which they will be written in the generated assembly code." }
|
||||||
{ $see-also generate reverse-post-order } ;
|
{ $see-also generate reverse-post-order } ;
|
||||||
|
|
||||||
HELP: block-number
|
|
||||||
{ $values { "bb" basic-block } { "n" integer } }
|
|
||||||
{ $description "Retrieves this blocks block number. Must not be called before " { $link number-blocks } "." } ;
|
|
||||||
|
|
||||||
HELP: number-blocks
|
HELP: number-blocks
|
||||||
{ $values { "bbs" sequence } }
|
{ $values { "bbs" sequence } }
|
||||||
{ $description "Associate each block with a block number and save the result in the " { $link numbers } " map." } ;
|
{ $description "Assigns the " { $slot "number" } " slot of each " { $link basic-block } " given it's sequence index." } ;
|
||||||
|
|
|
@ -17,12 +17,15 @@ V{ } 2 test-bb
|
||||||
0 get block>cfg linearization-order [ number>> ] map
|
0 get block>cfg linearization-order [ number>> ] map
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
! (linearization-order)
|
: two-successors-cfg ( -- cfg )
|
||||||
{ { 10 20 30 } } [
|
|
||||||
V{ } 10 insns>block
|
V{ } 10 insns>block
|
||||||
[ V{ } 20 insns>block connect-bbs ] keep
|
[ V{ } 20 insns>block connect-bbs ] keep
|
||||||
[ V{ } 30 insns>block connect-bbs ] keep
|
[ V{ } 30 insns>block connect-bbs ] keep
|
||||||
block>cfg (linearization-order) [ number>> ] map
|
block>cfg ;
|
||||||
|
|
||||||
|
! (linearization-order)
|
||||||
|
{ { 10 20 30 } } [
|
||||||
|
two-successors-cfg (linearization-order) [ number>> ] map
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
{ { 0 1 2 3 4 5 } } [
|
{ { 0 1 2 3 4 5 } } [
|
||||||
|
@ -43,3 +46,8 @@ V{ } 2 test-bb
|
||||||
V{ } 10 insns>block [ process-block ] V{ } make
|
V{ } 10 insns>block [ process-block ] V{ } make
|
||||||
[ number>> ] map
|
[ number>> ] map
|
||||||
] unit-test
|
] unit-test
|
||||||
|
|
||||||
|
! number-blocks
|
||||||
|
{ { 0 1 2 } } [
|
||||||
|
two-successors-cfg linearization-order dup number-blocks [ number>> ] map
|
||||||
|
] unit-test
|
||||||
|
|
|
@ -66,12 +66,8 @@ PRIVATE>
|
||||||
]
|
]
|
||||||
} cleave ;
|
} cleave ;
|
||||||
|
|
||||||
SYMBOL: numbers
|
|
||||||
|
|
||||||
: block-number ( bb -- n ) numbers get at ;
|
|
||||||
|
|
||||||
: number-blocks ( bbs -- )
|
: number-blocks ( bbs -- )
|
||||||
H{ } zip-index-as numbers set ;
|
[ >>number drop ] each-index ;
|
||||||
|
|
||||||
: blocks>insns ( bbs -- insns )
|
: blocks>insns ( bbs -- insns )
|
||||||
[ instructions>> ] map concat ;
|
[ instructions>> ] map concat ;
|
||||||
|
|
|
@ -23,9 +23,7 @@ SYMBOL: labels
|
||||||
labels get [ drop <label> ] cache ;
|
labels get [ drop <label> ] cache ;
|
||||||
|
|
||||||
: useless-branch? ( bb successor -- ? )
|
: useless-branch? ( bb successor -- ? )
|
||||||
! If our successor immediately follows us in linearization
|
[ number>> ] bi@ 1 - = ; inline
|
||||||
! order then we don't need to branch.
|
|
||||||
[ block-number ] bi@ 1 - = ; inline
|
|
||||||
|
|
||||||
: emit-branch ( bb successor -- )
|
: emit-branch ( bb successor -- )
|
||||||
2dup useless-branch?
|
2dup useless-branch?
|
||||||
|
|
Loading…
Reference in New Issue