112 lines
3.1 KiB
Factor
112 lines
3.1 KiB
Factor
! Copyright (C) 2009, 2010 Slava Pestov.
|
|
! See http://factorcode.org/license.txt for BSD license.
|
|
USING: kernel accessors assocs fry deques dlists namespaces
|
|
sequences sets compiler.cfg compiler.cfg.def-use
|
|
compiler.cfg.instructions compiler.cfg.registers
|
|
compiler.cfg.utilities compiler.cfg.predecessors
|
|
compiler.cfg.rpo cpu.architecture ;
|
|
FROM: namespaces => set ;
|
|
IN: compiler.cfg.liveness
|
|
|
|
! See http://en.wikipedia.org/wiki/Liveness_analysis
|
|
|
|
SYMBOL: live-ins
|
|
|
|
: live-in ( bb -- set )
|
|
live-ins get at ;
|
|
|
|
SYMBOL: live-outs
|
|
|
|
: live-out ( bb -- set )
|
|
live-outs get at ;
|
|
|
|
! Assoc mapping basic blocks to sequences of sets of vregs; each
|
|
! sequence is in correspondence with a predecessor
|
|
SYMBOL: edge-live-ins
|
|
|
|
: edge-live-in ( predecessor basic-block -- set )
|
|
edge-live-ins get at at ;
|
|
|
|
GENERIC: visit-insn ( live-set insn -- live-set )
|
|
|
|
: kill-defs ( live-set insn -- live-set )
|
|
defs-vregs [ over delete-at ] each ; inline
|
|
|
|
: gen-uses ( live-set insn -- live-set )
|
|
uses-vregs [ over conjoin ] each ; inline
|
|
|
|
M: vreg-insn visit-insn [ kill-defs ] [ gen-uses ] bi ;
|
|
|
|
! Our liveness analysis annotates call sites with GC maps
|
|
! indicating the spill slots in the stack frame that contain
|
|
! tagged pointers, and thus have to be visited if a GC occurs
|
|
! inside the call.
|
|
|
|
: fill-gc-map ( live-set insn -- live-set )
|
|
representations get [
|
|
gc-map>> over keys
|
|
[ rep-of tagged-rep? ] filter
|
|
>>gc-roots
|
|
] when
|
|
drop ;
|
|
|
|
M: gc-map-insn visit-insn
|
|
[ kill-defs ] [ fill-gc-map ] [ gen-uses ] tri ;
|
|
|
|
M: ##phi visit-insn kill-defs ;
|
|
|
|
M: insn visit-insn drop ;
|
|
|
|
: transfer-liveness ( live-set instructions -- live-set' )
|
|
[ clone ] [ <reversed> ] bi* [ visit-insn ] each ;
|
|
|
|
: local-live-in ( instructions -- live-set )
|
|
[ H{ } ] dip transfer-liveness keys ;
|
|
|
|
SYMBOL: work-list
|
|
|
|
: add-to-work-list ( basic-blocks -- )
|
|
work-list get '[ _ push-front ] each ;
|
|
|
|
: compute-live-in ( basic-block -- live-in )
|
|
[ live-out ] keep instructions>> transfer-liveness ;
|
|
|
|
: compute-edge-live-in ( basic-block -- edge-live-in )
|
|
H{ } clone [
|
|
'[ inputs>> [ swap _ conjoin-at ] assoc-each ] each-phi
|
|
] keep ;
|
|
|
|
: update-live-in ( basic-block -- changed? )
|
|
[ [ compute-live-in ] keep live-ins get maybe-set-at ]
|
|
[ [ compute-edge-live-in ] keep edge-live-ins get maybe-set-at ]
|
|
bi or ;
|
|
|
|
: compute-live-out ( basic-block -- live-out )
|
|
[ successors>> [ live-in ] map ]
|
|
[ dup successors>> [ edge-live-in ] with map ] bi
|
|
append assoc-combine ;
|
|
|
|
: update-live-out ( basic-block -- changed? )
|
|
[ compute-live-out ] keep
|
|
live-outs get maybe-set-at ;
|
|
|
|
: liveness-step ( basic-block -- )
|
|
dup update-live-out [
|
|
dup update-live-in
|
|
[ predecessors>> add-to-work-list ] [ drop ] if
|
|
] [ drop ] if ;
|
|
|
|
: compute-live-sets ( cfg -- )
|
|
needs-predecessors
|
|
|
|
<hashed-dlist> work-list set
|
|
H{ } clone live-ins set
|
|
H{ } clone edge-live-ins set
|
|
H{ } clone live-outs set
|
|
post-order add-to-work-list
|
|
work-list get [ liveness-step ] slurp-deque ;
|
|
|
|
: live-in? ( vreg bb -- ? ) live-in key? ;
|
|
|
|
: live-out? ( vreg bb -- ? ) live-out key? ;
|