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 -- )
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? ;
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
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 ;
! 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 ;
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 ;
: 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 ;
-! 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
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
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 ;
: 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