diff --git a/basis/compiler/cfg/checker/checker.factor b/basis/compiler/cfg/checker/checker.factor index 22b6f03231..07e6cc8cea 100644 --- a/basis/compiler/cfg/checker/checker.factor +++ b/basis/compiler/cfg/checker/checker.factor @@ -59,7 +59,7 @@ ERROR: undefined-values uses defs ; ! Check that every used register has a definition instructions>> [ [ uses-vregs ] map concat ] - [ [ [ defs-vregs ] [ temp-vregs ] bi append ] map concat ] bi + [ [ [ temp-vregs ] [ defs-vreg ] bi [ suffix ] when* ] map concat ] bi 2dup subset? [ 2drop ] [ undefined-values ] if ; : check-cfg ( cfg -- ) diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor index d4d6ce8289..1c9ac90f78 100644 --- a/basis/compiler/cfg/def-use/def-use.factor +++ b/basis/compiler/cfg/def-use/def-use.factor @@ -4,14 +4,14 @@ USING: accessors arrays kernel assocs sequences namespaces fry sets compiler.cfg.rpo compiler.cfg.instructions ; IN: compiler.cfg.def-use -GENERIC: defs-vregs ( insn -- seq ) +GENERIC: defs-vreg ( insn -- vreg/f ) GENERIC: temp-vregs ( insn -- seq ) GENERIC: uses-vregs ( insn -- seq ) -M: ##flushable defs-vregs dst>> 1array ; -M: ##fixnum-overflow defs-vregs dst>> 1array ; -M: _fixnum-overflow defs-vregs dst>> 1array ; -M: insn defs-vregs drop f ; +M: ##flushable defs-vreg dst>> ; +M: ##fixnum-overflow defs-vreg dst>> ; +M: _fixnum-overflow defs-vreg dst>> ; +M: insn defs-vreg drop f ; M: ##write-barrier temp-vregs [ card#>> ] [ table>> ] bi 2array ; M: ##unary/temp temp-vregs temp>> 1array ; @@ -50,55 +50,48 @@ M: _compare-imm-branch uses-vregs src1>> 1array ; M: _dispatch uses-vregs src>> 1array ; M: insn uses-vregs drop f ; -! Computing def-use chains. We don't assume a program is in SSA form, -! since SSA construction itself needs def-use information. defs-1 -! is only useful if the program is SSA. -SYMBOLS: defs defs-1 insns uses ; +! Computing def-use chains. -: def-of ( vreg -- node ) defs-1 get at ; -: defs-of ( vreg -- nodes ) defs get at ; +SYMBOLS: defs insns uses ; + +: def-of ( vreg -- node ) defs get at ; : uses-of ( vreg -- nodes ) uses get at ; : insn-of ( vreg -- insn ) insns get at ; -> [ - @ [ - _ conjoin-at - ] with each + _ set-def-of ] with each ] each-basic-block ] keep - [ keys ] assoc-map ; inline - -PRIVATE> - -: compute-defs ( cfg -- ) - [ defs-vregs ] (compute-def-use) - [ defs set ] [ [ first ] assoc-map defs-1 set ] bi ; - -: compute-uses ( cfg -- ) - [ uses-vregs ] (compute-def-use) uses set ; + defs set ; : compute-insns ( cfg -- ) H{ } clone [ '[ instructions>> [ - dup defs-vregs [ - _ set-at - ] with each + dup _ set-def-of ] each ] each-basic-block ] keep insns set ; +: compute-uses ( cfg -- ) + H{ } clone [ + '[ + dup instructions>> [ + uses-vregs [ + _ conjoin-at + ] with each + ] with each + ] each-basic-block + ] keep + [ keys ] assoc-map + uses set ; + : compute-def-use ( cfg -- ) [ compute-defs ] [ compute-uses ] [ compute-insns ] tri ; \ No newline at end of file diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor index 370f562fc4..3664f58b1e 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -86,7 +86,9 @@ GENERIC: assign-registers-in-insn ( insn -- ) [ [ vreg>> ] [ reg>> ] bi ] H{ } map>assoc ; : all-vregs ( insn -- vregs ) - [ defs-vregs ] [ temp-vregs ] [ uses-vregs ] tri 3append ; + [ [ temp-vregs ] [ uses-vregs ] bi append ] + [ defs-vreg ] bi + [ suffix ] when* ; SYMBOL: check-assignment? diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor index 8813a4e94e..77aae14503 100644 --- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor +++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor @@ -98,7 +98,7 @@ M: insn compute-live-intervals* drop ; M: vreg-insn compute-live-intervals* dup insn#>> live-intervals get - [ [ defs-vregs ] 2dip '[ [ _ ] dip _ handle-output ] each ] + [ [ defs-vreg ] 2dip '[ [ _ ] dip _ handle-output ] when* ] [ [ uses-vregs ] 2dip '[ [ _ ] dip _ handle-input ] each ] [ [ temp-vregs ] 2dip '[ [ _ ] dip _ handle-temp ] each ] 3tri ; diff --git a/basis/compiler/cfg/liveness/liveness.factor b/basis/compiler/cfg/liveness/liveness.factor index eef9296b4b..6c67769a45 100644 --- a/basis/compiler/cfg/liveness/liveness.factor +++ b/basis/compiler/cfg/liveness/liveness.factor @@ -13,7 +13,7 @@ BACKWARD-ANALYSIS: live GENERIC: insn-liveness ( live-set insn -- ) : kill-defs ( live-set insn -- live-set ) - defs-vregs [ over delete-at ] each ; + defs-vreg [ over delete-at ] when* ; : gen-uses ( live-set insn -- live-set ) dup ##phi? [ drop ] [ uses-vregs [ over conjoin ] each ] if ; diff --git a/basis/compiler/cfg/ssa/construction/construction.factor b/basis/compiler/cfg/ssa/construction/construction.factor index b6aea8bb17..3bbbb887f0 100644 --- a/basis/compiler/cfg/ssa/construction/construction.factor +++ b/basis/compiler/cfg/ssa/construction/construction.factor @@ -26,6 +26,27 @@ IN: compiler.cfg.ssa.construction ] 2tri + [ defs-multi get conjoin ] [ drop ] if + ] [ 2drop ] if ; + +: compute-defs ( cfg -- ) + H{ } clone defs set + H{ } clone defs-multi set + [ + dup instructions>> [ + compute-insn-defs + ] with each + ] each-basic-block ; + ! Maps basic blocks to sequences of vregs SYMBOL: inserting-phi-nodes @@ -36,15 +57,11 @@ SYMBOL: inserting-phi-nodes ] [ 2drop ] if ; : compute-phi-nodes-for ( vreg bbs -- ) - dup length 2 >= [ - [ - insert-phi-node-later - ] with merge-set-each - ] [ 2drop ] if ; + keys [ insert-phi-node-later ] with merge-set-each ; : compute-phi-nodes ( -- ) H{ } clone inserting-phi-nodes set - defs get [ compute-phi-nodes-for ] assoc-each ; + defs-multi get defs get '[ _ at compute-phi-nodes-for ] assoc-each ; : insert-phi-nodes-in ( phis bb -- ) [ append ] change-instructions drop ; diff --git a/basis/compiler/cfg/ssa/destruction/forest/forest.factor b/basis/compiler/cfg/ssa/destruction/forest/forest.factor index 8226e2787b..a196be13cb 100644 --- a/basis/compiler/cfg/ssa/destruction/forest/forest.factor +++ b/basis/compiler/cfg/ssa/destruction/forest/forest.factor @@ -10,7 +10,7 @@ TUPLE: dom-forest-node vreg bb children ; assoc [ [ second pre-of ] compare ] sort ; diff --git a/basis/compiler/cfg/ssa/destruction/live-ranges/live-ranges.factor b/basis/compiler/cfg/ssa/destruction/live-ranges/live-ranges.factor index 5a976f29ab..536f5e1e68 100644 --- a/basis/compiler/cfg/ssa/destruction/live-ranges/live-ranges.factor +++ b/basis/compiler/cfg/ssa/destruction/live-ranges/live-ranges.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs fry kernel namespaces sequences math -compiler.cfg.def-use compiler.cfg.instructions +arrays compiler.cfg.def-use compiler.cfg.instructions compiler.cfg.liveness compiler.cfg.rpo ; IN: compiler.cfg.ssa.destruction.live-ranges @@ -11,8 +11,8 @@ IN: compiler.cfg.ssa.destruction.live-ranges SYMBOLS: local-def-indices local-kill-indices ; -: record-defs ( n vregs -- ) - local-def-indices get '[ _ set-at ] with each ; +: record-def ( n vregs -- ) + dup [ local-def-indices get set-at ] [ 2drop ] if ; : record-uses ( n vregs -- ) local-kill-indices get '[ _ set-at ] with each ; @@ -24,9 +24,9 @@ SYMBOLS: local-def-indices local-kill-indices ; ! this instruction and before the next one, ensuring that outputs ! interfere with inputs. 2 * - [ swap defs-vregs record-defs ] + [ swap defs-vreg record-def ] [ swap uses-vregs record-uses ] - [ over def-is-use-insn? [ 1 + swap defs-vregs record-uses ] [ 2drop ] if ] + [ over def-is-use-insn? [ 1 + swap defs-vreg 1array record-uses ] [ 2drop ] if ] 2tri ; SYMBOLS: def-indices kill-indices ;