51 lines
		
	
	
		
			1.3 KiB
		
	
	
	
		
			Factor
		
	
	
		
		
			
		
	
	
			51 lines
		
	
	
		
			1.3 KiB
		
	
	
	
		
			Factor
		
	
	
|  | ! Copyright (C) 2008 Slava Pestov. | ||
|  | ! See http://factorcode.org/license.txt for BSD license. | ||
|  | USING: kernel math accessors sequences namespaces | ||
|  | compiler.cfg compiler.vops compiler.lvops ;
 | ||
|  | IN: compiler.machine.builder | ||
|  | 
 | ||
|  | SYMBOL: block-counter | ||
|  | 
 | ||
|  | : number-basic-block ( basic-block -- )
 | ||
|  |     #! Make this fancy later. | ||
|  |     dup number>> [ drop ] [ | ||
|  |         block-counter [ dup 1+ ] change >>number | ||
|  |         [ , ] [ | ||
|  |             successors>> <reversed>
 | ||
|  |             [ number-basic-block ] each
 | ||
|  |         ] bi
 | ||
|  |     ] if ;
 | ||
|  | 
 | ||
|  | : flatten-basic-blocks ( procedure -- blocks )
 | ||
|  |     [ | ||
|  |         0 block-counter | ||
|  |         [ number-basic-block ] | ||
|  |         with-variable
 | ||
|  |     ] { } make ;
 | ||
|  | 
 | ||
|  | GENERIC: linearize-instruction ( basic-block insn -- )
 | ||
|  | 
 | ||
|  | M: object linearize-instruction | ||
|  |     , drop ;
 | ||
|  | 
 | ||
|  | M: %b linearize-instruction | ||
|  |     drop successors>> first number>> _b emit ;
 | ||
|  | 
 | ||
|  | : conditional-branch ( basic-block insn class -- )
 | ||
|  |     [ successors>> ] 2dip
 | ||
|  |     [ [ first number>> ] [ [ in>> ] [ code>> ] bi ] [ ] tri* emit ] | ||
|  |     [ 2drop second number>> _b emit ] | ||
|  |     3bi ; inline
 | ||
|  | 
 | ||
|  | M: %bi linearize-instruction _bi conditional-branch ;
 | ||
|  | M: %bf linearize-instruction _bf conditional-branch ;
 | ||
|  | 
 | ||
|  | : build-mr ( procedure -- insns )
 | ||
|  |     [ | ||
|  |         flatten-basic-blocks [ | ||
|  |             [ number>> _label emit ] | ||
|  |             [ dup instructions>> [ linearize-instruction ] with each ] | ||
|  |             bi
 | ||
|  |         ] each
 | ||
|  |     ] { } make ;
 |