From 8e9badd4f54e7d40f9276d340fdb6fd9a7bcee89 Mon Sep 17 00:00:00 2001 From: Maximilian Lupke Date: Mon, 20 Jul 2009 01:31:26 +0200 Subject: [PATCH 1/7] sequences.abbrev: Initial commit --- extra/sequences/abbrev/abbrev-tests.factor | 26 ++++++++++++++++++++++ extra/sequences/abbrev/abbrev.factor | 23 +++++++++++++++++++ extra/sequences/abbrev/authors.txt | 1 + 3 files changed, 50 insertions(+) create mode 100644 extra/sequences/abbrev/abbrev-tests.factor create mode 100644 extra/sequences/abbrev/abbrev.factor create mode 100644 extra/sequences/abbrev/authors.txt diff --git a/extra/sequences/abbrev/abbrev-tests.factor b/extra/sequences/abbrev/abbrev-tests.factor new file mode 100644 index 0000000000..6e6739e09a --- /dev/null +++ b/extra/sequences/abbrev/abbrev-tests.factor @@ -0,0 +1,26 @@ +USING: assocs sequences.abbrev tools.test ; +IN: sequences.abbrev.tests + +[ { "help" "hello" } ] [ + "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..526737bd55 --- /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 ) + swap over '[ over _ at dup [ prepend ] [ 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 From 52e09199e12be8c4a4e4f7c56a51099c84a2ceb8 Mon Sep 17 00:00:00 2001 From: Maximilian Lupke Date: Mon, 20 Jul 2009 01:40:20 +0200 Subject: [PATCH 2/7] sequences.abbrev: small refactoring --- extra/sequences/abbrev/abbrev.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/sequences/abbrev/abbrev.factor b/extra/sequences/abbrev/abbrev.factor index 526737bd55..bab8bb94b2 100644 --- a/extra/sequences/abbrev/abbrev.factor +++ b/extra/sequences/abbrev/abbrev.factor @@ -6,7 +6,7 @@ IN: sequences.abbrev assoc ; From e3ec2b6c8bbb018ebeeb58ffbe231281ebdc6ce1 Mon Sep 17 00:00:00 2001 From: Maximilian Lupke Date: Mon, 20 Jul 2009 17:22:55 +0200 Subject: [PATCH 3/7] sequences.abbrev: more small refactoring --- extra/sequences/abbrev/abbrev.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/sequences/abbrev/abbrev.factor b/extra/sequences/abbrev/abbrev.factor index bab8bb94b2..d5bba8951e 100644 --- a/extra/sequences/abbrev/abbrev.factor +++ b/extra/sequences/abbrev/abbrev.factor @@ -12,7 +12,7 @@ IN: sequences.abbrev [ prefixes ] keep 1array '[ _ ] H{ } map>assoc ; : assoc-merge ( assoc1 assoc2 -- assoc3 ) - swap over '[ over _ at dup [ prepend ] [ drop ] if ] assoc-map assoc-union ; + tuck '[ over _ at dup [ prepend ] [ drop ] if ] assoc-map assoc-union ; PRIVATE> From ea7cbd2b5afab52059973509c426d595d167a5c3 Mon Sep 17 00:00:00 2001 From: Maximilian Lupke Date: Mon, 20 Jul 2009 20:18:13 +0200 Subject: [PATCH 4/7] sequences.abbrev: keep insertion order --- extra/sequences/abbrev/abbrev-tests.factor | 2 +- extra/sequences/abbrev/abbrev.factor | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/extra/sequences/abbrev/abbrev-tests.factor b/extra/sequences/abbrev/abbrev-tests.factor index 6e6739e09a..39e445b495 100644 --- a/extra/sequences/abbrev/abbrev-tests.factor +++ b/extra/sequences/abbrev/abbrev-tests.factor @@ -1,7 +1,7 @@ USING: assocs sequences.abbrev tools.test ; IN: sequences.abbrev.tests -[ { "help" "hello" } ] [ +[ { "hello" "help" } ] [ "he" { "apple" "hello" "help" } abbrev at ] unit-test diff --git a/extra/sequences/abbrev/abbrev.factor b/extra/sequences/abbrev/abbrev.factor index d5bba8951e..6770a48a3a 100644 --- a/extra/sequences/abbrev/abbrev.factor +++ b/extra/sequences/abbrev/abbrev.factor @@ -12,7 +12,7 @@ IN: sequences.abbrev [ prefixes ] keep 1array '[ _ ] H{ } map>assoc ; : assoc-merge ( assoc1 assoc2 -- assoc3 ) - tuck '[ over _ at dup [ prepend ] [ drop ] if ] assoc-map assoc-union ; + tuck '[ over _ at dup [ append ] [ drop ] if ] assoc-map assoc-union ; PRIVATE> From 08814c33085f4901683c853abcf5913f4cf949a1 Mon Sep 17 00:00:00 2001 From: Maximilian Lupke Date: Tue, 21 Jul 2009 00:37:45 +0200 Subject: [PATCH 5/7] sequences.abbrev: add docs - not much, but a start --- extra/sequences/abbrev/abbrev-docs.factor | 28 +++++++++++++++++++++++ 1 file changed, 28 insertions(+) create mode 100644 extra/sequences/abbrev/abbrev-docs.factor 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" From e7e5bee9a278e554a1f151586c715feaf6921819 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 21 Jul 2009 17:49:30 -0500 Subject: [PATCH 6/7] compiler.cfg.ssa: Cytron's SSA construction algorithm --- .../cfg/dominance/dominance-tests.factor | 9 +- basis/compiler/cfg/dominance/dominance.factor | 7 +- basis/compiler/cfg/renaming/renaming.factor | 8 + basis/compiler/cfg/ssa/ssa-tests.factor | 79 ++++++++++ basis/compiler/cfg/ssa/ssa.factor | 146 ++++++++++++++++++ 5 files changed, 240 insertions(+), 9 deletions(-) create mode 100644 basis/compiler/cfg/ssa/ssa-tests.factor create mode 100644 basis/compiler/cfg/ssa/ssa.factor diff --git a/basis/compiler/cfg/dominance/dominance-tests.factor b/basis/compiler/cfg/dominance/dominance-tests.factor index e3e0d09cfc..b87f668d88 100644 --- a/basis/compiler/cfg/dominance/dominance-tests.factor +++ b/basis/compiler/cfg/dominance/dominance-tests.factor @@ -34,11 +34,10 @@ V{ } 5 test-bb [ t ] [ 0 get dom-children 1 get 2 get 4 get 3array set= ] unit-test -[ t ] [ 4 get 1 get dom-frontier key? ] unit-test -[ f ] [ 3 get 1 get dom-frontier key? ] unit-test -[ t ] [ 4 get 2 get dom-frontier key? ] unit-test -[ t ] [ 0 get dom-frontier assoc-empty? ] unit-test -[ t ] [ 4 get dom-frontier assoc-empty? ] unit-test +[ { 4 } ] [ 1 get dom-frontier [ number>> ] map ] unit-test +[ { 4 } ] [ 2 get dom-frontier [ number>> ] map ] unit-test +[ f ] [ 0 get dom-frontier ] unit-test +[ f ] [ 4 get dom-frontier ] unit-test ! Example from the paper V{ } 0 test-bb diff --git a/basis/compiler/cfg/dominance/dominance.factor b/basis/compiler/cfg/dominance/dominance.factor index 8b8d006560..9c8fc79619 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 sets math compiler.cfg.rpo -compiler.cfg.stack-analysis fry kernel math.order namespaces -sequences ; +USING: accessors assocs combinators sets math fry kernel math.order +namespaces sequences sorting compiler.cfg.rpo ; IN: compiler.cfg.dominance ! Reference: @@ -66,7 +65,7 @@ SYMBOL: dom-frontiers PRIVATE> -: dom-frontier ( bb -- set ) dom-frontiers get at ; +: dom-frontier ( bb -- set ) dom-frontiers get at keys ; >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 + compute-dominance + 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 + +[ + 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>> + [ dup ##phi? [ [ [ [ number>> ] dip ] assoc-map ] change-inputs ] when ] map +] 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..e11701965b --- /dev/null +++ b/basis/compiler/cfg/ssa/ssa.factor @@ -0,0 +1,146 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: namespaces kernel accessors sequences fry dlists +deques assocs sets math combinators sorting +compiler.cfg +compiler.cfg.rpo +compiler.cfg.def-use +compiler.cfg.renaming +compiler.cfg.registers +compiler.cfg.dominance +compiler.cfg.instructions ; +IN: compiler.cfg.ssa + +! SSA construction. Predecessors and dominance must be computed first. + +! This is the classical algorithm based on dominance frontiers: +! 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 [ + _ push-at + ] with each + ] with each + ] each-basic-block ; + +SYMBOLS: has-already ever-on-work-list work-list ; + +: init-insert-phi-nodes ( bbs -- ) + H{ } clone has-already set + [ unique ever-on-work-list set ] + [ [ push-all-front ] keep work-list set ] bi ; + +: add-to-work-list ( bb -- ) + dup ever-on-work-list get key? [ drop ] [ + [ ever-on-work-list get conjoin ] + [ work-list get push-front ] + bi + ] if ; + +: insert-phi-node-later ( vreg bb -- ) + [ predecessors>> over '[ _ ] H{ } map>assoc \ ##phi new-insn ] keep + inserting-phi-nodes get push-at ; + +: compute-phi-node-in ( vreg bb -- ) + dup has-already get key? [ 2drop ] [ + [ insert-phi-node-later ] + [ has-already get conjoin ] + [ add-to-work-list ] + tri + ] if ; + +: compute-phi-nodes-for ( vreg bbs -- ) + dup length 2 >= [ + init-insert-phi-nodes + work-list get [ + dom-frontier [ + compute-phi-node-in + ] with each + ] with slurp-deque + ] [ 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' ) + dup [ compute-defs compute-phi-nodes insert-phi-nodes ] [ rename ] bi ; \ No newline at end of file From ead57fc5dde4cc15770d74301f197be96e9777a0 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 21 Jul 2009 17:49:44 -0500 Subject: [PATCH 7/7] compiler.cfg.registers: minor optimization --- basis/compiler/cfg/registers/registers.factor | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) 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