compiler.cfg: more silly optimizations
							parent
							
								
									1a61c50896
								
							
						
					
					
						commit
						5ecd2b61c7
					
				| 
						 | 
				
			
			@ -49,9 +49,11 @@ M: ##write-barrier-imm build-liveness-graph
 | 
			
		|||
M: ##allot build-liveness-graph
 | 
			
		||||
    [ dst>> allocations get adjoin ] [ call-next-method ] bi ;
 | 
			
		||||
 | 
			
		||||
M: insn build-liveness-graph
 | 
			
		||||
M: vreg-insn build-liveness-graph
 | 
			
		||||
    dup defs-vreg dup [ add-edges ] [ 2drop ] if ;
 | 
			
		||||
 | 
			
		||||
M: insn build-liveness-graph drop ;
 | 
			
		||||
 | 
			
		||||
GENERIC: compute-live-vregs ( insn -- )
 | 
			
		||||
 | 
			
		||||
: (record-live) ( vregs -- )
 | 
			
		||||
| 
						 | 
				
			
			@ -87,9 +89,11 @@ M: ##fixnum-sub compute-live-vregs record-live ;
 | 
			
		|||
 | 
			
		||||
M: ##fixnum-mul compute-live-vregs record-live ;
 | 
			
		||||
 | 
			
		||||
M: insn compute-live-vregs
 | 
			
		||||
M: vreg-insn compute-live-vregs
 | 
			
		||||
    dup defs-vreg [ drop ] [ record-live ] if ;
 | 
			
		||||
 | 
			
		||||
M: insn compute-live-vregs drop ;
 | 
			
		||||
 | 
			
		||||
GENERIC: live-insn? ( insn -- ? )
 | 
			
		||||
 | 
			
		||||
M: ##set-slot live-insn? obj>> live-vreg? ;
 | 
			
		||||
| 
						 | 
				
			
			@ -106,7 +110,9 @@ M: ##fixnum-sub live-insn? drop t ;
 | 
			
		|||
 | 
			
		||||
M: ##fixnum-mul live-insn? drop t ;
 | 
			
		||||
 | 
			
		||||
M: insn live-insn? defs-vreg [ live-vreg? ] [ t ] if* ;
 | 
			
		||||
M: vreg-insn live-insn? defs-vreg [ live-vreg? ] [ t ] if* ;
 | 
			
		||||
 | 
			
		||||
M: insn live-insn? defs-vreg drop t ;
 | 
			
		||||
 | 
			
		||||
: eliminate-dead-code ( cfg -- cfg' )
 | 
			
		||||
    ! Even though we don't use predecessors directly, we depend
 | 
			
		||||
| 
						 | 
				
			
			@ -116,7 +122,7 @@ M: insn live-insn? defs-vreg [ live-vreg? ] [ t ] if* ;
 | 
			
		|||
 | 
			
		||||
    init-dead-code
 | 
			
		||||
    dup
 | 
			
		||||
    [ [ instructions>> [ build-liveness-graph ] each ] each-basic-block ]
 | 
			
		||||
    [ [ instructions>> [ compute-live-vregs ] each ] each-basic-block ]
 | 
			
		||||
    [ [ instructions>> [ live-insn? ] filter! drop ] each-basic-block ]
 | 
			
		||||
    [ [ [ build-liveness-graph ] each ] simple-analysis ]
 | 
			
		||||
    [ [ [ compute-live-vregs ] each ] simple-analysis ]
 | 
			
		||||
    [ [ [ live-insn? ] filter! ] simple-optimization ]
 | 
			
		||||
    tri ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -22,7 +22,8 @@ IN: compiler.cfg.gc-checks
 | 
			
		|||
! can contain tagged pointers.
 | 
			
		||||
 | 
			
		||||
: insert-gc-check? ( bb -- ? )
 | 
			
		||||
    instructions>> [ ##allocation? ] any? ;
 | 
			
		||||
    dup kill-block?>>
 | 
			
		||||
    [ drop f ] [ instructions>> [ ##allocation? ] any? ] if ;
 | 
			
		||||
 | 
			
		||||
: blocks-with-gc ( cfg -- bbs )
 | 
			
		||||
    post-order [ insert-gc-check? ] filter ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -89,15 +89,13 @@ M: ##copy conversions-for-insn , ;
 | 
			
		|||
 | 
			
		||||
M: insn conversions-for-insn , ;
 | 
			
		||||
 | 
			
		||||
: conversions-for-block ( bb -- )
 | 
			
		||||
: conversions-for-block ( insns -- insns )
 | 
			
		||||
    [
 | 
			
		||||
        [
 | 
			
		||||
            alternatives get clear-assoc
 | 
			
		||||
            [ conversions-for-insn ] each
 | 
			
		||||
        ] V{ } make
 | 
			
		||||
    ] change-instructions drop ;
 | 
			
		||||
        alternatives get clear-assoc
 | 
			
		||||
        [ conversions-for-insn ] each
 | 
			
		||||
    ] V{ } make ;
 | 
			
		||||
 | 
			
		||||
: insert-conversions ( cfg -- )
 | 
			
		||||
    H{ } clone alternatives set
 | 
			
		||||
    V{ } clone renaming-set set
 | 
			
		||||
    [ conversions-for-block ] each-basic-block ;
 | 
			
		||||
    [ conversions-for-block ] simple-optimization ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -44,5 +44,13 @@ SYMBOL: visited
 | 
			
		|||
: simple-optimization ( ... cfg quot: ( ... insns -- ... insns' ) -- ... )
 | 
			
		||||
    '[ _ optimize-basic-block ] each-basic-block ; inline
 | 
			
		||||
 | 
			
		||||
: analyze-basic-block ( bb quot -- )
 | 
			
		||||
    over kill-block?>> [ 2drop ] [
 | 
			
		||||
        [ dup basic-block set instructions>> ] dip call
 | 
			
		||||
    ] if ; inline
 | 
			
		||||
 | 
			
		||||
: simple-analysis ( ... cfg quot: ( ... insns -- ... ) -- ... )
 | 
			
		||||
    '[ _ analyze-basic-block ] each-basic-block ; inline
 | 
			
		||||
 | 
			
		||||
: needs-post-order ( cfg -- cfg' )
 | 
			
		||||
    dup post-order drop ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1,4 +1,4 @@
 | 
			
		|||
! Copyright (C) 2009 Slava Pestov.
 | 
			
		||||
! Copyright (C) 2009, 2010 Slava Pestov.
 | 
			
		||||
! See http://factorcode.org/license.txt for BSD license.
 | 
			
		||||
USING: namespaces kernel accessors sequences fry assocs
 | 
			
		||||
sets math combinators
 | 
			
		||||
| 
						 | 
				
			
			@ -42,10 +42,9 @@ SYMBOL: defs-multi
 | 
			
		|||
    H{ } clone defs set
 | 
			
		||||
    H{ } clone defs-multi set
 | 
			
		||||
    [
 | 
			
		||||
        dup instructions>> [
 | 
			
		||||
            compute-insn-defs
 | 
			
		||||
        ] with each
 | 
			
		||||
    ] each-basic-block ;
 | 
			
		||||
        [ basic-block get ] dip
 | 
			
		||||
        [ compute-insn-defs ] with each
 | 
			
		||||
    ] simple-analysis ;
 | 
			
		||||
 | 
			
		||||
! Maps basic blocks to sequences of vregs
 | 
			
		||||
SYMBOL: inserting-phi-nodes
 | 
			
		||||
| 
						 | 
				
			
			@ -88,7 +87,9 @@ RENAMING: ssa-rename [ gen-name ] [ top-name ] [ ]
 | 
			
		|||
 | 
			
		||||
GENERIC: rename-insn ( insn -- )
 | 
			
		||||
 | 
			
		||||
M: insn rename-insn
 | 
			
		||||
M: insn rename-insn drop ;
 | 
			
		||||
 | 
			
		||||
M: vreg-insn rename-insn
 | 
			
		||||
    [ ssa-rename-insn-uses ]
 | 
			
		||||
    [ ssa-rename-insn-defs ]
 | 
			
		||||
    bi ;
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -76,7 +76,9 @@ GENERIC: prepare-insn ( insn -- )
 | 
			
		|||
 | 
			
		||||
: try-to-coalesce ( dst src -- ) 2array copies get push ;
 | 
			
		||||
 | 
			
		||||
M: insn prepare-insn
 | 
			
		||||
M: insn prepare-insn drop ;
 | 
			
		||||
 | 
			
		||||
M: vreg-insn prepare-insn
 | 
			
		||||
    [ temp-vregs [ leader-map get conjoin ] each ]
 | 
			
		||||
    [
 | 
			
		||||
        [ defs-vreg ] [ uses-vregs ] bi
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue