insert-gc-checks
insert-save-contexts
destruct-ssa
- delete-empty-blocks
linear-scan ;
SYMBOL: spill-slots
: assign-spill-slot ( coalesced-vreg rep -- spill-slot )
+ dup tagged-rep? [ drop int-rep ] when
spill-slots get [ nip next-spill-slot ] 2cache ;
: lookup-spill-slot ( coalesced-vreg rep -- spill-slot )
+ dup tagged-rep? [ drop int-rep ] when
2array spill-slots get ?at [ ] [ bad-vreg ] if ;
: init-allocator ( registers -- )
compiler.cfg
compiler.cfg.def-use
compiler.cfg.liveness
+compiler.cfg.liveness.ssa
compiler.cfg.registers
compiler.cfg.instructions
+compiler.cfg.ssa.destruction
compiler.cfg.renaming.functor
compiler.cfg.linearization.order
compiler.cfg.linear-scan.allocation
: remove-pending ( live-interval -- )
vreg>> pending-interval-assoc get delete-at ;
-ERROR: bad-vreg vreg ;
-
-:: (vreg>reg) ( vreg pending -- reg )
+:: vreg>reg ( vreg -- reg )
! If a live vreg is not in the pending set, then it must
! have been spilled.
- vreg pending at* [
- drop vreg vreg rep-of lookup-spill-slot
+ vreg leader :> leader
+ leader pending-interval-assoc get at* [
+ drop leader vreg rep-of lookup-spill-slot
] unless ;
-: vreg>reg ( vreg -- reg )
- pending-interval-assoc get (vreg>reg) ;
-
: vregs>regs ( vregs -- assoc )
- dup assoc-empty? [
- pending-interval-assoc get
- '[ _ (vreg>reg) ] assoc-map
- ] unless ;
+ [ f ] [ [ dup vreg>reg ] H{ } map>assoc ] if-empty ;
! Minheap of live intervals which still need a register allocation
SYMBOL: unhandled-intervals
: init-unhandled ( live-intervals -- )
[ add-unhandled ] each ;
+! Liveness info is used by resolve pass
+
! Mapping from basic blocks to values which are live at the start
-SYMBOL: register-live-ins
+! on all incoming CFG edges
+SYMBOL: machine-live-ins
+
+: machine-live-in ( bb -- assoc )
+ machine-live-ins get at ;
+
+: compute-live-in ( bb -- )
+ [ live-in keys vregs>regs ] keep machine-live-ins get set-at ;
+
+! Mapping from basic blocks to predecessors to values which are
+! live on a particular incoming edge
+SYMBOL: machine-edge-live-ins
+
+: machine-edge-live-in ( predecessor bb -- assoc )
+ machine-edge-live-ins get at at ;
+
+: compute-edge-live-in ( bb -- )
+ [ edge-live-ins get at [ keys vregs>regs ] assoc-map ] keep
+ machine-edge-live-ins get set-at ;
! Mapping from basic blocks to values which are live at the end
-SYMBOL: register-live-outs
+SYMBOL: machine-live-outs
+
+: machine-live-out ( bb -- assoc )
+ machine-live-outs get at ;
+
+: compute-live-out ( bb -- )
+ [ live-out keys vregs>regs ] keep machine-live-outs get set-at ;
: init-assignment ( live-intervals -- )
<min-heap> pending-interval-heap set
H{ } clone pending-interval-assoc set
<min-heap> unhandled-intervals set
- H{ } clone register-live-ins set
- H{ } clone register-live-outs set
+ H{ } clone machine-live-ins set
+ H{ } clone machine-edge-live-ins set
+ H{ } clone machine-live-outs set
init-unhandled ;
: insert-spill ( live-interval -- )
M: insn assign-registers-in-insn drop ;
: begin-block ( bb -- )
- dup basic-block set
- dup block-from activate-new-intervals
- [ live-in vregs>regs ] keep register-live-ins get set-at ;
-
-: end-block ( bb -- )
- [ live-out vregs>regs ] keep register-live-outs get set-at ;
-
-: vreg-at-start ( vreg bb -- state )
- register-live-ins get at ?at [ bad-vreg ] unless ;
-
-: vreg-at-end ( vreg bb -- state )
- register-live-outs get at ?at [ bad-vreg ] unless ;
+ {
+ [ basic-block set ]
+ [ block-from activate-new-intervals ]
+ [ compute-edge-live-in ]
+ [ compute-live-in ]
+ } cleave ;
:: assign-registers-in-block ( bb -- )
bb [
[ , ]
} cleave
] each
- bb end-block
+ bb compute-live-out
] V{ } make
] change-instructions drop ;
-! Copyright (C) 2008, 2009 Slava Pestov.
+! Copyright (C) 2008, 2010 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel accessors namespaces make locals
cpu.architecture
compiler.cfg
compiler.cfg.rpo
-compiler.cfg.liveness
compiler.cfg.registers
compiler.cfg.instructions
compiler.cfg.linear-scan.numbering
! by Omri Traub, Glenn Holloway, Michael D. Smith
! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.34.8435
+! SSA liveness must have been computed already
+
:: (linear-scan) ( cfg machine-registers -- )
- cfg compute-live-sets
cfg number-instructions
cfg compute-live-intervals machine-registers allocate-registers
cfg assign-registers
! See http://factorcode.org/license.txt for BSD license.
USING: namespaces kernel assocs accessors locals sequences math
math.order fry combinators binary-search
-compiler.cfg.instructions compiler.cfg.registers
-compiler.cfg.def-use compiler.cfg.liveness
+compiler.cfg.instructions
+compiler.cfg.registers
+compiler.cfg.def-use
+compiler.cfg.liveness
compiler.cfg.linearization.order
+compiler.cfg.ssa.destruction
compiler.cfg
cpu.architecture ;
IN: compiler.cfg.linear-scan.live-intervals
[ drop ] [ [ from>> <=> ] with search nip ] 2bi
covers?
] if ;
-
+
: add-new-range ( from to live-interval -- )
[ <live-range> ] dip ranges>> push ;
SYMBOL: live-intervals
: live-interval ( vreg -- live-interval )
- live-intervals get [ dup rep-of reg-class-of <live-interval> ] cache ;
+ leader live-intervals get
+ [ dup rep-of reg-class-of <live-interval> ] cache ;
GENERIC: compute-live-intervals* ( insn -- )
M: insn compute-live-intervals* drop ;
-:: handle-output ( vreg n type -- )
+:: record-def ( vreg n type -- )
vreg rep-of :> rep
vreg live-interval :> live-interval
n live-interval shorten-range
rep n type live-interval add-use ;
-:: handle-input ( vreg n type -- )
+:: record-use ( vreg n type -- )
vreg rep-of :> rep
vreg live-interval :> live-interval
from get n live-interval add-range
rep n type live-interval add-use ;
-:: handle-temp ( vreg n -- )
+:: record-temp ( vreg n -- )
vreg rep-of :> rep
vreg live-interval :> live-interval
M:: vreg-insn compute-live-intervals* ( insn -- )
insn insn#>> :> n
- insn defs-vreg [ n +def+ handle-output ] when*
- insn uses-vregs [ n +use+ handle-input ] each
- insn temp-vregs [ n handle-temp ] each ;
+ insn defs-vreg [ n +def+ record-def ] when*
+ insn uses-vregs [ n +use+ record-use ] each
+ insn temp-vregs [ n record-temp ] each ;
M:: clobber-insn compute-live-intervals* ( insn -- )
insn insn#>> :> n
- insn defs-vreg [ n +use+ handle-output ] when*
- insn uses-vregs [ n +memory+ handle-input ] each
- insn temp-vregs [ n handle-temp ] each ;
+ insn defs-vreg [ n +use+ record-def ] when*
+ insn uses-vregs [ n +memory+ record-use ] each
+ insn temp-vregs [ n record-temp ] each ;
: handle-live-out ( bb -- )
live-out dup assoc-empty? [ drop ] [
compiler.cfg.instructions
compiler.cfg.predecessors
compiler.cfg.parallel-copy
+compiler.cfg.ssa.destruction
compiler.cfg.linear-scan.assignment
compiler.cfg.linear-scan.allocation.state ;
IN: compiler.cfg.linear-scan.resolve
: add-mapping ( from to rep -- )
'[ _ <location> ] bi@ 2array , ;
-:: resolve-value-data-flow ( bb to vreg -- )
- vreg bb vreg-at-end
- vreg to vreg-at-start
+:: resolve-value-data-flow ( vreg live-out live-in edge-live-in -- )
+ vreg live-out ?at [ bad-vreg ] unless
+ vreg live-in ?at [ edge-live-in ?at [ bad-vreg ] unless ] unless
2dup = [ 2drop ] [ vreg rep-of add-mapping ] if ;
-: compute-mappings ( bb to -- mappings )
- dup live-in dup assoc-empty? [ 3drop f ] [
- [ keys [ resolve-value-data-flow ] with with each ] { } make
+:: compute-mappings ( bb to -- mappings )
+ bb machine-live-out :> live-out
+ to machine-live-in :> live-in
+ bb to machine-edge-live-in :> edge-live-in
+ live-out assoc-empty? [ f ] [
+ [
+ live-in keys edge-live-in keys append [
+ live-out live-in edge-live-in
+ resolve-value-data-flow
+ ] each
+ ] { } make
] if ;
: memory->register ( from to -- )
--- /dev/null
+USING: accessors compiler.cfg compiler.cfg.debugger
+compiler.cfg.instructions compiler.cfg.liveness.ssa
+compiler.cfg.liveness arrays sequences assocs
+compiler.cfg.registers kernel namespaces tools.test ;
+IN: compiler.cfg.liveness.ssa.tests
+
+V{
+ T{ ##prologue }
+ T{ ##branch }
+} 0 test-bb
+
+V{
+ T{ ##branch }
+} 1 test-bb
+
+V{
+ T{ ##load-integer f 0 0 }
+ T{ ##branch }
+} 2 test-bb
+
+V{
+ T{ ##load-integer f 1 1 }
+ T{ ##branch }
+} 3 test-bb
+
+V{
+ T{ ##phi f 2 }
+ T{ ##branch }
+} 4 test-bb
+
+2 get 0 2array
+3 get 1 2array 2array
+4 get instructions>> first (>>inputs)
+
+V{
+ T{ ##branch }
+} 5 test-bb
+
+V{
+ T{ ##replace f 2 D 0 }
+ T{ ##branch }
+} 6 test-bb
+
+V{
+ T{ ##epilogue }
+ T{ ##return }
+} 7 test-bb
+
+0 1 edge
+1 { 2 3 } edges
+2 4 edge
+3 4 edge
+4 { 5 6 } edges
+5 6 edge
+6 7 edge
+
+[ ] [ cfg new 0 get >>entry dup cfg set compute-ssa-live-sets ] unit-test
+
+[ t ] [ 0 get live-in assoc-empty? ] unit-test
+
+[ H{ { 2 2 } } ] [ 4 get live-out ] unit-test
+
+[ H{ { 0 0 } } ] [ 2 get 4 get edge-live-in ] unit-test
+
+[ H{ { 1 1 } } ] [ 3 get 4 get edge-live-in ] unit-test
! Assoc mapping basic blocks to sequences of sets of vregs; each sequence
! is in correspondence with a predecessor
-SYMBOL: phi-live-ins
+SYMBOL: edge-live-ins
-: phi-live-in ( predecessor basic-block -- set ) phi-live-ins get at at ;
+: edge-live-in ( predecessor basic-block -- set ) edge-live-ins get at at ;
SYMBOL: work-list
: compute-live-in ( basic-block -- live-in )
[ live-out ] keep instructions>> transfer-liveness ;
-: compute-phi-live-in ( basic-block -- phi-live-in )
+: 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-phi-live-in ] keep phi-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>> [ phi-live-in ] with map ] bi
+ [ dup successors>> [ edge-live-in ] with map ] bi
append assoc-combine ;
: update-live-out ( basic-block -- changed? )
<hashed-dlist> work-list set
H{ } clone live-ins set
- H{ } clone phi-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 ;
USING: accessors arrays assocs fry kernel namespaces
sequences sequences.deep
sets vectors
+cpu.architecture
compiler.cfg.rpo
compiler.cfg.def-use
-compiler.cfg.renaming
compiler.cfg.registers
compiler.cfg.dominance
compiler.cfg.instructions
FROM: namespaces => set ;
IN: compiler.cfg.ssa.destruction
-! Maps vregs to leaders.
+! Because of the design of the register allocator, this pass
+! has three peculiar properties.
+!
+! 1) Instead of renaming vreg usages in the CFG, a map from
+! vregs to canonical representatives is computed. This allows
+! the register allocator to use the original SSA names to get
+! reaching definitions.
+! 2) Useless ##copy instructions, and all ##phi instructions,
+! are eliminated, so the register allocator does not have to
+! remove any redundant operations.
+! 3) A side effect of running this pass is that SSA liveness
+! information is computed, so the register allocator does not
+! need to compute it again.
+
SYMBOL: leader-map
: leader ( vreg -- vreg' ) leader-map get compress-path ;
-! Maps basic blocks to ##phi instruction outputs
-SYMBOL: phi-sets
-
-: phi-set ( bb -- vregs ) phi-sets get at ;
-
! Maps leaders to equivalence class elements.
SYMBOL: class-element-map
: class-elements ( vreg -- elts ) class-element-map get at ;
+<PRIVATE
+
! Sequence of vreg pairs
SYMBOL: copies
: init-coalescing ( -- )
- H{ } clone leader-map set
- H{ } clone class-element-map set
+ defs get keys
+ [ [ dup ] H{ } map>assoc leader-map set ]
+ [ [ dup 1vector ] H{ } map>assoc class-element-map set ] bi
V{ } clone copies set ;
: classes-interfere? ( vreg1 vreg2 -- ? )
2bi
] if ;
-: introduce-vreg ( vreg -- )
- [ leader-map get conjoin ]
- [ [ 1vector ] keep class-element-map get set-at ] bi ;
-
GENERIC: prepare-insn ( insn -- )
: try-to-coalesce ( dst src -- ) 2array copies get push ;
M: insn prepare-insn
- [ defs-vreg ] [ uses-vregs ] bi
- 2dup empty? not and [
- first
- 2dup [ rep-of ] bi@ eq?
- [ try-to-coalesce ] [ 2drop ] if
- ] [ 2drop ] if ;
+ [ temp-vregs [ leader-map get conjoin ] each ]
+ [
+ [ defs-vreg ] [ uses-vregs ] bi
+ 2dup empty? not and [
+ first
+ 2dup [ rep-of ] bi@ eq?
+ [ try-to-coalesce ] [ 2drop ] if
+ ] [ 2drop ] if
+ ] bi ;
M: ##copy prepare-insn
[ dst>> ] [ src>> ] bi try-to-coalesce ;
+M: ##tagged>integer prepare-insn
+ [ dst>> ] [ src>> ] bi eliminate-copy ;
+
M: ##phi prepare-insn
[ dst>> ] [ inputs>> values ] bi
[ eliminate-copy ] with each ;
: prepare-coalescing ( cfg -- )
init-coalescing
- defs get keys [ introduce-vreg ] each
[ prepare-block ] each-basic-block ;
: process-copies ( -- )
[ 2drop ] [ eliminate-copy ] if
] assoc-each ;
-GENERIC: rename-insn ( insn -- keep? )
+GENERIC: useful-insn? ( insn -- ? )
-M: vreg-insn rename-insn
- [ rename-insn-defs ] [ rename-insn-uses ] bi t ;
+: useful-copy? ( insn -- ? )
+ [ dst>> leader ] [ src>> leader ] bi eq? not ; inline
-M: ##copy rename-insn
- [ call-next-method drop ]
- [ [ dst>> ] [ src>> ] bi eq? not ] bi ;
+M: ##copy useful-insn? useful-copy? ;
-SYMBOL: current-phi-set
+M: ##tagged>integer useful-insn? useful-copy? ;
-M: ##phi rename-insn dst>> current-phi-set get push f ;
+M: ##phi useful-insn? drop f ;
-M: ##call-gc rename-insn
- [ renamings get '[ _ at ] map members ] change-gc-roots drop t ;
+M: insn useful-insn? drop t ;
-M: insn rename-insn drop t ;
+: cleanup-block ( bb -- )
+ instructions>> [ useful-insn? ] filter! drop ;
-: renaming-in-block ( bb -- )
- V{ } clone current-phi-set set
- [ [ current-phi-set ] dip phi-sets get set-at ]
- [ instructions>> [ rename-insn ] filter! drop ]
- bi ;
+: cleanup-cfg ( cfg -- )
+ [ cleanup-block ] each-basic-block ;
-: perform-renaming ( cfg -- )
- H{ } clone phi-sets set
- leader-map get keys [ dup leader ] H{ } map>assoc renamings set
- [ renaming-in-block ] each-basic-block ;
+PRIVATE>
: destruct-ssa ( cfg -- cfg' )
needs-dominance
dup compute-live-ranges
dup prepare-coalescing
process-copies
- dup perform-renaming ;
+ dup cleanup-cfg ;
M:: x86.32 %call-gc ( gc-roots -- )
4 save-vm-ptr
- EAX gc-roots gc-root-offsets %load-reference
- 0 stack@ EAX MOV
+ 0 stack@ gc-roots gc-root-offsets %load-reference
"inline_gc" f %alien-invoke ;
M: x86.32 dummy-stack-params? f ;
projects / factor.git / commitdiff