diff --git a/basis/calendar/unix/unix.factor b/basis/calendar/unix/unix.factor index 9848d0c164..aa4e8f7e9a 100644 --- a/basis/calendar/unix/unix.factor +++ b/basis/calendar/unix/unix.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: alien alien.c-types alien.syntax arrays calendar -kernel math unix unix.time namespaces system ; +kernel math unix unix.time unix.types namespaces system ; IN: calendar.unix : timeval>seconds ( timeval -- seconds ) @@ -19,7 +19,7 @@ IN: calendar.unix timespec>seconds since-1970 ; : get-time ( -- alien ) - f time localtime ; + f time localtime ; : timezone-name ( -- string ) get-time tm-zone ; diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis.factor b/basis/compiler/cfg/alias-analysis/alias-analysis.factor index d0bb792f72..f6834c131d 100644 --- a/basis/compiler/cfg/alias-analysis/alias-analysis.factor +++ b/basis/compiler/cfg/alias-analysis/alias-analysis.factor @@ -3,8 +3,7 @@ USING: kernel math namespaces assocs hashtables sequences arrays accessors vectors combinators sets classes compiler.cfg compiler.cfg.registers compiler.cfg.instructions -compiler.cfg.copy-prop compiler.cfg.rpo -compiler.cfg.liveness compiler.cfg.local ; +compiler.cfg.copy-prop compiler.cfg.rpo compiler.cfg.liveness ; IN: compiler.cfg.alias-analysis ! We try to eliminate redundant slot operations using some simple heuristics. @@ -197,7 +196,7 @@ M: ##set-slot insn-object obj>> resolve ; M: ##set-slot-imm insn-object obj>> resolve ; M: ##alien-global insn-object drop \ ##alien-global ; -: init-alias-analysis ( live-in -- ) +: init-alias-analysis ( insns -- insns' ) H{ } clone histories set H{ } clone vregs>acs set H{ } clone acs>vregs set @@ -208,7 +207,7 @@ M: ##alien-global insn-object drop \ ##alien-global ; 0 ac-counter set next-ac heap-ac set - [ set-heap-ac ] each ; + dup local-live-in [ set-heap-ac ] each ; GENERIC: analyze-aliases* ( insn -- insn' ) @@ -280,9 +279,10 @@ M: insn eliminate-dead-stores* ; [ insn# set eliminate-dead-stores* ] map-index sift ; : alias-analysis-step ( insns -- insns' ) + init-alias-analysis analyze-aliases compute-live-stores eliminate-dead-stores ; : alias-analysis ( cfg -- cfg' ) - [ init-alias-analysis ] [ alias-analysis-step ] local-optimization ; \ No newline at end of file + [ alias-analysis-step ] local-optimization ; \ No newline at end of file diff --git a/basis/compiler/cfg/checker/checker.factor b/basis/compiler/cfg/checker/checker.factor index 49ea775600..2f8077be99 100644 --- a/basis/compiler/cfg/checker/checker.factor +++ b/basis/compiler/cfg/checker/checker.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel compiler.cfg.instructions compiler.cfg.rpo -compiler.cfg.def-use compiler.cfg.linearization compiler.cfg.liveness +compiler.cfg.def-use compiler.cfg.linearization combinators.short-circuit accessors math sequences sets assocs ; IN: compiler.cfg.checker @@ -54,8 +54,6 @@ ERROR: undefined-values uses defs ; 2dup subset? [ 2drop ] [ undefined-values ] if ; : check-cfg ( cfg -- ) - compute-liveness - [ entry>> live-in assoc-empty? [ bad-live-in ] unless ] [ [ check-basic-block ] each-basic-block ] [ flatten-cfg check-mr ] - tri ; + bi ; diff --git a/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor new file mode 100644 index 0000000000..c38f43da8a --- /dev/null +++ b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor @@ -0,0 +1,140 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors assocs deques dlists kernel locals sequences lexer +namespaces functors compiler.cfg.rpo compiler.cfg.utilities +compiler.cfg ; +IN: compiler.cfg.dataflow-analysis + +GENERIC: join-sets ( sets dfa -- set ) +GENERIC: transfer-set ( in-set bb dfa -- out-set ) +GENERIC: block-order ( cfg dfa -- bbs ) +GENERIC: successors ( bb dfa -- seq ) +GENERIC: predecessors ( bb dfa -- seq ) + + ( cfg dfa -- queue ) + block-order [ push-all-front ] keep ; + +GENERIC# compute-in-set 2 ( bb out-sets dfa -- set ) + +! M: kill-block compute-in-set 3drop f ; + +M:: basic-block compute-in-set ( bb out-sets dfa -- set ) + bb dfa predecessors [ out-sets at ] map dfa join-sets ; + +:: update-in-set ( bb in-sets out-sets dfa -- ? ) + bb out-sets dfa compute-in-set + bb in-sets maybe-set-at ; inline + +GENERIC# compute-out-set 2 ( bb out-sets dfa -- set ) + +! M: kill-block compute-out-set 3drop f ; + +M:: basic-block compute-out-set ( bb in-sets dfa -- set ) + bb in-sets at bb dfa transfer-set ; + +:: update-out-set ( bb in-sets out-sets dfa -- ? ) + bb in-sets dfa compute-out-set + bb out-sets maybe-set-at ; inline + +:: dfa-step ( bb in-sets out-sets dfa work-list -- ) + bb in-sets out-sets dfa update-in-set [ + bb in-sets out-sets dfa update-out-set [ + bb dfa successors work-list push-all-front + ] when + ] when ; inline + +:: run-dataflow-analysis ( cfg dfa -- in-sets out-sets ) + H{ } clone :> in-sets + H{ } clone :> out-sets + cfg dfa :> work-list + work-list [ in-sets out-sets dfa work-list dfa-step ] slurp-deque + in-sets + out-sets ; inline + +M: dataflow-analysis join-sets drop assoc-refine ; + +FUNCTOR: define-analysis ( name -- ) + +name-analysis DEFINES-CLASS ${name}-analysis +name-ins DEFINES ${name}-ins +name-outs DEFINES ${name}-outs +name-in DEFINES ${name}-in +name-out DEFINES ${name}-out + +WHERE + +SINGLETON: name-analysis + +SYMBOL: name-ins + +: name-in ( bb -- set ) name-ins get at ; + +SYMBOL: name-outs + +: name-out ( bb -- set ) name-outs get at ; + +;FUNCTOR + +! ! ! Forward dataflow analysis + +MIXIN: forward-analysis +INSTANCE: forward-analysis dataflow-analysis + +M: forward-analysis block-order drop reverse-post-order ; +M: forward-analysis successors drop successors>> ; +M: forward-analysis predecessors drop predecessors>> ; + +FUNCTOR: define-forward-analysis ( name -- ) + +name-analysis IS ${name}-analysis +name-ins IS ${name}-ins +name-outs IS ${name}-outs +compute-name-sets DEFINES compute-${name}-sets + +WHERE + +INSTANCE: name-analysis forward-analysis + +: compute-name-sets ( cfg -- ) + name-analysis run-dataflow-analysis + [ name-ins set ] [ name-outs set ] bi* ; + +;FUNCTOR + +! ! ! Backward dataflow analysis + +MIXIN: backward-analysis +INSTANCE: backward-analysis dataflow-analysis + +M: backward-analysis block-order drop post-order ; +M: backward-analysis successors drop predecessors>> ; +M: backward-analysis predecessors drop successors>> ; + +FUNCTOR: define-backward-analysis ( name -- ) + +name-analysis IS ${name}-analysis +name-ins IS ${name}-ins +name-outs IS ${name}-outs +compute-name-sets DEFINES compute-${name}-sets + +WHERE + +INSTANCE: name-analysis backward-analysis + +: compute-name-sets ( cfg -- ) + \ name-analysis run-dataflow-analysis + [ name-outs set ] [ name-ins set ] bi* ; + +;FUNCTOR + +PRIVATE> + +SYNTAX: FORWARD-ANALYSIS: + scan [ define-analysis ] [ define-forward-analysis ] bi ; + +SYNTAX: BACKWARD-ANALYSIS: + scan [ define-analysis ] [ define-backward-analysis ] bi ; diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor index e355ee2ac1..18f1b3be76 100644 --- a/basis/compiler/cfg/debugger/debugger.factor +++ b/basis/compiler/cfg/debugger/debugger.factor @@ -7,7 +7,7 @@ parser compiler.tree.builder compiler.tree.optimizer compiler.cfg.builder compiler.cfg.linearization compiler.cfg.registers compiler.cfg.stack-frame compiler.cfg.linear-scan compiler.cfg.two-operand -compiler.cfg.liveness compiler.cfg.optimizer +compiler.cfg.optimizer compiler.cfg.mr compiler.cfg ; IN: compiler.cfg.debugger diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor index c8a9d1861b..d7bfc56b32 100644 --- a/basis/compiler/cfg/def-use/def-use.factor +++ b/basis/compiler/cfg/def-use/def-use.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays kernel assocs compiler.cfg.instructions ; +USING: accessors arrays kernel assocs sequences +sets compiler.cfg.instructions ; IN: compiler.cfg.def-use GENERIC: defs-vregs ( insn -- seq ) @@ -62,3 +63,12 @@ UNION: vreg-insn _conditional-branch _compare-imm-branch _dispatch ; + +: map-unique ( seq quot -- assoc ) + map concat unique ; inline + +: gen-set ( instructions -- seq ) + [ uses-vregs ] map-unique ; + +: kill-set ( instructions -- seq ) + [ defs-vregs ] map-unique ; diff --git a/basis/compiler/cfg/dominance/dominance-tests.factor b/basis/compiler/cfg/dominance/dominance-tests.factor new file mode 100644 index 0000000000..e884e32d78 --- /dev/null +++ b/basis/compiler/cfg/dominance/dominance-tests.factor @@ -0,0 +1,97 @@ +IN: compiler.cfg.dominance.tests +USING: tools.test sequences vectors namespaces kernel accessors assocs sets +math.ranges arrays compiler.cfg compiler.cfg.dominance compiler.cfg.debugger +compiler.cfg.predecessors ; + +: test-dominance ( -- ) + cfg new 0 get >>entry + compute-predecessors + compute-dominance ; + +! Example with no back edges +V{ } 0 test-bb +V{ } 1 test-bb +V{ } 2 test-bb +V{ } 3 test-bb +V{ } 4 test-bb +V{ } 5 test-bb + +0 get 1 get 2 get V{ } 2sequence >>successors drop +1 get 3 get 1vector >>successors drop +2 get 4 get 1vector >>successors drop +3 get 4 get 1vector >>successors drop +4 get 5 get 1vector >>successors drop + +[ ] [ test-dominance ] unit-test + +[ t ] [ 0 get dom-parent 0 get eq? ] unit-test +[ t ] [ 1 get dom-parent 0 get eq? ] unit-test +[ t ] [ 2 get dom-parent 0 get eq? ] unit-test +[ t ] [ 4 get dom-parent 0 get eq? ] unit-test +[ t ] [ 3 get dom-parent 1 get eq? ] unit-test +[ t ] [ 5 get dom-parent 4 get eq? ] unit-test + +[ t ] [ 0 get dom-children 1 get 2 get 4 get 3array set= ] unit-test + +[ { 4 } ] [ 1 get dom-frontier [ number>> ] map ] unit-test +[ { 4 } ] [ 2 get dom-frontier [ number>> ] map ] unit-test +[ { } ] [ 0 get dom-frontier ] unit-test +[ { } ] [ 4 get dom-frontier ] unit-test + +! Example from the paper +V{ } 0 test-bb +V{ } 1 test-bb +V{ } 2 test-bb +V{ } 3 test-bb +V{ } 4 test-bb + +0 get 1 get 2 get V{ } 2sequence >>successors drop +1 get 3 get 1vector >>successors drop +2 get 4 get 1vector >>successors drop +3 get 4 get 1vector >>successors drop +4 get 3 get 1vector >>successors drop + +[ ] [ test-dominance ] unit-test + +[ t ] [ 0 4 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test + +! The other example from the paper +V{ } 0 test-bb +V{ } 1 test-bb +V{ } 2 test-bb +V{ } 3 test-bb +V{ } 4 test-bb +V{ } 5 test-bb + +0 get 1 get 2 get V{ } 2sequence >>successors drop +1 get 5 get 1vector >>successors drop +2 get 4 get 3 get V{ } 2sequence >>successors drop +5 get 4 get 1vector >>successors drop +4 get 5 get 3 get V{ } 2sequence >>successors drop +3 get 4 get 1vector >>successors drop + +[ ] [ test-dominance ] unit-test + +[ t ] [ 0 5 [a,b] [ get dom-parent 0 get eq? ] all? ] unit-test + +V{ } 0 test-bb +V{ } 1 test-bb +V{ } 2 test-bb +V{ } 3 test-bb +V{ } 4 test-bb +V{ } 5 test-bb +V{ } 6 test-bb + +0 get 1 get 5 get V{ } 2sequence >>successors drop +1 get 2 get 3 get V{ } 2sequence >>successors drop +2 get 4 get 1vector >>successors drop +3 get 4 get 1vector >>successors drop +4 get 6 get 1vector >>successors drop +5 get 6 get 1vector >>successors drop + +[ ] [ test-dominance ] unit-test + +[ t ] [ + 2 get 3 get 2array iterated-dom-frontier + 4 get 6 get 2array set= +] unit-test \ No newline at end of file diff --git a/basis/compiler/cfg/dominance/dominance.factor b/basis/compiler/cfg/dominance/dominance.factor index 750a46ee6c..73d9f58eec 100644 --- a/basis/compiler/cfg/dominance/dominance.factor +++ b/basis/compiler/cfg/dominance/dominance.factor @@ -1,8 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors assocs combinators compiler.cfg.rpo -compiler.cfg.stack-analysis fry kernel math.order namespaces -sequences ; +USING: accessors assocs combinators sets math fry kernel math.order +dlists deques namespaces sequences sorting compiler.cfg.rpo ; IN: compiler.cfg.dominance ! Reference: @@ -11,31 +10,106 @@ IN: compiler.cfg.dominance ! Keith D. Cooper, Timothy J. Harvey, and Ken Kennedy ! http://www.cs.rice.edu/~keith/EMBED/dom.pdf -SYMBOL: idoms - -: idom ( bb -- bb' ) idoms get at ; +! Also, a nice overview is given in these lecture notes: +! http://llvm.cs.uiuc.edu/~vadve/CS526/public_html/Notes/4ssa.4up.pdf idom(bb) +SYMBOL: dom-parents + +PRIVATE> + +: dom-parent ( bb -- bb' ) dom-parents get at ; + +> ] compare { - { +lt+ [ [ idom ] dip intersect ] } - { +gt+ [ idom intersect ] } + { +gt+ [ [ dom-parent ] dip intersect ] } + { +lt+ [ dom-parent intersect ] } [ 2drop ] } case ; : compute-idom ( bb -- idom ) - predecessors>> [ idom ] map sift + predecessors>> [ dom-parent ] filter [ ] [ intersect ] map-reduce ; : iterate ( rpo -- changed? ) [ [ compute-idom ] keep set-idom ] map [ ] any? ; +: compute-dom-parents ( cfg -- ) + H{ } clone dom-parents set + reverse-post-order + unclip dup set-idom drop '[ _ iterate ] loop ; + +! Maps bb -> {bb' | idom(bb') = bb} +SYMBOL: dom-childrens + PRIVATE> -: compute-dominance ( cfg -- cfg ) - H{ } clone idoms set - dup reverse-post-order - unclip dup set-idom drop '[ _ iterate ] loop ; \ No newline at end of file +: dom-children ( bb -- seq ) dom-childrens get at ; + + DF(bb) +SYMBOL: dom-frontiers + +PRIVATE> + +: dom-frontier ( bb -- set ) dom-frontiers get at keys ; + +> dup length 2 >= [ + [ compute-dom-frontier ] with each + ] [ 2drop ] if + ] each-basic-block ; + +PRIVATE> + +: compute-dominance ( cfg -- ) + [ compute-dom-parents compute-dom-children ] + [ compute-dom-frontiers ] + bi ; + + + +: iterated-dom-frontier ( bbs -- bbs' ) + [ + work-list set + H{ } clone visited set + [ add-to-work-list ] each + work-list get [ iterated-dom-frontier-step ] slurp-deque + visited get keys + ] with-scope ; \ 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 98deca9472..8e21e7e3fb 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -4,6 +4,7 @@ USING: accessors kernel math assocs namespaces sequences heaps fry make combinators sets locals cpu.architecture compiler.cfg +compiler.cfg.rpo compiler.cfg.def-use compiler.cfg.liveness compiler.cfg.registers @@ -185,6 +186,6 @@ ERROR: bad-vreg vreg ; ] V{ } make ] change-instructions drop ; -: assign-registers ( live-intervals rpo -- ) +: assign-registers ( live-intervals cfg -- ) [ init-assignment ] dip - [ assign-registers-in-block ] each ; + [ assign-registers-in-block ] each-basic-block ; diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index df521c1988..7362d185b4 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -7,7 +7,6 @@ compiler.cfg compiler.cfg.optimizer compiler.cfg.instructions compiler.cfg.registers -compiler.cfg.liveness compiler.cfg.predecessors compiler.cfg.rpo compiler.cfg.linearization @@ -1507,9 +1506,7 @@ SYMBOL: linear-scan-result [ cfg new 0 get >>entry compute-predecessors - compute-liveness - dup reverse-post-order - { { int-regs regs } } (linear-scan) + dup { { int-regs regs } } (linear-scan) cfg-changed flatten-cfg 1array mr. ] with-scope ; @@ -2331,9 +2328,6 @@ test-diamond ! early in bootstrap on x86-32 [ t ] [ [ - H{ } clone live-ins set - H{ } clone live-outs set - H{ } clone phi-live-ins set T{ basic-block { id 12345 } { instructions @@ -2353,7 +2347,8 @@ test-diamond T{ ##replace f V int-regs 5 D 0 } } } - } dup 1array { { int-regs V{ 0 1 2 3 } } } (linear-scan) + } cfg new over >>entry + { { int-regs V{ 0 1 2 3 } } } (linear-scan) instructions>> first live-values>> assoc-empty? ] with-scope diff --git a/basis/compiler/cfg/linear-scan/linear-scan.factor b/basis/compiler/cfg/linear-scan/linear-scan.factor index c17aa23e83..b081f2ca6e 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan.factor @@ -4,6 +4,7 @@ USING: kernel accessors namespaces make locals cpu.architecture compiler.cfg compiler.cfg.rpo +compiler.cfg.liveness compiler.cfg.instructions compiler.cfg.linear-scan.numbering compiler.cfg.linear-scan.live-intervals @@ -28,17 +29,18 @@ IN: compiler.cfg.linear-scan ! by Omri Traub, Glenn Holloway, Michael D. Smith ! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.34.8435 -:: (linear-scan) ( rpo machine-registers -- ) - rpo number-instructions - rpo compute-live-intervals machine-registers allocate-registers - rpo assign-registers - rpo resolve-data-flow - rpo check-numbering ; +:: (linear-scan) ( cfg machine-registers -- ) + cfg compute-live-sets + cfg number-instructions + cfg compute-live-intervals machine-registers allocate-registers + cfg assign-registers + cfg resolve-data-flow + cfg check-numbering ; : linear-scan ( cfg -- cfg' ) [ init-mapping - dup reverse-post-order machine-registers (linear-scan) + dup machine-registers (linear-scan) spill-counts get >>spill-counts cfg-changed ] with-scope ; 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 68a780d42a..8813a4e94e 100644 --- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor +++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. USING: namespaces kernel assocs accessors sequences math math.order fry combinators binary-search compiler.cfg.instructions compiler.cfg.registers -compiler.cfg.def-use compiler.cfg.liveness compiler.cfg ; +compiler.cfg.def-use compiler.cfg.liveness compiler.cfg.rpo +compiler.cfg ; IN: compiler.cfg.linear-scan.live-intervals TUPLE: live-range from to ; @@ -144,10 +145,10 @@ ERROR: bad-live-interval live-interval ; } cleave ] each ; -: compute-live-intervals ( rpo -- live-intervals ) +: compute-live-intervals ( cfg -- live-intervals ) H{ } clone [ live-intervals set - [ compute-live-intervals-step ] each + post-order [ compute-live-intervals-step ] each ] keep values dup finish-live-intervals ; : relevant-ranges ( interval1 interval2 -- ranges1 ranges2 ) diff --git a/basis/compiler/cfg/linear-scan/numbering/numbering.factor b/basis/compiler/cfg/linear-scan/numbering/numbering.factor index ac18b0cb2e..2976680857 100644 --- a/basis/compiler/cfg/linear-scan/numbering/numbering.factor +++ b/basis/compiler/cfg/linear-scan/numbering/numbering.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel accessors math sequences grouping namespaces ; +USING: kernel accessors math sequences grouping namespaces +compiler.cfg.rpo ; IN: compiler.cfg.linear-scan.numbering : number-instructions ( rpo -- ) @@ -8,7 +9,7 @@ IN: compiler.cfg.linear-scan.numbering instructions>> [ [ (>>insn#) ] [ drop 2 + ] 2bi ] each - ] each drop ; + ] each-basic-block drop ; SYMBOL: check-numbering? @@ -18,5 +19,5 @@ ERROR: bad-numbering bb ; dup instructions>> [ insn#>> ] map sift [ <= ] monotonic? [ drop ] [ bad-numbering ] if ; -: check-numbering ( rpo -- ) - check-numbering? get [ [ check-block-numbering ] each ] [ drop ] if ; \ No newline at end of file +: check-numbering ( cfg -- ) + check-numbering? get [ [ check-block-numbering ] each-basic-block ] [ drop ] if ; \ No newline at end of file diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor index f7ed994f18..56beaa5379 100644 --- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor +++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor @@ -3,10 +3,12 @@ USING: accessors arrays assocs combinators combinators.short-circuit fry kernel locals make math sequences +compiler.cfg.rpo +compiler.cfg.liveness compiler.cfg.utilities compiler.cfg.instructions compiler.cfg.linear-scan.assignment -compiler.cfg.linear-scan.mapping compiler.cfg.liveness ; +compiler.cfg.linear-scan.mapping ; IN: compiler.cfg.linear-scan.resolve : add-mapping ( from to reg-class -- ) @@ -43,5 +45,5 @@ IN: compiler.cfg.linear-scan.resolve : resolve-block-data-flow ( bb -- ) dup successors>> [ resolve-edge-data-flow ] with each ; -: resolve-data-flow ( rpo -- ) - [ resolve-block-data-flow ] each ; +: resolve-data-flow ( cfg -- ) + [ resolve-block-data-flow ] each-basic-block ; diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor index 9faa1e9e38..c62d4b0208 100755 --- a/basis/compiler/cfg/linearization/linearization.factor +++ b/basis/compiler/cfg/linearization/linearization.factor @@ -4,7 +4,6 @@ USING: kernel math accessors sequences namespaces make combinators assocs arrays locals cpu.architecture compiler.cfg compiler.cfg.rpo -compiler.cfg.liveness compiler.cfg.comparisons compiler.cfg.stack-frame compiler.cfg.instructions ; diff --git a/basis/compiler/cfg/liveness/authors.txt b/basis/compiler/cfg/liveness/authors.txt deleted file mode 100644 index d4f5d6b3ae..0000000000 --- a/basis/compiler/cfg/liveness/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov \ No newline at end of file diff --git a/basis/compiler/cfg/liveness/liveness-tests.factor b/basis/compiler/cfg/liveness/liveness-tests.factor index 271dc60d76..697a1f8a7b 100644 --- a/basis/compiler/cfg/liveness/liveness-tests.factor +++ b/basis/compiler/cfg/liveness/liveness-tests.factor @@ -1,15 +1,38 @@ -USING: compiler.cfg compiler.cfg.instructions compiler.cfg.registers -compiler.cfg.liveness accessors tools.test cpu.architecture ; +USING: compiler.cfg.liveness compiler.cfg.debugger +compiler.cfg.instructions compiler.cfg.predecessors +compiler.cfg.registers compiler.cfg cpu.architecture +accessors namespaces sequences kernel tools.test ; IN: compiler.cfg.liveness.tests +! Sanity check... + +V{ + T{ ##peek f V int-regs 0 D 0 } + T{ ##replace f V int-regs 0 D 0 } + T{ ##replace f V int-regs 1 D 1 } + T{ ##peek f V int-regs 1 D 1 } +} 1 test-bb + +V{ + T{ ##replace f V int-regs 2 D 0 } +} 2 test-bb + +V{ + T{ ##replace f V int-regs 3 D 0 } +} 3 test-bb + +1 get 2 get 3 get V{ } 2sequence >>successors drop + +cfg new 1 get >>entry +compute-predecessors +compute-live-sets + [ H{ - { "A" H{ { V int-regs 1 V int-regs 1 } { V int-regs 4 V int-regs 4 } } } - { "B" H{ { V int-regs 3 V int-regs 3 } { V int-regs 2 V int-regs 2 } } } + { V int-regs 1 V int-regs 1 } + { V int-regs 2 V int-regs 2 } + { V int-regs 3 V int-regs 3 } } -] [ - V{ - T{ ##phi f V int-regs 0 { { "A" V int-regs 1 } { "B" V int-regs 2 } } } - T{ ##phi f V int-regs 1 { { "B" V int-regs 3 } { "A" V int-regs 4 } } } - } >>instructions compute-phi-live-in -] unit-test \ No newline at end of file +] +[ 1 get live-in ] +unit-test \ No newline at end of file diff --git a/basis/compiler/cfg/liveness/liveness.factor b/basis/compiler/cfg/liveness/liveness.factor index 8a46b32070..c1793842a2 100644 --- a/basis/compiler/cfg/liveness/liveness.factor +++ b/basis/compiler/cfg/liveness/liveness.factor @@ -1,82 +1,26 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel namespaces deques accessors sets sequences assocs fry -hashtables dlists compiler.cfg.def-use compiler.cfg.instructions -compiler.cfg.rpo ; +USING: kernel accessors assocs sequences sets +compiler.cfg.def-use compiler.cfg.dataflow-analysis +compiler.cfg.instructions ; IN: compiler.cfg.liveness -! This is a backward dataflow analysis. See http://en.wikipedia.org/wiki/Liveness_analysis +! See http://en.wikipedia.org/wiki/Liveness_analysis +! Do not run after SSA construction -! Assoc mapping basic blocks to sets of vregs -SYMBOL: live-ins +BACKWARD-ANALYSIS: live -: live-in ( basic-block -- set ) live-ins get at ; +: transfer-liveness ( live-set instructions -- live-set' ) + [ clone ] [ ] bi* [ + [ uses-vregs [ over conjoin ] each ] + [ defs-vregs [ over delete-at ] each ] bi + ] each ; -! Assoc mapping basic blocks to sequences of sets of vregs; each sequence -! is in conrrespondence with a predecessor -SYMBOL: phi-live-ins +: local-live-in ( instructions -- live-set ) + [ ##phi? not ] filter [ H{ } ] dip transfer-liveness keys ; -: phi-live-in ( predecessor basic-block -- set ) phi-live-ins get at at ; +M: live-analysis transfer-set + drop instructions>> transfer-liveness ; -! Assoc mapping basic blocks to sets of vregs -SYMBOL: live-outs - -: live-out ( basic-block -- set ) live-outs get at ; - -SYMBOL: work-list - -: add-to-work-list ( basic-blocks -- ) - work-list get '[ _ push-front ] each ; - -: map-unique ( seq quot -- assoc ) - map concat unique ; inline - -: gen-set ( instructions -- seq ) - [ ##phi? not ] filter [ uses-vregs ] map-unique ; - -: kill-set ( instructions -- seq ) - [ [ defs-vregs ] [ temp-vregs ] bi append ] map-unique ; - -: compute-live-in ( basic-block -- live-in ) - dup instructions>> - [ [ live-out ] [ gen-set ] bi* assoc-union ] - [ nip kill-set ] - 2bi assoc-diff ; - -: conjoin-at ( value key assoc -- ) - [ dupd ?set-at ] change-at ; - -: compute-phi-live-in ( basic-block -- phi-live-in ) - instructions>> [ ##phi? ] filter [ f ] [ - H{ } clone [ - '[ inputs>> [ swap _ conjoin-at ] assoc-each ] each - ] keep - ] if-empty ; - -: 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 ] - bi and ; - -: compute-live-out ( basic-block -- live-out ) - [ successors>> [ live-in ] map ] - [ dup successors>> [ phi-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-liveness ( cfg -- cfg' ) - work-list set - H{ } clone live-ins set - H{ } clone phi-live-ins set - H{ } clone live-outs set - dup post-order add-to-work-list - work-list get [ liveness-step ] slurp-deque ; +M: live-analysis join-sets + drop assoc-combine ; \ No newline at end of file diff --git a/basis/compiler/cfg/local/authors.txt b/basis/compiler/cfg/local/authors.txt deleted file mode 100644 index d4f5d6b3ae..0000000000 --- a/basis/compiler/cfg/local/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov \ No newline at end of file diff --git a/basis/compiler/cfg/local/local.factor b/basis/compiler/cfg/local/local.factor deleted file mode 100644 index 2f5f5b18e3..0000000000 --- a/basis/compiler/cfg/local/local.factor +++ /dev/null @@ -1,14 +0,0 @@ -! Copyright (C) 2009 Slava Pestov. -! See http://factorcode.org/license.txt for BSD license. -USING: locals accessors kernel assocs namespaces -compiler.cfg compiler.cfg.liveness compiler.cfg.rpo ; -IN: compiler.cfg.local - -:: optimize-basic-block ( bb init-quot insn-quot -- ) - bb basic-block set - bb live-in keys init-quot call - bb insn-quot change-instructions drop ; inline - -:: local-optimization ( cfg init-quot: ( live-in -- ) insn-quot: ( insns -- insns' ) -- cfg' ) - cfg [ init-quot insn-quot optimize-basic-block ] each-basic-block - cfg ; inline \ No newline at end of file diff --git a/basis/compiler/cfg/mr/mr.factor b/basis/compiler/cfg/mr/mr.factor index 9f6a62090c..cb198d5149 100644 --- a/basis/compiler/cfg/mr/mr.factor +++ b/basis/compiler/cfg/mr/mr.factor @@ -1,13 +1,12 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: compiler.cfg.linearization compiler.cfg.two-operand -compiler.cfg.liveness compiler.cfg.gc-checks compiler.cfg.linear-scan +compiler.cfg.gc-checks compiler.cfg.linear-scan compiler.cfg.build-stack-frame compiler.cfg.rpo ; IN: compiler.cfg.mr : build-mr ( cfg -- mr ) convert-two-operand - compute-liveness insert-gc-checks linear-scan flatten-cfg diff --git a/basis/compiler/cfg/optimizer/optimizer.factor b/basis/compiler/cfg/optimizer/optimizer.factor index 1af0fcbc53..50148b73b2 100644 --- a/basis/compiler/cfg/optimizer/optimizer.factor +++ b/basis/compiler/cfg/optimizer/optimizer.factor @@ -11,7 +11,6 @@ compiler.cfg.alias-analysis compiler.cfg.value-numbering compiler.cfg.dce compiler.cfg.write-barrier -compiler.cfg.liveness compiler.cfg.rpo compiler.cfg.phi-elimination compiler.cfg.checker ; @@ -35,7 +34,6 @@ SYMBOL: check-optimizer? join-blocks compute-predecessors stack-analysis - compute-liveness alias-analysis value-numbering compute-predecessors diff --git a/basis/compiler/cfg/phi-elimination/phi-elimination-tests.factor b/basis/compiler/cfg/phi-elimination/phi-elimination-tests.factor index 79d1797720..22afc0b32b 100644 --- a/basis/compiler/cfg/phi-elimination/phi-elimination-tests.factor +++ b/basis/compiler/cfg/phi-elimination/phi-elimination-tests.factor @@ -36,27 +36,20 @@ V{ test-diamond +3 vreg-counter set-global + [ ] [ cfg new 0 get >>entry eliminate-phis drop ] unit-test -[let | n! [ f ] | - -[ ] [ 2 get successors>> first instructions>> first dst>> n>> n! ] unit-test - -[ t ] [ - T{ ##copy f V int-regs n V int-regs 1 } - 2 get successors>> first instructions>> first = +[ T{ ##copy f V int-regs 4 V int-regs 1 } ] [ + 2 get successors>> first instructions>> first ] unit-test -[ t ] [ - T{ ##copy f V int-regs n V int-regs 2 } - 3 get successors>> first instructions>> first = +[ T{ ##copy f V int-regs 4 V int-regs 2 } ] [ + 3 get successors>> first instructions>> first ] unit-test -[ t ] [ - T{ ##copy f V int-regs 3 V int-regs n } - 4 get instructions>> first = +[ T{ ##copy f V int-regs 3 V int-regs 4 } ] [ + 4 get instructions>> first ] unit-test -] - [ 3 ] [ 4 get instructions>> length ] unit-test diff --git a/basis/compiler/cfg/registers/registers.factor b/basis/compiler/cfg/registers/registers.factor index 71f313be5a..c5b3907153 100644 --- a/basis/compiler/cfg/registers/registers.factor +++ b/basis/compiler/cfg/registers/registers.factor @@ -1,11 +1,17 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors namespaces kernel arrays parser ; +USING: accessors namespaces kernel arrays parser math math.order ; IN: compiler.cfg.registers ! Virtual registers, used by CFG and machine IRs -TUPLE: vreg { reg-class read-only } { n read-only } ; +TUPLE: vreg { reg-class read-only } { n fixnum read-only } ; + +M: vreg equal? over vreg? [ [ n>> ] bi@ eq? ] [ 2drop f ] if ; + +M: vreg hashcode* nip n>> ; + SYMBOL: vreg-counter + : next-vreg ( reg-class -- vreg ) \ vreg-counter counter vreg boa ; ! Stack locations -- 'n' is an index starting from the top of the stack diff --git a/basis/compiler/cfg/renaming/renaming.factor b/basis/compiler/cfg/renaming/renaming.factor index efc841e21f..a2204fb36e 100644 --- a/basis/compiler/cfg/renaming/renaming.factor +++ b/basis/compiler/cfg/renaming/renaming.factor @@ -6,7 +6,7 @@ IN: compiler.cfg.renaming SYMBOL: renamings -: rename-value ( vreg -- vreg' ) renamings get at ; +: rename-value ( vreg -- vreg' ) renamings get ?at drop ; GENERIC: rename-insn-defs ( insn -- ) @@ -14,6 +14,14 @@ M: ##flushable rename-insn-defs [ rename-value ] change-dst drop ; +M: ##fixnum-overflow rename-insn-defs + [ rename-value ] change-dst + drop ; + +M: _fixnum-overflow rename-insn-defs + [ rename-value ] change-dst + drop ; + M: insn rename-insn-defs drop ; GENERIC: rename-insn-uses ( insn -- ) diff --git a/basis/compiler/cfg/rpo/rpo.factor b/basis/compiler/cfg/rpo/rpo.factor index f6a40e17d0..1ddacdf8ab 100644 --- a/basis/compiler/cfg/rpo/rpo.factor +++ b/basis/compiler/cfg/rpo/rpo.factor @@ -33,3 +33,10 @@ SYMBOL: visited : each-basic-block ( cfg quot -- ) [ reverse-post-order ] dip each ; inline + +: optimize-basic-block ( bb quot -- ) + [ drop basic-block set ] + [ change-instructions drop ] 2bi ; inline + +: local-optimization ( cfg quot: ( insns -- insns' ) -- cfg' ) + dupd '[ _ optimize-basic-block ] each-basic-block ; inline \ No newline at end of file diff --git a/basis/compiler/cfg/ssa/ssa-tests.factor b/basis/compiler/cfg/ssa/ssa-tests.factor new file mode 100644 index 0000000000..6a3a014f78 --- /dev/null +++ b/basis/compiler/cfg/ssa/ssa-tests.factor @@ -0,0 +1,113 @@ +USING: accessors compiler.cfg compiler.cfg.debugger +compiler.cfg.dominance compiler.cfg.instructions +compiler.cfg.predecessors compiler.cfg.ssa assocs +compiler.cfg.registers cpu.architecture kernel namespaces sequences +tools.test vectors ; +IN: compiler.cfg.ssa.tests + +: reset-counters ( -- ) + ! Reset counters so that results are deterministic w.r.t. hash order + 0 vreg-counter set-global + 0 basic-block set-global ; + +reset-counters + +V{ + T{ ##load-immediate f V int-regs 1 100 } + T{ ##add-imm f V int-regs 2 V int-regs 1 50 } + T{ ##add-imm f V int-regs 2 V int-regs 2 10 } + T{ ##branch } +} 0 test-bb + +V{ + T{ ##load-immediate f V int-regs 3 3 } + T{ ##branch } +} 1 test-bb + +V{ + T{ ##load-immediate f V int-regs 3 4 } + T{ ##branch } +} 2 test-bb + +V{ + T{ ##replace f V int-regs 3 D 0 } + T{ ##return } +} 3 test-bb + +0 get 1 get 2 get V{ } 2sequence >>successors drop +1 get 3 get 1vector >>successors drop +2 get 3 get 1vector >>successors drop + +: test-ssa ( -- ) + cfg new 0 get >>entry + compute-predecessors + construct-ssa + drop ; + +[ ] [ test-ssa ] unit-test + +[ + V{ + T{ ##load-immediate f V int-regs 1 100 } + T{ ##add-imm f V int-regs 2 V int-regs 1 50 } + T{ ##add-imm f V int-regs 3 V int-regs 2 10 } + T{ ##branch } + } +] [ 0 get instructions>> ] unit-test + +[ + V{ + T{ ##load-immediate f V int-regs 4 3 } + T{ ##branch } + } +] [ 1 get instructions>> ] unit-test + +[ + V{ + T{ ##load-immediate f V int-regs 5 4 } + T{ ##branch } + } +] [ 2 get instructions>> ] unit-test + +: clean-up-phis ( insns -- insns' ) + [ dup ##phi? [ [ [ [ number>> ] dip ] assoc-map ] change-inputs ] when ] map ; + +[ + V{ + T{ ##phi f V int-regs 6 H{ { 1 V int-regs 4 } { 2 V int-regs 5 } } } + T{ ##replace f V int-regs 6 D 0 } + T{ ##return } + } +] [ + 3 get instructions>> + clean-up-phis +] unit-test + +reset-counters + +V{ } 0 test-bb +V{ } 1 test-bb +V{ T{ ##peek f V int-regs 0 D 0 } } 2 test-bb +V{ T{ ##peek f V int-regs 0 D 0 } } 3 test-bb +V{ T{ ##replace f V int-regs 0 D 0 } } 4 test-bb +V{ } 5 test-bb +V{ } 6 test-bb + +0 get 1 get 5 get V{ } 2sequence >>successors drop +1 get 2 get 3 get V{ } 2sequence >>successors drop +2 get 4 get 1vector >>successors drop +3 get 4 get 1vector >>successors drop +4 get 6 get 1vector >>successors drop +5 get 6 get 1vector >>successors drop + +[ ] [ test-ssa ] unit-test + +[ + V{ + T{ ##phi f V int-regs 3 H{ { 2 V int-regs 1 } { 3 V int-regs 2 } } } + T{ ##replace f V int-regs 3 D 0 } + } +] [ + 4 get instructions>> + clean-up-phis +] unit-test \ No newline at end of file diff --git a/basis/compiler/cfg/ssa/ssa.factor b/basis/compiler/cfg/ssa/ssa.factor new file mode 100644 index 0000000000..2e76ba35a1 --- /dev/null +++ b/basis/compiler/cfg/ssa/ssa.factor @@ -0,0 +1,131 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: namespaces kernel accessors sequences fry assocs +sets math combinators +compiler.cfg +compiler.cfg.rpo +compiler.cfg.def-use +compiler.cfg.renaming +compiler.cfg.liveness +compiler.cfg.registers +compiler.cfg.dominance +compiler.cfg.instructions ; +IN: compiler.cfg.ssa + +! SSA construction. Predecessors must be computed first. + +! This is the classical algorithm based on dominance frontiers, except +! we consult liveness information to build pruned SSA: +! http://citeseerx.ist.psu.edu/viewdoc/summary?doi=10.1.1.25.8240 + +! Eventually might be worth trying something fancier: +! http://portal.acm.org/citation.cfm?id=1065887.1065890 + +> [ + defs-vregs [ + _ conjoin-at + ] with each + ] with each + ] each-basic-block ; + +: insert-phi-node-later ( vreg bb -- ) + 2dup live-in key? [ + [ predecessors>> over '[ _ ] H{ } map>assoc \ ##phi new-insn ] keep + inserting-phi-nodes get push-at + ] [ 2drop ] if ; + +: compute-phi-nodes-for ( vreg bbs -- ) + keys dup length 2 >= [ + iterated-dom-frontier [ + insert-phi-node-later + ] with each + ] [ 2drop ] if ; + +: compute-phi-nodes ( -- ) + H{ } clone inserting-phi-nodes set + defs get [ compute-phi-nodes-for ] assoc-each ; + +: insert-phi-nodes-in ( phis bb -- ) + [ append ] change-instructions drop ; + +: insert-phi-nodes ( -- ) + inserting-phi-nodes get [ swap insert-phi-nodes-in ] assoc-each ; + +SYMBOLS: stacks originals ; + +: init-renaming ( -- ) + H{ } clone stacks set + H{ } clone originals set ; + +: gen-name ( vreg -- vreg' ) + [ reg-class>> next-vreg ] keep + [ stacks get push-at ] + [ swap originals get set-at ] + [ drop ] + 2tri ; + +: top-name ( vreg -- vreg' ) + stacks get at last ; + +GENERIC: rename-insn ( insn -- ) + +M: insn rename-insn + [ dup uses-vregs [ dup top-name ] { } map>assoc renamings set rename-insn-uses ] + [ dup defs-vregs [ dup gen-name ] { } map>assoc renamings set rename-insn-defs ] + bi ; + +M: ##phi rename-insn + dup defs-vregs [ dup gen-name ] { } map>assoc renamings set rename-insn-defs ; + +: rename-insns ( bb -- ) + instructions>> [ rename-insn ] each ; + +: rename-successor-phi ( phi bb -- ) + swap inputs>> [ top-name ] change-at ; + +: rename-successor-phis ( succ bb -- ) + [ inserting-phi-nodes get at ] dip + '[ _ rename-successor-phi ] each ; + +: rename-successors-phis ( bb -- ) + [ successors>> ] keep '[ _ rename-successor-phis ] each ; + +: pop-stacks ( bb -- ) + instructions>> [ + defs-vregs originals get stacks get + '[ _ at _ at pop* ] each + ] each ; + +: rename-in-block ( bb -- ) + { + [ rename-insns ] + [ rename-successors-phis ] + [ dom-children [ rename-in-block ] each ] + [ pop-stacks ] + } cleave ; + +: rename ( cfg -- ) + init-renaming + entry>> rename-in-block ; + +PRIVATE> + +: construct-ssa ( cfg -- cfg' ) + { + [ ] + [ compute-live-sets ] + [ compute-dominance ] + [ compute-defs compute-phi-nodes insert-phi-nodes ] + [ rename ] + } cleave ; \ No newline at end of file diff --git a/basis/compiler/cfg/two-operand/two-operand.factor b/basis/compiler/cfg/two-operand/two-operand.factor index 87be509c6f..0a52aa7c1a 100644 --- a/basis/compiler/cfg/two-operand/two-operand.factor +++ b/basis/compiler/cfg/two-operand/two-operand.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors kernel sequences make compiler.cfg.instructions -compiler.cfg.local cpu.architecture ; +compiler.cfg.rpo cpu.architecture ; IN: compiler.cfg.two-operand ! On x86, instructions take the form x = x op y @@ -54,7 +54,6 @@ M: insn convert-two-operand* , ; : convert-two-operand ( cfg -- cfg' ) two-operand? [ - [ drop ] [ [ [ convert-two-operand* ] each ] V{ } make ] local-optimization ] when ; diff --git a/basis/compiler/cfg/value-numbering/expressions/expressions.factor b/basis/compiler/cfg/value-numbering/expressions/expressions.factor index 76ad3d892f..87fa959178 100644 --- a/basis/compiler/cfg/value-numbering/expressions/expressions.factor +++ b/basis/compiler/cfg/value-numbering/expressions/expressions.factor @@ -6,7 +6,6 @@ compiler.cfg.value-numbering.graph ; IN: compiler.cfg.value-numbering.expressions ! Referentially-transparent expressions -TUPLE: expr op ; TUPLE: unary-expr < expr in ; TUPLE: binary-expr < expr in1 in2 ; TUPLE: commutative-expr < binary-expr ; @@ -37,17 +36,6 @@ M: reference-expr equal? } cond ] [ 2drop f ] if ; -! Expressions whose values are inputs to the basic block. We -! can eliminate a second computation having the same 'n' as -! the first one; we can also eliminate input-exprs whose -! result is not used. -TUPLE: input-expr < expr n ; - -SYMBOL: input-expr-counter - -: next-input-expr ( class -- expr ) - input-expr-counter [ dup 1 + ] change input-expr boa ; - : constant>vn ( constant -- vn ) expr>vn ; inline GENERIC: >expr ( insn -- expr ) @@ -97,7 +85,7 @@ M: ##compare-imm >expr compare-imm>expr ; M: ##compare-float >expr compare>expr ; -M: ##flushable >expr class next-input-expr ; +M: ##flushable >expr drop next-input-expr ; : init-expressions ( -- ) 0 input-expr-counter set ; diff --git a/basis/compiler/cfg/value-numbering/graph/graph.factor b/basis/compiler/cfg/value-numbering/graph/graph.factor index 41e7201953..77b75bd3ac 100644 --- a/basis/compiler/cfg/value-numbering/graph/graph.factor +++ b/basis/compiler/cfg/value-numbering/graph/graph.factor @@ -10,13 +10,24 @@ SYMBOL: vn-counter ! biassoc mapping expressions to value numbers SYMBOL: exprs>vns +TUPLE: expr op ; + : expr>vn ( expr -- vn ) exprs>vns get [ drop next-vn ] cache ; : vn>expr ( vn -- expr ) exprs>vns get value-at ; +! Expressions whose values are inputs to the basic block. +TUPLE: input-expr < expr n ; + +SYMBOL: input-expr-counter + +: next-input-expr ( -- expr ) + f input-expr-counter counter input-expr boa ; + SYMBOL: vregs>vns -: vreg>vn ( vreg -- vn ) vregs>vns get at ; +: vreg>vn ( vreg -- vn ) + vregs>vns get [ drop next-input-expr expr>vn ] cache ; : vn>vreg ( vn -- vreg ) vregs>vns get value-at ; diff --git a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor index 62ed4a7eb3..9063947ae1 100644 --- a/basis/compiler/cfg/value-numbering/value-numbering-tests.factor +++ b/basis/compiler/cfg/value-numbering/value-numbering-tests.factor @@ -3,7 +3,7 @@ USING: compiler.cfg.value-numbering compiler.cfg.instructions compiler.cfg.registers compiler.cfg.debugger compiler.cfg.comparisons cpu.architecture tools.test kernel math combinators.short-circuit accessors sequences compiler.cfg.predecessors locals -compiler.cfg.phi-elimination compiler.cfg.dce compiler.cfg.liveness +compiler.cfg.phi-elimination compiler.cfg.dce compiler.cfg assocs vectors arrays layouts namespaces ; : trim-temps ( insns -- insns ) @@ -15,10 +15,6 @@ compiler.cfg assocs vectors arrays layouts namespaces ; } 1|| [ f >>temp ] when ] map ; -: test-value-numbering ( insns -- insns ) - { } init-value-numbering - value-numbering-step ; - ! Folding constants together [ { @@ -33,7 +29,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##load-reference f V int-regs 1 -0.0 } T{ ##replace f V int-regs 0 D 0 } T{ ##replace f V int-regs 1 D 1 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -49,7 +45,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##load-reference f V int-regs 1 0.0 } T{ ##replace f V int-regs 0 D 0 } T{ ##replace f V int-regs 1 D 1 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -65,7 +61,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##load-reference f V int-regs 1 t } T{ ##replace f V int-regs 0 D 0 } T{ ##replace f V int-regs 1 D 1 } - } test-value-numbering + } value-numbering-step ] unit-test ! Copy propagation @@ -80,7 +76,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 45 D 1 } T{ ##copy f V int-regs 48 V int-regs 45 } T{ ##compare-imm-branch f V int-regs 48 7 cc/= } - } test-value-numbering + } value-numbering-step ] unit-test ! Compare propagation @@ -99,7 +95,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc> } T{ ##compare-imm f V int-regs 6 V int-regs 4 5 cc/= } T{ ##replace f V int-regs 6 D 0 } - } test-value-numbering trim-temps + } value-numbering-step trim-temps ] unit-test [ @@ -117,7 +113,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##compare f V int-regs 4 V int-regs 2 V int-regs 1 cc<= } T{ ##compare-imm f V int-regs 6 V int-regs 4 5 cc= } T{ ##replace f V int-regs 6 D 0 } - } test-value-numbering trim-temps + } value-numbering-step trim-temps ] unit-test [ @@ -139,7 +135,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##compare-float f V int-regs 12 V double-float-regs 10 V double-float-regs 11 cc< } T{ ##compare-imm f V int-regs 14 V int-regs 12 5 cc= } T{ ##replace f V int-regs 14 D 0 } - } test-value-numbering trim-temps + } value-numbering-step trim-temps ] unit-test [ @@ -155,7 +151,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 30 D -2 } T{ ##compare f V int-regs 33 V int-regs 29 V int-regs 30 cc<= } T{ ##compare-imm-branch f V int-regs 33 5 cc/= } - } test-value-numbering trim-temps + } value-numbering-step trim-temps ] unit-test ! Immediate operand conversion @@ -170,7 +166,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 100 } T{ ##add f V int-regs 2 V int-regs 0 V int-regs 1 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -184,7 +180,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 100 } T{ ##add f V int-regs 2 V int-regs 1 V int-regs 0 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -198,7 +194,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 100 } T{ ##sub f V int-regs 2 V int-regs 0 V int-regs 1 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -210,7 +206,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; { T{ ##peek f V int-regs 0 D 0 } T{ ##sub f V int-regs 1 V int-regs 0 V int-regs 0 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -224,7 +220,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 100 } T{ ##mul f V int-regs 2 V int-regs 0 V int-regs 1 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -238,7 +234,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 100 } T{ ##mul f V int-regs 2 V int-regs 1 V int-regs 0 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -250,7 +246,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; { T{ ##peek f V int-regs 1 D 0 } T{ ##mul-imm f V int-regs 2 V int-regs 1 8 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -264,7 +260,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 100 } T{ ##and f V int-regs 2 V int-regs 0 V int-regs 1 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -278,7 +274,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 100 } T{ ##and f V int-regs 2 V int-regs 1 V int-regs 0 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -292,7 +288,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 100 } T{ ##or f V int-regs 2 V int-regs 0 V int-regs 1 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -306,7 +302,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 100 } T{ ##or f V int-regs 2 V int-regs 1 V int-regs 0 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -320,7 +316,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 100 } T{ ##xor f V int-regs 2 V int-regs 0 V int-regs 1 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -334,7 +330,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 100 } T{ ##xor f V int-regs 2 V int-regs 1 V int-regs 0 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -348,7 +344,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 100 } T{ ##compare f V int-regs 2 V int-regs 0 V int-regs 1 cc<= } - } test-value-numbering trim-temps + } value-numbering-step trim-temps ] unit-test [ @@ -362,7 +358,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 100 } T{ ##compare f V int-regs 2 V int-regs 1 V int-regs 0 cc<= } - } test-value-numbering trim-temps + } value-numbering-step trim-temps ] unit-test [ @@ -376,7 +372,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 100 } T{ ##compare-branch f V int-regs 0 V int-regs 1 cc<= } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -390,7 +386,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 100 } T{ ##compare-branch f V int-regs 1 V int-regs 0 cc<= } - } test-value-numbering trim-temps + } value-numbering-step trim-temps ] unit-test ! Reassociation @@ -409,7 +405,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##add f V int-regs 2 V int-regs 0 V int-regs 1 } T{ ##load-immediate f V int-regs 3 50 } T{ ##add f V int-regs 4 V int-regs 2 V int-regs 3 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -427,7 +423,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##add f V int-regs 2 V int-regs 1 V int-regs 0 } T{ ##load-immediate f V int-regs 3 50 } T{ ##add f V int-regs 4 V int-regs 3 V int-regs 2 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -445,7 +441,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##add f V int-regs 2 V int-regs 0 V int-regs 1 } T{ ##load-immediate f V int-regs 3 50 } T{ ##sub f V int-regs 4 V int-regs 2 V int-regs 3 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -463,7 +459,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##sub f V int-regs 2 V int-regs 0 V int-regs 1 } T{ ##load-immediate f V int-regs 3 50 } T{ ##sub f V int-regs 4 V int-regs 2 V int-regs 3 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -481,7 +477,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##mul f V int-regs 2 V int-regs 0 V int-regs 1 } T{ ##load-immediate f V int-regs 3 50 } T{ ##mul f V int-regs 4 V int-regs 2 V int-regs 3 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -499,7 +495,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##mul f V int-regs 2 V int-regs 1 V int-regs 0 } T{ ##load-immediate f V int-regs 3 50 } T{ ##mul f V int-regs 4 V int-regs 3 V int-regs 2 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -517,7 +513,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##and f V int-regs 2 V int-regs 0 V int-regs 1 } T{ ##load-immediate f V int-regs 3 50 } T{ ##and f V int-regs 4 V int-regs 2 V int-regs 3 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -535,7 +531,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##and f V int-regs 2 V int-regs 1 V int-regs 0 } T{ ##load-immediate f V int-regs 3 50 } T{ ##and f V int-regs 4 V int-regs 3 V int-regs 2 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -553,7 +549,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##or f V int-regs 2 V int-regs 0 V int-regs 1 } T{ ##load-immediate f V int-regs 3 50 } T{ ##or f V int-regs 4 V int-regs 2 V int-regs 3 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -571,7 +567,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##or f V int-regs 2 V int-regs 1 V int-regs 0 } T{ ##load-immediate f V int-regs 3 50 } T{ ##or f V int-regs 4 V int-regs 3 V int-regs 2 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -589,7 +585,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##xor f V int-regs 2 V int-regs 0 V int-regs 1 } T{ ##load-immediate f V int-regs 3 50 } T{ ##xor f V int-regs 4 V int-regs 2 V int-regs 3 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -607,7 +603,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##xor f V int-regs 2 V int-regs 1 V int-regs 0 } T{ ##load-immediate f V int-regs 3 50 } T{ ##xor f V int-regs 4 V int-regs 3 V int-regs 2 } - } test-value-numbering + } value-numbering-step ] unit-test ! Simplification @@ -626,7 +622,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##sub f V int-regs 2 V int-regs 1 V int-regs 1 } T{ ##add f V int-regs 3 V int-regs 0 V int-regs 2 } T{ ##replace f V int-regs 3 D 0 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -644,7 +640,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##sub f V int-regs 2 V int-regs 1 V int-regs 1 } T{ ##sub f V int-regs 3 V int-regs 0 V int-regs 2 } T{ ##replace f V int-regs 3 D 0 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -662,7 +658,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##sub f V int-regs 2 V int-regs 1 V int-regs 1 } T{ ##or f V int-regs 3 V int-regs 0 V int-regs 2 } T{ ##replace f V int-regs 3 D 0 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -680,7 +676,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##sub f V int-regs 2 V int-regs 1 V int-regs 1 } T{ ##xor f V int-regs 3 V int-regs 0 V int-regs 2 } T{ ##replace f V int-regs 3 D 0 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -696,7 +692,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##load-immediate f V int-regs 1 1 } T{ ##mul f V int-regs 2 V int-regs 0 V int-regs 1 } T{ ##replace f V int-regs 2 D 0 } - } test-value-numbering + } value-numbering-step ] unit-test ! Constant folding @@ -713,7 +709,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##load-immediate f V int-regs 1 1 } T{ ##load-immediate f V int-regs 2 3 } T{ ##add f V int-regs 3 V int-regs 1 V int-regs 2 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -729,7 +725,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##load-immediate f V int-regs 1 1 } T{ ##load-immediate f V int-regs 2 3 } T{ ##sub f V int-regs 3 V int-regs 1 V int-regs 2 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -745,7 +741,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##load-immediate f V int-regs 1 2 } T{ ##load-immediate f V int-regs 2 3 } T{ ##mul f V int-regs 3 V int-regs 1 V int-regs 2 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -761,7 +757,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##load-immediate f V int-regs 1 2 } T{ ##load-immediate f V int-regs 2 1 } T{ ##and f V int-regs 3 V int-regs 1 V int-regs 2 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -777,7 +773,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##load-immediate f V int-regs 1 2 } T{ ##load-immediate f V int-regs 2 1 } T{ ##or f V int-regs 3 V int-regs 1 V int-regs 2 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -793,7 +789,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##load-immediate f V int-regs 1 2 } T{ ##load-immediate f V int-regs 2 3 } T{ ##xor f V int-regs 3 V int-regs 1 V int-regs 2 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -807,7 +803,7 @@ compiler.cfg assocs vectors arrays layouts namespaces ; T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 1 } T{ ##shl-imm f V int-regs 3 V int-regs 1 3 } - } test-value-numbering + } value-numbering-step ] unit-test cell 8 = [ @@ -822,7 +818,7 @@ cell 8 = [ T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 -1 } T{ ##shr-imm f V int-regs 3 V int-regs 1 16 } - } test-value-numbering + } value-numbering-step ] unit-test ] when @@ -837,7 +833,7 @@ cell 8 = [ T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 1 -8 } T{ ##sar-imm f V int-regs 3 V int-regs 1 1 } - } test-value-numbering + } value-numbering-step ] unit-test cell 8 = [ @@ -854,7 +850,7 @@ cell 8 = [ T{ ##load-immediate f V int-regs 1 65536 } T{ ##shl-imm f V int-regs 2 V int-regs 1 31 } T{ ##add f V int-regs 3 V int-regs 0 V int-regs 2 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -868,7 +864,7 @@ cell 8 = [ T{ ##peek f V int-regs 0 D 0 } T{ ##load-immediate f V int-regs 2 140737488355328 } T{ ##add f V int-regs 3 V int-regs 0 V int-regs 2 } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -884,7 +880,7 @@ cell 8 = [ T{ ##load-immediate f V int-regs 2 2147483647 } T{ ##add f V int-regs 3 V int-regs 0 V int-regs 2 } T{ ##add f V int-regs 4 V int-regs 3 V int-regs 2 } - } test-value-numbering + } value-numbering-step ] unit-test ] when @@ -900,7 +896,7 @@ cell 8 = [ T{ ##load-immediate f V int-regs 1 1 } T{ ##load-immediate f V int-regs 2 2 } T{ ##compare f V int-regs 3 V int-regs 1 V int-regs 2 cc= } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -914,7 +910,7 @@ cell 8 = [ T{ ##load-immediate f V int-regs 1 1 } T{ ##load-immediate f V int-regs 2 2 } T{ ##compare f V int-regs 3 V int-regs 1 V int-regs 2 cc/= } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -928,7 +924,7 @@ cell 8 = [ T{ ##load-immediate f V int-regs 1 1 } T{ ##load-immediate f V int-regs 2 2 } T{ ##compare f V int-regs 3 V int-regs 1 V int-regs 2 cc< } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -942,7 +938,7 @@ cell 8 = [ T{ ##load-immediate f V int-regs 1 1 } T{ ##load-immediate f V int-regs 2 2 } T{ ##compare f V int-regs 3 V int-regs 2 V int-regs 1 cc< } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -954,7 +950,7 @@ cell 8 = [ { T{ ##peek f V int-regs 0 D 0 } T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc< } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -966,7 +962,7 @@ cell 8 = [ { T{ ##peek f V int-regs 0 D 0 } T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc<= } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -978,7 +974,7 @@ cell 8 = [ { T{ ##peek f V int-regs 0 D 0 } T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc> } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -990,7 +986,7 @@ cell 8 = [ { T{ ##peek f V int-regs 0 D 0 } T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc>= } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -1002,7 +998,7 @@ cell 8 = [ { T{ ##peek f V int-regs 0 D 0 } T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc/= } - } test-value-numbering + } value-numbering-step ] unit-test [ @@ -1014,12 +1010,12 @@ cell 8 = [ { T{ ##peek f V int-regs 0 D 0 } T{ ##compare f V int-regs 1 V int-regs 0 V int-regs 0 cc= } - } test-value-numbering + } value-numbering-step ] unit-test : test-branch-folding ( insns -- insns' n ) - [ V{ 0 1 } clone >>successors basic-block set test-value-numbering ] keep + [ V{ 0 1 } clone >>successors basic-block set value-numbering-step ] keep successors>> first ; [ @@ -1208,7 +1204,6 @@ test-diamond [ ] [ cfg new 0 get >>entry - compute-liveness value-numbering compute-predecessors eliminate-phis drop @@ -1218,17 +1213,6 @@ test-diamond [ t ] [ 1 get successors>> first 3 get eq? ] unit-test -[let | n! [ f ] | - -[ ] [ 2 get successors>> first instructions>> first src>> n>> n! ] unit-test - -[ t ] [ - T{ ##copy f V int-regs n V int-regs 2 } - 3 get successors>> first instructions>> first = -] unit-test - -] - [ 3 ] [ 4 get instructions>> length ] unit-test V{ @@ -1264,7 +1248,6 @@ test-diamond [ ] [ cfg new 0 get >>entry compute-predecessors - compute-liveness value-numbering compute-predecessors eliminate-dead-code @@ -1335,7 +1318,7 @@ V{ [ ] [ cfg new 0 get >>entry - compute-liveness value-numbering eliminate-dead-code drop + value-numbering eliminate-dead-code drop ] unit-test [ f ] [ 1 get instructions>> [ ##peek? ] any? ] unit-test diff --git a/basis/compiler/cfg/value-numbering/value-numbering.factor b/basis/compiler/cfg/value-numbering/value-numbering.factor index e49555e06e..0c9616b4e5 100644 --- a/basis/compiler/cfg/value-numbering/value-numbering.factor +++ b/basis/compiler/cfg/value-numbering/value-numbering.factor @@ -3,8 +3,7 @@ USING: namespaces assocs biassocs classes kernel math accessors sorting sets sequences fry compiler.cfg -compiler.cfg.local -compiler.cfg.liveness +compiler.cfg.rpo compiler.cfg.renaming compiler.cfg.value-numbering.graph compiler.cfg.value-numbering.expressions @@ -13,15 +12,6 @@ compiler.cfg.value-numbering.rewrite ; IN: compiler.cfg.value-numbering ! Local value numbering. Predecessors must be recomputed after this - -: number-input-values ( live-in -- ) - [ [ f next-input-expr simplify ] dip set-vn ] each ; - -: init-value-numbering ( live-in -- ) - init-value-graph - init-expressions - number-input-values ; - : vreg>vreg-mapping ( -- assoc ) vregs>vns get [ keys ] keep '[ dup _ [ at ] [ value-at ] bi ] H{ } map>assoc ; @@ -32,8 +22,10 @@ IN: compiler.cfg.value-numbering ] with-variable ; : value-numbering-step ( insns -- insns' ) - [ rewrite ] map dup rename-uses ; + init-value-graph + init-expressions + [ rewrite ] map + dup rename-uses ; : value-numbering ( cfg -- cfg' ) - [ init-value-numbering ] [ value-numbering-step ] local-optimization - cfg-changed ; + [ value-numbering-step ] local-optimization cfg-changed ; diff --git a/basis/compiler/cfg/write-barrier/write-barrier.factor b/basis/compiler/cfg/write-barrier/write-barrier.factor index b260b0464e..bcec542501 100644 --- a/basis/compiler/cfg/write-barrier/write-barrier.factor +++ b/basis/compiler/cfg/write-barrier/write-barrier.factor @@ -2,7 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: kernel accessors namespaces assocs sets sequences locals compiler.cfg compiler.cfg.instructions compiler.cfg.copy-prop -compiler.cfg.liveness compiler.cfg.local ; +compiler.cfg.rpo ; IN: compiler.cfg.write-barrier ! Eliminate redundant write barrier hits. @@ -43,4 +43,4 @@ M: insn eliminate-write-barrier ; [ eliminate-write-barrier ] map sift ; : eliminate-write-barriers ( cfg -- cfg' ) - [ drop ] [ write-barriers-step ] local-optimization ; + [ write-barriers-step ] local-optimization ; diff --git a/basis/functors/functors.factor b/basis/functors/functors.factor index 6ffc4d8112..5129515980 100644 --- a/basis/functors/functors.factor +++ b/basis/functors/functors.factor @@ -1,11 +1,11 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays classes.mixin classes.parser -classes.tuple classes.tuple.parser combinators effects -effects.parser fry generic generic.parser generic.standard -interpolate io.streams.string kernel lexer locals.parser -locals.rewrite.closures locals.types make namespaces parser -quotations sequences vocabs.parser words words.symbol ; +USING: accessors arrays classes.mixin classes.parser classes.singleton +classes.tuple classes.tuple.parser combinators effects effects.parser +fry generic generic.parser generic.standard interpolate +io.streams.string kernel lexer locals.parser locals.rewrite.closures +locals.types make namespaces parser quotations sequences vocabs.parser +words words.symbol ; IN: functors ! This is a hack @@ -71,6 +71,14 @@ SYNTAX: `TUPLE: } case \ define-tuple-class parsed ; +SYNTAX: `SINGLETON: + scan-param parsed + \ define-singleton-class parsed ; + +SYNTAX: `MIXIN: + scan-param parsed + \ define-mixin-class parsed ; + SYNTAX: `M: scan-param parsed scan-param parsed @@ -134,6 +142,8 @@ DEFER: ;FUNCTOR delimiter : functor-words ( -- assoc ) H{ { "TUPLE:" POSTPONE: `TUPLE: } + { "SINGLETON:" POSTPONE: `SINGLETON: } + { "MIXIN:" POSTPONE: `MIXIN: } { "M:" POSTPONE: `M: } { "C:" POSTPONE: `C: } { ":" POSTPONE: `: } diff --git a/basis/unix/types/freebsd/freebsd.factor b/basis/unix/types/freebsd/freebsd.factor index e012ebcbd6..215e344231 100644 --- a/basis/unix/types/freebsd/freebsd.factor +++ b/basis/unix/types/freebsd/freebsd.factor @@ -1,4 +1,4 @@ -USING: alien.syntax ; +USING: alien.syntax alien.c-types ; IN: unix.types @@ -22,3 +22,5 @@ TYPEDEF: __uint32_t fflags_t TYPEDEF: long ssize_t TYPEDEF: int pid_t TYPEDEF: int time_t + +ALIAS: diff --git a/basis/unix/types/linux/linux.factor b/basis/unix/types/linux/linux.factor index b0340c1778..a3dddfc93e 100644 --- a/basis/unix/types/linux/linux.factor +++ b/basis/unix/types/linux/linux.factor @@ -1,4 +1,4 @@ -USING: alien.syntax ; +USING: alien.syntax alien.c-types ; IN: unix.types TYPEDEF: ulonglong __uquad_type @@ -31,3 +31,5 @@ TYPEDEF: ulonglong __fsblkcnt64_t TYPEDEF: ulonglong __fsfilcnt64_t TYPEDEF: ulonglong ino64_t TYPEDEF: ulonglong off64_t + +ALIAS: \ No newline at end of file diff --git a/basis/unix/types/macosx/macosx.factor b/basis/unix/types/macosx/macosx.factor index ac62776ed7..421efa60bc 100644 --- a/basis/unix/types/macosx/macosx.factor +++ b/basis/unix/types/macosx/macosx.factor @@ -1,4 +1,4 @@ -USING: alien.syntax ; +USING: alien.syntax alien.c-types ; IN: unix.types ! Darwin 9.1.0 @@ -21,3 +21,5 @@ TYPEDEF: __int32_t blksize_t TYPEDEF: long ssize_t TYPEDEF: __int32_t pid_t TYPEDEF: long time_t + +ALIAS: \ No newline at end of file diff --git a/basis/unix/types/netbsd/netbsd.factor b/basis/unix/types/netbsd/netbsd.factor index b5b0ffe661..7dacc97061 100644 --- a/basis/unix/types/netbsd/netbsd.factor +++ b/basis/unix/types/netbsd/netbsd.factor @@ -1,4 +1,4 @@ -USING: alien.syntax combinators layouts vocabs.loader ; +USING: alien.syntax alien.c-types combinators layouts vocabs.loader ; IN: unix.types ! NetBSD 4.0 @@ -17,6 +17,8 @@ TYPEDEF: long ssize_t TYPEDEF: int pid_t TYPEDEF: int time_t +ALIAS: + cell-bits { { 32 [ "unix.types.netbsd.32" require ] } { 64 [ "unix.types.netbsd.64" require ] } diff --git a/basis/unix/types/openbsd/openbsd.factor b/basis/unix/types/openbsd/openbsd.factor index 8938afa936..7c8fbd2b9d 100644 --- a/basis/unix/types/openbsd/openbsd.factor +++ b/basis/unix/types/openbsd/openbsd.factor @@ -1,4 +1,4 @@ -USING: alien.syntax ; +USING: alien.syntax alien.c-types ; IN: unix.types ! OpenBSD 4.2 @@ -17,3 +17,5 @@ TYPEDEF: __uint32_t fflags_t TYPEDEF: long ssize_t TYPEDEF: int pid_t TYPEDEF: int time_t + +ALIAS: \ No newline at end of file diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor index 75607b0258..3c5ac31d23 100644 --- a/core/assocs/assocs-tests.factor +++ b/core/assocs/assocs-tests.factor @@ -134,3 +134,19 @@ unit-test [ f ] [ 1 2 H{ { 2 1 } } maybe-set-at ] unit-test [ t ] [ 1 3 H{ { 2 1 } } clone maybe-set-at ] unit-test [ t ] [ 3 2 H{ { 2 1 } } clone maybe-set-at ] unit-test + +[ H{ { 1 2 } { 2 3 } } ] [ + { + H{ { 1 3 } } + H{ { 2 3 } } + H{ { 1 2 } } + } assoc-combine +] unit-test + +[ H{ { 1 7 } } ] [ + { + H{ { 1 2 } { 2 4 } { 5 6 } } + H{ { 1 3 } { 2 5 } } + H{ { 1 7 } { 5 6 } } + } assoc-refine +] unit-test \ No newline at end of file diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index 62ab9f86ae..8b6809236c 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -129,6 +129,9 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) : assoc-combine ( seq -- union ) H{ } clone [ dupd update ] reduce ; +: assoc-refine ( seq -- assoc ) + [ f ] [ [ ] [ assoc-intersect ] map-reduce ] if-empty ; + : assoc-diff ( assoc1 assoc2 -- diff ) [ nip key? not ] curry assoc-filter ; diff --git a/core/sets/sets-docs.factor b/core/sets/sets-docs.factor index 0fce78dd68..cec3d65d3c 100755 --- a/core/sets/sets-docs.factor +++ b/core/sets/sets-docs.factor @@ -23,6 +23,7 @@ $nl "Adding elements to sets:" { $subsection adjoin } { $subsection conjoin } +{ $subsection conjoin-at } { $see-also member? memq? any? all? "assocs-sets" } ; ABOUT: "sets" @@ -54,6 +55,10 @@ HELP: conjoin } { $side-effects "assoc" } ; +HELP: conjoin-at +{ $values { "value" object } { "key" object } { "assoc" assoc } } +{ $description "Adds " { $snippet "value" } " to the set stored at " { $snippet "key" } " of " { $snippet "assoc" } "." } ; + HELP: unique { $values { "seq" "a sequence" } { "assoc" assoc } } { $description "Outputs a new assoc where the keys and values are equal." } diff --git a/core/sets/sets.factor b/core/sets/sets.factor index 062b624e8f..c7b834297a 100755 --- a/core/sets/sets.factor +++ b/core/sets/sets.factor @@ -7,6 +7,9 @@ IN: sets : conjoin ( elt assoc -- ) dupd set-at ; +: conjoin-at ( value key assoc -- ) + [ dupd ?set-at ] change-at ; + : (prune) ( elt hash vec -- ) 3dup drop key? [ 3drop ] [ [ drop conjoin ] [ nip push ] 3bi diff --git a/extra/sequences/abbrev/abbrev-docs.factor b/extra/sequences/abbrev/abbrev-docs.factor new file mode 100644 index 0000000000..ae351914de --- /dev/null +++ b/extra/sequences/abbrev/abbrev-docs.factor @@ -0,0 +1,28 @@ +! Copyright (C) 2009 Maximilian Lupke. +! See http://factorcode.org/license.txt for BSD license. +USING: assocs help.markup help.syntax sequences ; +IN: sequences.abbrev + +HELP: abbrev +{ $values + { "seqs" sequence } + { "assoc" assoc } +} +{ $description "Calculates an assoc of { prefix sequence } pairs with prefix being an prefix of each element of sequence for each element in " { $snippet "seqs" } "." } ; + +HELP: unique-abbrev +{ $values + { "seqs" sequence } + { "assoc" assoc } +} +{ $description "Calculates an assoc of { prefix { sequence } } pairs with prefix being an unambiguous prefix of sequence in seqs." } ; + +ARTICLE: "sequences.abbrev" "Examples of abbrev usage" +"It is probably easiest to just run examples to understand abbrev." +{ $code + "{ \"hello\" \"help\" } abbrev" + "{ \"hello\" \"help\" } unique-abbrev" +} +; + +ABOUT: "sequences.abbrev" diff --git a/extra/sequences/abbrev/abbrev-tests.factor b/extra/sequences/abbrev/abbrev-tests.factor new file mode 100644 index 0000000000..39e445b495 --- /dev/null +++ b/extra/sequences/abbrev/abbrev-tests.factor @@ -0,0 +1,26 @@ +USING: assocs sequences.abbrev tools.test ; +IN: sequences.abbrev.tests + +[ { "hello" "help" } ] [ + "he" { "apple" "hello" "help" } abbrev at +] unit-test + +[ f ] [ + "he" { "apple" "hello" "help" } unique-abbrev at +] unit-test + +[ { "apple" } ] [ + "a" { "apple" "hello" "help" } abbrev at +] unit-test + +[ { "apple" } ] [ + "a" { "apple" "hello" "help" } unique-abbrev at +] unit-test + +[ f ] [ + "a" { "hello" "help" } abbrev at +] unit-test + +[ f ] [ + "a" { "hello" "help" } unique-abbrev at +] unit-test diff --git a/extra/sequences/abbrev/abbrev.factor b/extra/sequences/abbrev/abbrev.factor new file mode 100644 index 0000000000..6770a48a3a --- /dev/null +++ b/extra/sequences/abbrev/abbrev.factor @@ -0,0 +1,23 @@ +! Copyright (C) 2009 Maximilian Lupke. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays assocs fry kernel math.ranges sequences ; +IN: sequences.abbrev + +assoc ; + +: assoc-merge ( assoc1 assoc2 -- assoc3 ) + tuck '[ over _ at dup [ append ] [ drop ] if ] assoc-map assoc-union ; + +PRIVATE> + +: abbrev ( seqs -- assoc ) + [ (abbrev) ] map H{ } [ assoc-merge ] reduce ; + +: unique-abbrev ( seqs -- assoc ) + abbrev [ nip length 1 = ] assoc-filter ; diff --git a/extra/sequences/abbrev/authors.txt b/extra/sequences/abbrev/authors.txt new file mode 100644 index 0000000000..758ea89529 --- /dev/null +++ b/extra/sequences/abbrev/authors.txt @@ -0,0 +1 @@ +Maximilian Lupke