]> gitweb.factorcode.org Git - factor.git/commitdiff
Various codegen improvements:
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Fri, 29 May 2009 18:11:34 +0000 (13:11 -0500)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Fri, 29 May 2009 18:11:34 +0000 (13:11 -0500)
- new-insn word to construct instructions
- cache RPO in the CFG
- re-organize low-level optimizer so that MR is built after register allocation
- register allocation now stores instruction numbers in the instructions themselves
- split defs-vregs into defs-vregs and temp-vregs

30 files changed:
basis/compiler/cfg/alias-analysis/alias-analysis.factor
basis/compiler/cfg/cfg.factor
basis/compiler/cfg/checker/checker.factor
basis/compiler/cfg/dce/dce.factor
basis/compiler/cfg/debugger/debugger.factor
basis/compiler/cfg/def-use/def-use.factor
basis/compiler/cfg/height/height.factor
basis/compiler/cfg/instructions/instructions.factor
basis/compiler/cfg/instructions/syntax/syntax.factor
basis/compiler/cfg/linear-scan/assignment/assignment.factor
basis/compiler/cfg/linear-scan/linear-scan-tests.factor
basis/compiler/cfg/linear-scan/linear-scan.factor
basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor
basis/compiler/cfg/linear-scan/numbering/authors.txt [new file with mode: 0644]
basis/compiler/cfg/linear-scan/numbering/numbering.factor [new file with mode: 0644]
basis/compiler/cfg/linearization/linearization.factor
basis/compiler/cfg/liveness/liveness.factor
basis/compiler/cfg/optimizer/optimizer.factor
basis/compiler/cfg/phi-elimination/phi-elimination.factor
basis/compiler/cfg/predecessors/predecessors.factor
basis/compiler/cfg/rpo/rpo.factor
basis/compiler/cfg/stack-analysis/stack-analysis-tests.factor
basis/compiler/cfg/stack-analysis/stack-analysis.factor
basis/compiler/cfg/two-operand/two-operand.factor
basis/compiler/cfg/useless-blocks/useless-blocks-tests.factor
basis/compiler/cfg/useless-blocks/useless-blocks.factor
basis/compiler/cfg/value-numbering/rewrite/rewrite.factor
basis/compiler/cfg/value-numbering/value-numbering.factor
basis/compiler/cfg/write-barrier/write-barrier.factor
basis/compiler/compiler.factor

index 7ea02c81e57a6fcae21bc5469bd4bac148e34444..384fd65c1a612db35fc3075d9689b2e3a86ca9c3 100644 (file)
@@ -227,7 +227,7 @@ M: ##read analyze-aliases*
     call-next-method
     dup [ dst>> ] [ insn-slot# ] [ insn-object ] tri
     2dup live-slot dup [
-        2nip f \ ##copy boa analyze-aliases* nip
+        2nip \ ##copy new-insn analyze-aliases* nip
     ] [
         drop remember-slot
     ] if ;
@@ -284,5 +284,5 @@ M: insn eliminate-dead-stores* ;
     compute-live-stores
     eliminate-dead-stores ;
 
-: alias-analysis ( rpo -- )
+: alias-analysis ( cfg -- cfg' )
     [ init-alias-analysis ] [ alias-analysis-step ] local-optimization ;
\ No newline at end of file
index 265cbb8f00be6f282aa12db34b0b3e20511796d3..c3ae15f069efac396561a3c03c48b32153e57af6 100644 (file)
@@ -27,11 +27,11 @@ M: basic-block hashcode* nip id>> ;
         building get push
     ] with-variable ; inline
 
-TUPLE: cfg { entry basic-block } word label ;
+TUPLE: cfg { entry basic-block } word label spill-counts post-order ;
 
-C: <cfg> cfg
+: <cfg> ( entry word label -- cfg ) f f cfg boa ;
 
-TUPLE: mr { instructions array } word label spill-counts ;
+TUPLE: mr { instructions array } word label ;
 
 : <mr> ( instructions word label -- mr )
     mr new
index 65191d5ac244eeb6cc81a6e7a75eb0cae32cc8a8..bf5adc2d55bf52f6075b1060935b16a1ab044901 100644 (file)
@@ -41,20 +41,18 @@ ERROR: bad-successors ;
 
 ERROR: bad-live-in ;
 
-: check-rpo ( rpo -- )
-    [ compute-liveness ]
-    [ first live-in assoc-empty? [ bad-live-in ] unless ]
-    [ [ check-basic-block ] each ]
-    tri ;
-
 ERROR: undefined-values uses defs ;
 
 : check-mr ( mr -- )
     ! Check that every used register has a definition
     instructions>>
     [ [ uses-vregs ] map concat ]
-    [ [ defs-vregs ] map concat ] bi
+    [ [ [ defs-vregs ] [ temp-vregs ] bi append ] map concat ] bi
     2dup subset? [ 2drop ] [ undefined-values ] if ;
 
 : check-cfg ( cfg -- )
-    [ reverse-post-order check-rpo ] [ build-mr check-mr ] bi ;
+    compute-liveness
+    [ entry>> live-in assoc-empty? [ bad-live-in ] unless ]
+    [ [ check-basic-block ] each-basic-block ]
+    [ build-mr check-mr ]
+    tri ;
index 5db760e861a18b5bad22a50a480984a755c682ed..68c89be455efad91a4f187ad5312a9bc6b098b70 100644 (file)
@@ -1,7 +1,8 @@
 ! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors assocs sets kernel namespaces sequences
-compiler.cfg.instructions compiler.cfg.def-use ;
+compiler.cfg.instructions compiler.cfg.def-use
+compiler.cfg.rpo ;
 IN: compiler.cfg.dce
 
 ! Maps vregs to sequences of vregs
@@ -36,8 +37,9 @@ M: ##flushable live-insn? dst>> live-vregs get key? ;
 
 M: insn live-insn? drop t ;
 
-: eliminate-dead-code ( rpo -- )
+: eliminate-dead-code ( cfg -- cfg' )
     init-dead-code
-    [ [ instructions>> [ update-liveness-graph ] each ] each ]
-    [ [ [ [ live-insn? ] filter ] change-instructions drop ] each ]
-    bi ;
\ No newline at end of file
+    [ [ instructions>> [ update-liveness-graph ] each ] each-basic-block ]
+    [ [ [ [ live-insn? ] filter ] change-instructions drop ] each-basic-block ]
+    [ ]
+    tri ;
\ No newline at end of file
index 6b0aba6813b69ac0ddc9f6cb647921a328df44c4..5c106bfaee13ce61b2b5aed1e951f310706fee8f 100644 (file)
@@ -23,10 +23,10 @@ SYMBOL: allocate-registers?
 : test-mr ( quot -- mrs )
     test-cfg [
         optimize-cfg
-        build-mr
         convert-two-operand
-        allocate-registers? get
-        [ linear-scan build-stack-frame ] when
+        allocate-registers? get [ linear-scan ] when
+        build-mr
+        allocate-registers? get [ build-stack-frame ] when
     ] map ;
 
 : insn. ( insn -- )
index ba2a4dac3a0f246ceeb70c641cb78077e7033afb..17e49f59a80aba0e04ffdfb00f2dcb627f34d9cb 100644 (file)
@@ -1,29 +1,39 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays kernel compiler.cfg.instructions ;
 IN: compiler.cfg.def-use
 
 GENERIC: defs-vregs ( insn -- seq )
+GENERIC: temp-vregs ( insn -- seq )
 GENERIC: uses-vregs ( insn -- seq )
 
-: dst/tmp-vregs ( insn -- seq ) [ dst>> ] [ temp>> ] bi 2array ;
 M: ##flushable defs-vregs dst>> 1array ;
-M: ##write-barrier defs-vregs [ card#>> ] [ table>> ] bi 2array ;
-M: ##unary/temp defs-vregs dst/tmp-vregs ;
-M: ##allot defs-vregs dst/tmp-vregs ;
-M: ##dispatch defs-vregs temp>> 1array ;
-M: ##slot defs-vregs dst/tmp-vregs ;
+M: ##unary/temp defs-vregs dst>> 1array ;
+M: ##allot defs-vregs dst>> 1array ;
+M: ##slot defs-vregs dst>> 1array ;
 M: ##set-slot defs-vregs temp>> 1array ;
-M: ##string-nth defs-vregs dst/tmp-vregs ;
-M: ##set-string-nth-fast defs-vregs temp>> 1array ;
-M: ##compare defs-vregs dst/tmp-vregs ;
-M: ##compare-imm defs-vregs dst/tmp-vregs ;
-M: ##compare-float defs-vregs dst/tmp-vregs ;
-M: ##fixnum-mul defs-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
-M: ##fixnum-mul-tail defs-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
-M: _dispatch defs-vregs temp>> 1array ;
+M: ##string-nth defs-vregs dst>> 1array ;
+M: ##compare defs-vregs dst>> 1array ;
+M: ##compare-imm defs-vregs dst>> 1array ;
+M: ##compare-float defs-vregs dst>> 1array ;
 M: insn defs-vregs drop f ;
 
+M: ##write-barrier temp-vregs [ card#>> ] [ table>> ] bi 2array ;
+M: ##unary/temp temp-vregs temp>> 1array ;
+M: ##allot temp-vregs temp>> 1array ;
+M: ##dispatch temp-vregs temp>> 1array ;
+M: ##slot temp-vregs temp>> 1array ;
+M: ##set-slot temp-vregs temp>> 1array ;
+M: ##string-nth temp-vregs temp>> 1array ;
+M: ##set-string-nth-fast temp-vregs temp>> 1array ;
+M: ##compare temp-vregs temp>> 1array ;
+M: ##compare-imm temp-vregs temp>> 1array ;
+M: ##compare-float temp-vregs temp>> 1array ;
+M: ##fixnum-mul temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
+M: ##fixnum-mul-tail temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ;
+M: _dispatch temp-vregs temp>> 1array ;
+M: insn temp-vregs drop f ;
+
 M: ##unary uses-vregs src>> 1array ;
 M: ##binary uses-vregs [ src1>> ] [ src2>> ] bi 2array ;
 M: ##binary-imm uses-vregs src1>> 1array ;
index eed0aeb0b556a6939e228d64ea47481327db8dd9..b91120ccfd86a88e9218fa4a97f6aaff648b72c2 100644 (file)
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors math namespaces sequences kernel fry
 compiler.cfg compiler.cfg.registers compiler.cfg.instructions
-compiler.cfg.rpo ;
+compiler.cfg.liveness ;
 IN: compiler.cfg.height
 
 ! Combine multiple stack height changes into one at the
@@ -48,8 +48,8 @@ M: insn normalize-height* ;
     0 rs-height set
     [ [ compute-heights ] each ]
     [ [ [ normalize-height* ] map sift ] with-scope ] bi
-    ds-height get dup 0 = [ drop ] [ f \ ##inc-d boa prefix ] if
-    rs-height get dup 0 = [ drop ] [ f \ ##inc-r boa prefix ] if ;
+    ds-height get dup 0 = [ drop ] [ \ ##inc-d new-insn prefix ] if
+    rs-height get dup 0 = [ drop ] [ \ ##inc-r new-insn prefix ] if ;
 
-: normalize-height ( rpo -- )
+: normalize-height ( cfg -- cfg' )
     [ drop ] [ height-step ] local-optimization ;
index 5682aa668d8c590639642688119ff8b13f6f9323..d2d444a4a5898a835efc7efe660c7adc338c6777 100644 (file)
@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: assocs accessors arrays kernel sequences namespaces words
 math math.order layouts classes.algebra alien byte-arrays
@@ -6,6 +6,8 @@ compiler.constants combinators compiler.cfg.registers
 compiler.cfg.instructions.syntax ;
 IN: compiler.cfg.instructions
 
+: new-insn ( ... class -- insn ) [ f f ] dip boa ; inline
+
 ! Virtual CPU instructions, used by CFG and machine IRs
 TUPLE: insn ;
 
index 876ac5596cd829906b03b19505286f004daf6e1a..e8f8641e7dcde1fcdb2ac9e59670c1edd0bfbfef 100644 (file)
@@ -11,12 +11,12 @@ IN: compiler.cfg.instructions.syntax
     "insn" "compiler.cfg.instructions" lookup ;
 
 : insn-effect ( word -- effect )
-    boa-effect in>> but-last f <effect> ;
+    boa-effect in>> 2 head* f <effect> ;
 
 SYNTAX: INSN:
-    parse-tuple-definition "regs" suffix
+    parse-tuple-definition { "regs" "insn#" } append
     [ dup tuple eq? [ drop insn-word ] when ] dip
     [ define-tuple-class ]
     [ 2drop save-location ]
-    [ 2drop [ ] [ '[ f _ boa , ] ] [ insn-effect ] tri define-inline ]
+    [ 2drop [ ] [ '[ f _ boa , ] ] [ insn-effect ] tri define-inline ]
     3tri ;
index da45b45aaa482a237bc9fc95b46c0f185426f459..f21b9e5db8ac9454adfa75e8e7c5ea42b48207d2 100644 (file)
@@ -59,29 +59,35 @@ SYMBOL: unhandled-intervals
         ] [ 2drop ] if
     ] if ;
 
-GENERIC: (assign-registers) ( insn -- )
+GENERIC: assign-registers-in-insn ( insn -- )
 
-M: vreg-insn (assign-registers)
-    dup
-    [ defs-vregs ] [ uses-vregs ] bi append
-    active-intervals get swap '[ vreg>> _ member? ] filter
+: all-vregs ( insn -- vregs )
+    [ defs-vregs ] [ temp-vregs ] [ uses-vregs ] tri 3append ;
+
+M: vreg-insn assign-registers-in-insn
+    active-intervals get over all-vregs '[ vreg>> _ member? ] filter
     [ [ vreg>> ] [ reg>> ] bi ] { } map>assoc
     >>regs drop ;
 
-M: insn (assign-registers) drop ;
+M: insn assign-registers-in-insn drop ;
 
 : init-assignment ( live-intervals -- )
     V{ } clone active-intervals set
     <min-heap> unhandled-intervals set
     init-unhandled ;
 
-: assign-registers ( insns live-intervals -- insns' )
+: assign-registers-in-block ( bb -- )
     [
-        init-assignment
         [
-            [ activate-new-intervals ]
-            [ drop [ (assign-registers) ] [ , ] bi ]
-            [ expire-old-intervals ]
-            tri
-        ] each-index
-    ] { } make ;
+            [
+                [ insn#>> activate-new-intervals ]
+                [ [ assign-registers-in-insn ] [ , ] bi ]
+                [ insn#>> expire-old-intervals ]
+                tri
+            ] each
+        ] V{ } make
+    ] change-instructions drop ;
+
+: assign-registers ( rpo live-intervals -- )
+    init-assignment
+    [ assign-registers-in-block ] each ;
index 4ddd1fdc0b18256d698ee4f1ae10ba29e25ceb3e..bfbc8248462e56a5e2dac52cdd03354a8d0697fa 100644 (file)
@@ -3,6 +3,8 @@ USING: tools.test random sorting sequences sets hashtables assocs
 kernel fry arrays splitting namespaces math accessors vectors
 math.order grouping
 cpu.architecture
+compiler.cfg
+compiler.cfg.optimizer
 compiler.cfg.instructions
 compiler.cfg.registers
 compiler.cfg.linear-scan
@@ -264,18 +266,27 @@ SYMBOL: max-uses
 
 USING: math.private compiler.cfg.debugger ;
 
-[ ] [ [ float+ float>fixnum 3 fixnum*fast ] test-mr first linear-scan drop ] unit-test
+[ ] [
+    [ float+ float>fixnum 3 fixnum*fast ]
+    test-cfg first optimize-cfg linear-scan drop
+] unit-test
 
 [ f ] [
-    T{ ##allot
-        f
-        T{ vreg f int-regs 1 }
-        40
-        array
-        T{ vreg f int-regs 2 }
-        f
-    } clone
-    1array (linear-scan) first regs>> values all-equal?
+    T{ basic-block
+       { instructions
+         V{
+             T{ ##allot
+                f
+                T{ vreg f int-regs 1 }
+                40
+                array
+                T{ vreg f int-regs 2 }
+                f
+             }
+         }
+       }
+    } clone [ [ clone ] map ] change-instructions
+    dup 1array (linear-scan) instructions>> first regs>> values all-equal?
 ] unit-test
 
 [ 0 1 ] [
index 855f2a6648e3cc7edf7dcae1fa3fd5d1fbf7273d..1e6b9d02c8ae75d788252c1955bc351aca6859a1 100644 (file)
@@ -1,9 +1,11 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel accessors namespaces make
 cpu.architecture
 compiler.cfg
+compiler.cfg.rpo
 compiler.cfg.instructions
+compiler.cfg.linear-scan.numbering
 compiler.cfg.linear-scan.live-intervals
 compiler.cfg.linear-scan.allocation
 compiler.cfg.linear-scan.assignment ;
@@ -23,16 +25,13 @@ 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) ( insns -- insns' )
+: (linear-scan) ( rpo -- )
+    dup number-instructions
     dup compute-live-intervals
     machine-registers allocate-registers assign-registers ;
 
-: linear-scan ( mr -- mr' )
+: linear-scan ( cfg -- cfg' )
     [
-        [
-            [
-                (linear-scan) %
-                spill-counts get _spill-counts
-            ] { } make
-        ] change-instructions
+        dup reverse-post-order (linear-scan)
+        spill-counts get >>spill-counts
     ] with-scope ;
index 1055a3524a310cbb45e3dc7737de67da7acdbdd0..55bcdc74700af3b3c4abf7ca44f90df9346afddd 100644 (file)
@@ -1,4 +1,4 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces kernel assocs accessors sequences math fry
 compiler.cfg.instructions compiler.cfg.registers
@@ -38,27 +38,29 @@ SYMBOL: live-intervals
         [ [ <live-interval> ] keep ] dip set-at
     ] if ;
 
-GENERIC# compute-live-intervals* 1 ( insn n -- )
+GENERIC: compute-live-intervals* ( insn -- )
 
-M: insn compute-live-intervals* 2drop ;
+M: insn compute-live-intervals* drop ;
 
 M: vreg-insn compute-live-intervals*
+    dup insn#>>
     live-intervals get
     [ [ uses-vregs ] 2dip '[ _ swap _ at add-use ] each ]
     [ [ defs-vregs ] 2dip '[ _ swap _ new-live-interval ] each ]
-    3bi ;
+    [ [ temp-vregs ] 2dip '[ _ swap _ new-live-interval ] each ]
+    3tri ;
 
 : record-copy ( insn -- )
     [ dst>> live-intervals get at ] [ src>> ] bi >>copy-from drop ;
 
 M: ##copy compute-live-intervals*
-    [ call-next-method ] [ drop record-copy ] 2bi ;
+    [ call-next-method ] [ record-copy ] bi ;
 
 M: ##copy-float compute-live-intervals*
-    [ call-next-method ] [ drop record-copy ] 2bi ;
+    [ call-next-method ] [ record-copy ] bi ;
 
-: compute-live-intervals ( instructions -- live-intervals )
+: compute-live-intervals ( rpo -- live-intervals )
     H{ } clone [
         live-intervals set
-        [ compute-live-intervals* ] each-index
+        [ instructions>> [ compute-live-intervals* ] each ] each
     ] keep values ;
diff --git a/basis/compiler/cfg/linear-scan/numbering/authors.txt b/basis/compiler/cfg/linear-scan/numbering/authors.txt
new file mode 100644 (file)
index 0000000..d4f5d6b
--- /dev/null
@@ -0,0 +1 @@
+Slava Pestov
\ No newline at end of file
diff --git a/basis/compiler/cfg/linear-scan/numbering/numbering.factor b/basis/compiler/cfg/linear-scan/numbering/numbering.factor
new file mode 100644 (file)
index 0000000..6734f6a
--- /dev/null
@@ -0,0 +1,11 @@
+! Copyright (C) 2009 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel accessors math sequences ;
+IN: compiler.cfg.linear-scan.numbering
+
+: number-instructions ( rpo -- )
+    [ 0 ] dip [
+        instructions>> [
+            [ (>>insn#) ] [ drop 2 + ] 2bi
+        ] each
+    ] each drop ;
\ No newline at end of file
index 9b328a43c0761d8e90ba836e1479b3e5f0e78bb8..5ad8be29533411370d2a4e5d55dd37bef6acbc5a 100755 (executable)
@@ -60,25 +60,31 @@ M: ##branch linearize-insn
     [ drop dup successors>> second useless-branch? ] 2bi
     [ [ swap number>> ] 3dip ] [ [ number>> ] 3dip negate-cc ] if ;
 
+: with-regs ( insn quot -- )
+    over regs>> [ call ] dip building get peek (>>regs) ; inline
+
 M: ##compare-branch linearize-insn
-    binary-conditional _compare-branch emit-branch ;
+    [ binary-conditional _compare-branch ] with-regs emit-branch ;
 
 M: ##compare-imm-branch linearize-insn
-    binary-conditional _compare-imm-branch emit-branch ;
+    [ binary-conditional _compare-imm-branch ] with-regs emit-branch ;
 
 M: ##compare-float-branch linearize-insn
-    binary-conditional _compare-float-branch emit-branch ;
+    [ binary-conditional _compare-float-branch ] with-regs emit-branch ;
 
 M: ##dispatch linearize-insn
     swap
-    [ [ src>> ] [ temp>> ] bi _dispatch ]
+    [ [ [ src>> ] [ temp>> ] bi _dispatch ] with-regs ]
     [ successors>> [ number>> _dispatch-label ] each ]
     bi* ;
 
-: linearize-basic-blocks ( rpo -- insns )
-    [ [ linearize-basic-block ] each ] { } make ;
+: linearize-basic-blocks ( cfg -- insns )
+    [
+        [ [ linearize-basic-block ] each-basic-block ]
+        [ spill-counts>> _spill-counts ]
+        bi
+    ] { } make ;
 
 : build-mr ( cfg -- mr )
-    [ reverse-post-order linearize-basic-blocks ]
-    [ word>> ] [ label>> ]
-    tri <mr> ;
+    [ linearize-basic-blocks ] [ word>> ] [ label>> ] tri
+    <mr> ;
index e069caa03d1491a1c8f0eca5e5cef724d3027952..72609cf4d97507b9b8b5286281001a14c326b281 100644 (file)
@@ -1,7 +1,8 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel namespaces deques accessors sets sequences assocs fry
-dlists compiler.cfg.def-use compiler.cfg.instructions ;
+dlists compiler.cfg.def-use compiler.cfg.instructions
+compiler.cfg.rpo ;
 IN: compiler.cfg.liveness
 
 ! This is a backward dataflow analysis. See http://en.wikipedia.org/wiki/Liveness_analysis
@@ -36,7 +37,7 @@ SYMBOL: work-list
     [ ##phi? not ] filter [ uses-vregs ] map-unique ;
 
 : kill-set ( instructions -- seq )
-    [ defs-vregs ] map-unique ;
+    [ [ defs-vregs ] [ temp-vregs ] bi append ] map-unique ;
 
 : compute-live-in ( basic-block -- live-in )
     dup instructions>>
@@ -68,10 +69,13 @@ SYMBOL: work-list
         [ predecessors>> add-to-work-list ] [ drop ] if
     ] [ drop ] if ;
 
-: compute-liveness ( rpo -- )
+: compute-liveness ( cfg -- cfg' )
     <hashed-dlist> work-list set
     H{ } clone live-ins set
     H{ } clone phi-live-ins set
     H{ } clone live-outs set
-    <reversed> add-to-work-list
-    work-list get [ liveness-step ] slurp-deque ;
\ No newline at end of file
+    dup post-order add-to-work-list
+    work-list get [ liveness-step ] slurp-deque ;
+
+: local-optimization ( cfg init-quot: ( live-in -- ) insn-quot: ( insns -- insns' ) -- cfg' )
+    [ dup ] 2dip '[ _ _ optimize-basic-block ] each-basic-block ;
\ No newline at end of file
index f59e9e0b83288f1f021e012034eb6ebaf5774f64..8ceafd1693ff954ef7ccdcbde03e86e6fd367ff1 100644 (file)
@@ -14,23 +14,17 @@ compiler.cfg.rpo
 compiler.cfg.phi-elimination ;
 IN: compiler.cfg.optimizer
 
-: optimize-cfg ( cfg -- cfg )
+: optimize-cfg ( cfg -- cfg' )
     [
-        [
-            [ compute-predecessors ]
-            [ delete-useless-blocks ]
-            [ delete-useless-conditionals ] tri
-        ] [
-            reverse-post-order
-            {
-                [ normalize-height ]
-                [ stack-analysis ]
-                [ compute-liveness ]
-                [ alias-analysis ]
-                [ value-numbering ]
-                [ eliminate-dead-code ]
-                [ eliminate-write-barriers ]
-                [ eliminate-phis ]
-            } cleave
-        ] [ ] tri
+        compute-predecessors
+        delete-useless-blocks
+        delete-useless-conditionals
+        normalize-height
+        stack-analysis
+        compute-liveness
+        alias-analysis
+        value-numbering
+        eliminate-dead-code
+        eliminate-write-barriers
+        eliminate-phis
     ] with-scope ;
index d94e57f378159a0c9491d3bc326d924002f972c9..3ebf553a4550d0ce7236d457a7e42ee14645eb1d 100644 (file)
@@ -1,7 +1,7 @@
 ! Copyright (C) 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors compiler.cfg compiler.cfg.instructions fry
-kernel sequences ;
+USING: accessors compiler.cfg compiler.cfg.instructions
+compiler.cfg.rpo fry kernel sequences ;
 IN: compiler.cfg.phi-elimination
 
 : insert-copy ( predecessor input output -- )
@@ -17,5 +17,5 @@ IN: compiler.cfg.phi-elimination
         [ [ eliminate-phi ] with each ] dip
     ] change-instructions drop ;
 
-: eliminate-phis ( rpo -- )
-    [ eliminate-phi-step ] each ;
\ No newline at end of file
+: eliminate-phis ( cfg -- cfg' )
+    dup [ eliminate-phi-step ] each-basic-block ;
\ No newline at end of file
index 9bc3a08f63dd965bc8f9f236b38ba48ddda4f560..5be085ba5a19ea13462cbc6ad65aa84ef155b70b 100644 (file)
@@ -6,5 +6,5 @@ IN: compiler.cfg.predecessors
 : predecessors-step ( bb -- )
     dup successors>> [ predecessors>> push ] with each ;
 
-: compute-predecessors ( cfg -- )
-    [ predecessors-step ] each-basic-block ;
+: compute-predecessors ( cfg -- cfg' )
+    dup [ predecessors-step ] each-basic-block ;
index babea55643b40409659edee6cd3c6756336c280a..d01f5ee864bdb3eb90a6025eac3174578c833584 100644 (file)
@@ -16,22 +16,24 @@ SYMBOL: visited
         ] [ , ] bi
     ] if ;
 
-: post-order ( cfg -- blocks )
-    [ entry>> post-order-traversal ] { } make ;
-
 : number-blocks ( blocks -- )
-    [ >>number drop ] each-index ;
+    dup length iota <reversed>
+    [ >>number drop ] 2each ;
+
+: post-order ( cfg -- blocks )
+    dup post-order>> [ ] [
+        [
+            H{ } clone visited set
+            dup entry>> post-order-traversal
+        ] { } make dup number-blocks
+        >>post-order post-order>>
+    ] ?if ;
 
 : reverse-post-order ( cfg -- blocks )
-    H{ } clone visited [
-        post-order <reversed> dup number-blocks
-    ] with-variable ; inline
+    post-order <reversed> ; inline
 
 : each-basic-block ( cfg quot -- )
     [ reverse-post-order ] dip each ; inline
 
 : optimize-basic-block ( bb init-quot insn-quot -- )
-    [ '[ live-in keys _ call ] ] [ '[ _ change-instructions drop ] ] bi* bi ; inline
-
-: local-optimization ( rpo init-quot: ( live-in -- ) insn-quot: ( insns -- insns' ) -- )
-    '[ _ _ optimize-basic-block ] each ;
\ No newline at end of file
+    [ '[ live-in keys @ ] ] [ '[ _ change-instructions drop ] ] bi* bi ; inline
index e846ebc28f00c3ebed2d27fd572922651be0b81c..bd0e539173c7671912d7ab0480c1aadaf4700675 100644 (file)
@@ -8,7 +8,7 @@ sets ;
 IN: compiler.cfg.stack-analysis.tests
 
 ! Fundamental invariant: a basic block should not load or store a value more than once
-: check-for-redundant-ops ( rpo -- )
+: check-for-redundant-ops ( cfg -- )
     [
         instructions>>
         [
@@ -18,34 +18,36 @@ IN: compiler.cfg.stack-analysis.tests
             [ ##replace? ] filter [ loc>> ] map duplicates empty?
             [ "Redundant replaces" throw ] unless
         ] bi
-    ] each ;
+    ] each-basic-block ;
 
-: test-stack-analysis ( quot -- mr )
+: test-stack-analysis ( quot -- cfg )
     dup cfg? [ test-cfg first ] unless
-    dup compute-predecessors
-    dup delete-useless-blocks
-    dup delete-useless-conditionals
-    reverse-post-order
-    dup normalize-height
-    dup stack-analysis
-    dup check-rpo
+    compute-predecessors
+    delete-useless-blocks
+    delete-useless-conditionals
+    normalize-height
+    stack-analysis
+    dup check-cfg
     dup check-for-redundant-ops ;
 
+: linearize ( cfg -- mr )
+    build-mr instructions>> ;
+
 [ ] [ [ ] test-stack-analysis drop ] unit-test
 
 ! Only peek once
-[ 1 ] [ [ dup drop dup ] test-stack-analysis linearize-basic-blocks [ ##peek? ] count ] unit-test
+[ 1 ] [ [ dup drop dup ] test-stack-analysis linearize [ ##peek? ] count ] unit-test
 
 ! Redundant replace is redundant
-[ f ] [ [ dup drop ] test-stack-analysis linearize-basic-blocks [ ##replace? ] any? ] unit-test
-[ f ] [ [ swap swap ] test-stack-analysis linearize-basic-blocks [ ##replace? ] any? ] unit-test
+[ f ] [ [ dup drop ] test-stack-analysis linearize [ ##replace? ] any? ] unit-test
+[ f ] [ [ swap swap ] test-stack-analysis linearize [ ##replace? ] any? ] unit-test
 
 ! Replace required here
-[ t ] [ [ dup ] test-stack-analysis linearize-basic-blocks [ ##replace? ] any? ] unit-test
-[ t ] [ [ [ drop 1 ] when ] test-stack-analysis linearize-basic-blocks [ ##replace? ] any? ] unit-test
+[ t ] [ [ dup ] test-stack-analysis linearize [ ##replace? ] any? ] unit-test
+[ t ] [ [ [ drop 1 ] when ] test-stack-analysis linearize [ ##replace? ] any? ] unit-test
 
 ! Only one replace, at the end
-[ 1 ] [ [ [ 1 ] [ 2 ] if ] test-stack-analysis linearize-basic-blocks [ ##replace? ] count ] unit-test
+[ 1 ] [ [ [ 1 ] [ 2 ] if ] test-stack-analysis linearize [ ##replace? ] count ] unit-test
 
 ! Do we support the full language?
 [ ] [ [ { [ ] [ ] } dispatch ] test-stack-analysis drop ] unit-test
@@ -63,10 +65,10 @@ IN: compiler.cfg.stack-analysis.tests
 [ ] [ [ [ drop 1 ] when ] test-stack-analysis drop ] unit-test
 
 ! This should be a total no-op
-[ f ] [ [ [ ] dip ] test-stack-analysis linearize-basic-blocks [ ##replace? ] any? ] unit-test
+[ f ] [ [ [ ] dip ] test-stack-analysis linearize [ ##replace? ] any? ] unit-test
 
 ! Don't insert inc-d/inc-r; that's wrong!
-[ 1 ] [ [ dup ] test-stack-analysis linearize-basic-blocks [ ##inc-d? ] count ] unit-test
+[ 1 ] [ [ dup ] test-stack-analysis linearize [ ##inc-d? ] count ] unit-test
 
 ! Bug in height tracking
 [ ] [ [ dup [ ] [ reverse ] if ] test-stack-analysis drop ] unit-test
@@ -81,13 +83,13 @@ IN: compiler.cfg.stack-analysis.tests
 
 ! Make sure the replace stores a value with the right height
 [ ] [
-    [ [ . ] [ 2drop 1 ] if ] test-stack-analysis dup eliminate-dead-code linearize-basic-blocks
+    [ [ . ] [ 2drop 1 ] if ] test-stack-analysis eliminate-dead-code linearize
     [ ##replace? ] filter [ length 1 assert= ] [ first loc>> D 0 assert= ] bi
 ] unit-test
 
 ! translate-loc was the wrong way round
 [ ] [
-    [ 1 2 rot ] test-stack-analysis dup eliminate-dead-code linearize-basic-blocks
+    [ 1 2 rot ] test-stack-analysis eliminate-dead-code linearize
     [ [ ##load-immediate? ] count 2 assert= ]
     [ [ ##peek? ] count 1 assert= ]
     [ [ ##replace? ] count 3 assert= ]
@@ -95,7 +97,7 @@ IN: compiler.cfg.stack-analysis.tests
 ] unit-test
 
 [ ] [
-    [ 1 2 ? ] test-stack-analysis dup eliminate-dead-code linearize-basic-blocks
+    [ 1 2 ? ] test-stack-analysis eliminate-dead-code linearize
     [ [ ##load-immediate? ] count 2 assert= ]
     [ [ ##peek? ] count 1 assert= ]
     [ [ ##replace? ] count 1 assert= ]
@@ -105,6 +107,6 @@ IN: compiler.cfg.stack-analysis.tests
 ! Sync before a back-edge, not after
 ! ##peeks should be inserted before a ##loop-entry
 [ 1 ] [
-    [ 1000 [ ] times ] test-stack-analysis dup eliminate-dead-code linearize-basic-blocks
+    [ 1000 [ ] times ] test-stack-analysis eliminate-dead-code linearize
     [ ##add-imm? ] count
 ] unit-test
index ffff728ece965eafb1c093cb32c306af78ca987a..955630a76d84f3c221b3feee32daf3c532c8770f 100644 (file)
@@ -278,10 +278,10 @@ ERROR: cannot-merge-poisoned states ;
         ] 2bi
     ] V{ } make >>instructions drop ;
 
-: stack-analysis ( rpo -- )
+: stack-analysis ( cfg -- cfg' )
     [
         H{ } clone copies set
         H{ } clone state-in set
         H{ } clone state-out set
-        [ visit-block ] each
+        dup [ visit-block ] each-basic-block
     ] with-scope ;
index dabecaeec4623888fa4be920dad61d040a6c2b09..d5fb1e56cf72a7ad349e55c591e9b131a9161493 100644 (file)
@@ -1,7 +1,7 @@
-! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2008, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays kernel sequences compiler.utilities
-compiler.cfg.instructions cpu.architecture ;
+USING: accessors arrays kernel sequences make compiler.cfg.instructions
+compiler.cfg.rpo cpu.architecture ;
 IN: compiler.cfg.two-operand
 
 ! On x86, instructions take the form x = x op y
@@ -11,26 +11,26 @@ IN: compiler.cfg.two-operand
 ! has a LEA instruction which is effectively a three-operand
 ! addition
 
-: make-copy ( dst src -- insn ) f \ ##copy boa ; inline
+: make-copy ( dst src -- insn ) \ ##copy new-insn ; inline
 
-: make-copy/float ( dst src -- insn ) f \ ##copy-float boa ; inline
+: make-copy/float ( dst src -- insn ) \ ##copy-float new-insn ; inline
 
 : convert-two-operand/integer ( insn -- insns )
-    [ [ dst>> ] [ src1>> ] bi make-copy ]
-    [ dup dst>> >>src1 ]
-    bi 2array ; inline
+    [ [ dst>> ] [ src1>> ] bi ##copy ]
+    [ dup dst>> >>src1 ]
+    bi ; inline
 
 : convert-two-operand/float ( insn -- insns )
-    [ [ dst>> ] [ src1>> ] bi make-copy/float ]
-    [ dup dst>> >>src1 ]
-    bi 2array ; inline
+    [ [ dst>> ] [ src1>> ] bi ##copy-float ]
+    [ dup dst>> >>src1 ]
+    bi ; inline
 
-GENERIC: convert-two-operand* ( insn -- insns )
+GENERIC: convert-two-operand* ( insn -- )
 
 M: ##not convert-two-operand*
-    [ [ dst>> ] [ src>> ] bi make-copy ]
-    [ dup dst>> >>src ]
-    bi 2array ;
+    [ [ dst>> ] [ src>> ] bi ##copy ]
+    [ dup dst>> >>src ]
+    bi ;
 
 M: ##sub convert-two-operand* convert-two-operand/integer ;
 M: ##mul convert-two-operand* convert-two-operand/integer ;
@@ -50,11 +50,13 @@ M: ##sub-float convert-two-operand* convert-two-operand/float ;
 M: ##mul-float convert-two-operand* convert-two-operand/float ;
 M: ##div-float convert-two-operand* convert-two-operand/float ;
 
-M: insn convert-two-operand* ;
+M: insn convert-two-operand* ;
 
-: convert-two-operand ( mr -- mr' )
-    [
-        two-operand? [
-            [ convert-two-operand* ] map-flat
-        ] when
-    ] change-instructions ;
+: convert-two-operand ( cfg -- cfg' )
+    two-operand? [
+        dup [
+            [
+                [ [ convert-two-operand* ] each ] V{ } make
+            ] change-instructions drop
+        ] each-basic-block
+    ] when ;
index ebc333b537a023da54a65d62cceafa23e5ddf788..1d14cef19301ea4122e72027d6349faca087f813 100644 (file)
@@ -7,5 +7,5 @@ compiler.cfg.debugger compiler.cfg.predecessors tools.test ;
     [ [ drop 1 ] unless ]
 } [
     [ [ ] ] dip
-    '[ _ test-cfg first dup compute-predecessors dup delete-useless-blocks check-cfg ] unit-test
+    '[ _ test-cfg first compute-predecessors delete-useless-blocks check-cfg ] unit-test
 ] each
\ No newline at end of file
index b6ec1a72ce6264163479960fb216ac8953733ee7..91c337e43ad613026f4cde19ea90d18b8cf00b21 100644 (file)
@@ -35,10 +35,11 @@ IN: compiler.cfg.useless-blocks
         [ instructions>> first ##branch? ]
     } 1&& ;
 
-: delete-useless-blocks ( cfg -- )
-    [
+: delete-useless-blocks ( cfg -- cfg' )
+    dup [
         dup delete-basic-block? [ delete-basic-block ] [ drop ] if
-    ] each-basic-block ;
+    ] each-basic-block
+    f >>post-order ;
 
 : delete-conditional? ( bb -- ? )
     dup instructions>> [ drop f ] [
@@ -51,10 +52,11 @@ IN: compiler.cfg.useless-blocks
 
 : delete-conditional ( bb -- )
     dup successors>> first 1vector >>successors
-    [ but-last f \ ##branch boa suffix ] change-instructions
+    [ but-last \ ##branch new-insn suffix ] change-instructions
     drop ;
 
-: delete-useless-conditionals ( cfg -- )
-    [
+: delete-useless-conditionals ( cfg -- cfg' )
+    dup [
         dup delete-conditional? [ delete-conditional ] [ drop ] if
-    ] each-basic-block ;
+    ] each-basic-block
+    f >>post-order ;
index 990543ed7acca8b73ee23d2332d6e19b3ae08a59..c53a001d2853656b6ab705fbfa14640194212ca8 100644 (file)
@@ -13,7 +13,7 @@ GENERIC: rewrite ( insn -- insn' )
 
 M: ##mul-imm rewrite
     dup src2>> dup power-of-2? [
-        [ [ dst>> ] [ src1>> ] bi ] [ log2 ] bi* f \ ##shl-imm boa
+        [ [ dst>> ] [ src1>> ] bi ] [ log2 ] bi* \ ##shl-imm new-insn
         dup number-values
     ] [ drop ] if ;
 
@@ -36,9 +36,9 @@ M: ##mul-imm rewrite
 
 : rewrite-boolean-comparison ( expr -- insn )
     src1>> vreg>expr dup op>> {
-        { \ ##compare [ >compare-expr< f \ ##compare-branch boa ] }
-        { \ ##compare-imm [ >compare-imm-expr< f \ ##compare-imm-branch boa ] }
-        { \ ##compare-float [ >compare-expr< f \ ##compare-float-branch boa ] }
+        { \ ##compare [ >compare-expr< \ ##compare-branch new-insn ] }
+        { \ ##compare-imm [ >compare-imm-expr< \ ##compare-imm-branch new-insn ] }
+        { \ ##compare-float [ >compare-expr< \ ##compare-float-branch new-insn ] }
     } case ;
 
 : tag-fixnum-expr? ( expr -- ? )
@@ -60,11 +60,11 @@ M: ##mul-imm rewrite
 GENERIC: rewrite-tagged-comparison ( insn -- insn' )
 
 M: ##compare-imm-branch rewrite-tagged-comparison
-    (rewrite-tagged-comparison) f \ ##compare-imm-branch boa ;
+    (rewrite-tagged-comparison) \ ##compare-imm-branch new-insn ;
 
 M: ##compare-imm rewrite-tagged-comparison
     [ dst>> ] [ (rewrite-tagged-comparison) ] bi
-    i f \ ##compare-imm boa ;
+    i \ ##compare-imm new-insn ;
 
 M: ##compare-imm-branch rewrite
     dup rewrite-boolean-comparison? [ rewrite-boolean-comparison ] when
@@ -96,9 +96,9 @@ M: ##compare rewrite
 
 : rewrite-redundant-comparison ( insn -- insn' )
     [ cc>> ] [ dst>> ] [ src1>> vreg>expr dup op>> ] tri {
-        { \ ##compare [ >compare-expr< i f \ ##compare boa ] }
-        { \ ##compare-imm [ >compare-imm-expr< i f \ ##compare-imm boa ] }
-        { \ ##compare-float [ >compare-expr< i f \ ##compare-float boa ] }
+        { \ ##compare [ >compare-expr< i \ ##compare new-insn ] }
+        { \ ##compare-imm [ >compare-imm-expr< i \ ##compare-imm new-insn ] }
+        { \ ##compare-float [ >compare-expr< i \ ##compare-float new-insn ] }
     } case
     swap cc= eq? [ [ negate-cc ] change-cc ] when ;
 
index c771d3b3883b0d413453fdfaea671e2afb3d610f..cc62c0f0c18c5e31e72acc6b393ed7d192b72fff 100644 (file)
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: namespaces assocs biassocs classes kernel math accessors
 sorting sets sequences
-compiler.cfg.rpo
+compiler.cfg.liveness
 compiler.cfg.value-numbering.graph
 compiler.cfg.value-numbering.expressions
 compiler.cfg.value-numbering.propagate
@@ -21,5 +21,5 @@ IN: compiler.cfg.value-numbering
 : value-numbering-step ( insns -- insns' )
     [ [ number-values ] [ rewrite propagate ] bi ] map ;
 
-: value-numbering ( rpo -- )
+: value-numbering ( cfg -- cfg' )
     [ init-value-numbering ] [ value-numbering-step ] local-optimization ;
index e4767599a763aedc826c3f9698664b0ec63595d0..52d5170138bf61c03d02daf10bd5ee2e5b3f88d1 100644 (file)
@@ -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.rpo ;
+compiler.cfg.liveness ;
 IN: compiler.cfg.write-barrier
 
 ! Eliminate redundant write barrier hits.
@@ -42,5 +42,5 @@ M: insn eliminate-write-barrier ;
     H{ } clone copies set
     [ eliminate-write-barrier ] map sift ;
 
-: eliminate-write-barriers ( rpo -- )
+: eliminate-write-barriers ( cfg -- cfg' )
     [ drop ] [ write-barriers-step ] local-optimization ;
index c3d70fdc5bbcdf8eeaf529dd4bcd7e0949488466..ae58c3bd3e42d7474482a821877d9a31c9be3292 100644 (file)
@@ -8,8 +8,8 @@ stack-checker.inlining stack-checker.errors combinators.short-circuit
 compiler.errors compiler.units compiler.tree.builder
 compiler.tree.optimizer compiler.cfg.builder compiler.cfg.optimizer
 compiler.cfg.linearization compiler.cfg.two-operand
-compiler.cfg.linear-scan compiler.cfg.stack-frame compiler.codegen
-compiler.utilities ;
+compiler.cfg.linear-scan compiler.cfg.stack-frame compiler.cfg.rpo
+compiler.codegen compiler.utilities ;
 IN: compiler
 
 SYMBOL: compile-queue
@@ -146,9 +146,9 @@ t compile-dependencies? set-global
 : backend ( nodes word -- )
     build-cfg [
         optimize-cfg
-        build-mr
         convert-two-operand
         linear-scan
+        build-mr
         build-stack-frame
         generate
         save-asm