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