] interleave nl ;
: block. ( bb -- )
- "=== Basic block #" write dup block-number . nl
+ "=== Basic block #" write dup number>> . nl
dup instructions>> [ insn. ] each nl
successors>> [
"Successors: " write
- [ block-number unparse ] map ", " join print nl
+ [ number>> unparse ] map ", " join print nl
] unless-empty ;
: cfg. ( cfg -- )
{ $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 } ;
-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
{ $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." } ;
0 get block>cfg linearization-order [ number>> ] map
] unit-test
-! (linearization-order)
-{ { 10 20 30 } } [
+: two-successors-cfg ( -- cfg )
V{ } 10 insns>block
[ V{ } 20 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
{ { 0 1 2 3 4 5 } } [
V{ } 10 insns>block [ process-block ] V{ } make
[ number>> ] map
] unit-test
+
+! number-blocks
+{ { 0 1 2 } } [
+ two-successors-cfg linearization-order dup number-blocks [ number>> ] map
+] unit-test
]
} cleave ;
-SYMBOL: numbers
-
-: block-number ( bb -- n ) numbers get at ;
-
: number-blocks ( bbs -- )
- H{ } zip-index-as numbers set ;
+ [ >>number drop ] each-index ;
: blocks>insns ( bbs -- insns )
[ instructions>> ] map concat ;
labels get [ drop <label> ] cache ;
: useless-branch? ( bb successor -- ? )
- ! If our successor immediately follows us in linearization
- ! order then we don't need to branch.
- [ block-number ] bi@ 1 - = ; inline
+ [ number>> ] bi@ 1 - = ; inline
: emit-branch ( bb successor -- )
2dup useless-branch?