compiler.cfg.alias-analysis: simplify and speed up

basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor

@@ -1,8 +1,14 @@
 USING: arrays compiler.cfg.alias-analysis compiler.cfg.instructions
 compiler.cfg.registers compiler.cfg.debugger compiler.cfg.comparisons
-cpu.architecture tools.test byte-arrays layouts literals alien ;
+cpu.architecture tools.test byte-arrays layouts literals alien
+accessors sequences ;
 IN: compiler.cfg.alias-analysis.tests
 
+: test-alias-analysis ( insn -- insn )
+    init-alias-analysis
+    alias-analysis-step
+    [ f >>insn# ] map ;
+
 ! Redundant load elimination
 [
     V{
@@ -15,7 +21,7 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##peek f 0 D 0 }
         T{ ##slot-imm f 1 0 1 0 }
         T{ ##slot-imm f 2 0 1 0 }
-    } alias-analysis-step
+    } test-alias-analysis
 ] unit-test
 
 ! Store-load forwarding
@@ -32,7 +38,7 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##peek f 1 D 1 }
         T{ ##set-slot-imm f 1 0 1 0 }
         T{ ##slot-imm f 2 0 1 0 }
-    } alias-analysis-step
+    } test-alias-analysis
 ] unit-test
 
 ! Dead store elimination
@@ -50,7 +56,27 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##peek f 2 D 2 }
         T{ ##set-slot-imm f 1 0 1 0 }
         T{ ##set-slot-imm f 2 0 1 0 }
-    } alias-analysis-step
+    } test-alias-analysis
+] unit-test
+
+[
+    V{
+        T{ ##peek f 0 D 0 }
+        T{ ##peek f 1 D 1 }
+        T{ ##peek f 2 D 2 }
+        T{ ##peek f 3 D 3 }
+        T{ ##set-slot-imm f 3 0 1 0 }
+    }
+] [
+    V{
+        T{ ##peek f 0 D 0 }
+        T{ ##peek f 1 D 1 }
+        T{ ##peek f 2 D 2 }
+        T{ ##peek f 3 D 3 }
+        T{ ##set-slot-imm f 1 0 1 0 }
+        T{ ##set-slot-imm f 2 0 1 0 }
+        T{ ##set-slot-imm f 3 0 1 0 }
+    } test-alias-analysis
 ] unit-test
 
 ! Redundant store elimination
@@ -64,7 +90,7 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##peek f 0 D 0 }
         T{ ##slot-imm f 1 0 1 0 }
         T{ ##set-slot-imm f 1 0 1 0 }
-    } alias-analysis-step
+    } test-alias-analysis
 ] unit-test
 
 [
@@ -79,7 +105,7 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##slot-imm f 1 0 1 0 }
         T{ ##copy f 2 1 any-rep }
         T{ ##set-slot-imm f 2 0 1 0 }
-    } alias-analysis-step
+    } test-alias-analysis
 ] unit-test
 
 ! Not a redundant load
@@ -98,7 +124,7 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##slot-imm f 1 0 1 0 }
         T{ ##set-slot-imm f 0 1 1 0 }
         T{ ##slot-imm f 2 0 1 0 }
-    } alias-analysis-step
+    } test-alias-analysis
 ] unit-test
 
 ! Not a redundant store
@@ -121,7 +147,7 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##set-slot-imm f 2 1 1 0 }
         T{ ##slot-imm f 4 0 1 0 }
         T{ ##set-slot-imm f 3 1 1 0 }
-    } alias-analysis-step
+    } test-alias-analysis
 ] unit-test
 
 ! There's a redundant load, but not a redundant store
@@ -148,7 +174,7 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##slot f 5 0 3 0 0 }
         T{ ##set-slot-imm f 3 0 1 0 }
         T{ ##slot-imm f 6 0 1 0 }
-    } alias-analysis-step
+    } test-alias-analysis
 ] unit-test
 
 ! Fresh allocations don't alias existing values
@@ -173,7 +199,7 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##set-slot-imm f 3 4 1 0 }
         T{ ##set-slot-imm f 2 1 1 0 }
         T{ ##slot-imm f 5 4 1 0 }
-    } alias-analysis-step
+    } test-alias-analysis
 ] unit-test
 
 ! Redundant store elimination
@@ -195,7 +221,7 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##set-slot-imm f 1 4 1 0 }
         T{ ##slot-imm f 5 1 1 0 }
         T{ ##set-slot-imm f 3 4 1 0 }
-    } alias-analysis-step
+    } test-alias-analysis
 ] unit-test
 
 ! Storing a new alias class into another object means that heap-ac
@@ -225,7 +251,7 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##slot-imm f 5 3 1 0 }
         T{ ##set-slot-imm f 1 5 1 0 }
         T{ ##slot-imm f 6 4 1 0 }
-    } alias-analysis-step
+    } test-alias-analysis
 ] unit-test
 
 ! Compares between objects which cannot alias are eliminated
@@ -240,7 +266,7 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##peek f 0 D 0 }
         T{ ##allot f 1 16 array }
         T{ ##compare f 2 0 1 cc= }
-    } alias-analysis-step
+    } test-alias-analysis
 ] unit-test
 
 ! Make sure that input to ##box-displaced-alien becomes heap-ac
@@ -259,5 +285,5 @@ IN: compiler.cfg.alias-analysis.tests
         T{ ##box-displaced-alien f 3 2 1 4 byte-array }
         T{ ##slot-imm f 5 3 1 $[ alien type-number ] }
         T{ ##compare f 6 5 1 cc= }
-    } alias-analysis-step
+    } test-alias-analysis
 ] unit-test

basis/compiler/cfg/alias-analysis/alias-analysis.factor

@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math namespaces assocs hashtables sequences arrays
 accessors words vectors combinators combinators.short-circuit
-sets classes layouts fry cpu.architecture
+sets classes layouts fry locals cpu.architecture
 compiler.cfg
 compiler.cfg.rpo
 compiler.cfg.def-use
@@ -112,29 +112,20 @@ SYMBOL: acs>vregs
 ! Map vregs -> slot# -> vreg
 SYMBOL: live-slots
 
-! Current instruction number
+! Maps vreg -> slot# -> insn# of last store or f
-SYMBOL: insn#
+SYMBOL: recent-stores
 
-! Load/store history, for dead store elimination
+! A set of insn#s of dead stores
-TUPLE: load insn# ;
+SYMBOL: dead-stores
-TUPLE: store insn# ;
 
-: new-action ( class -- action )
+: dead-store ( insn# -- ) dead-stores get adjoin ;
-    insn# get swap boa ; inline
 
-! Maps vreg -> slot# -> sequence of loads/stores
+:: set-ac ( vreg ac -- )
-SYMBOL: histories
-
-: history ( vreg -- history ) histories get at ;
-
-: set-ac ( vreg ac -- )
     #! Set alias class of newly-seen vreg.
-    {
+    H{ } clone vreg recent-stores get set-at
-        [ drop H{ } clone swap histories get set-at ]
+    H{ } clone vreg live-slots get set-at
-        [ drop H{ } clone swap live-slots get set-at ]
+    ac vreg vregs>acs get set-at
-        [ swap vregs>acs get set-at ]
+    vreg ac acs>vregs get push-at ;
-        [ acs>vregs get push-at ]
-    } 2cleave ;
 
 : live-slot ( slot#/f vreg -- vreg' )
     #! If the slot number is unknown, we never reuse a previous
@@ -152,20 +143,17 @@ ERROR: vreg-has-no-slots vreg ;
 : record-constant-slot ( slot# vreg -- )
     #! A load can potentially read every store of this slot#
     #! in that alias class.
-    [
+    [ recent-stores get at delete-at ] with each-alias ;
-        history [ load new-action swap ?push ] change-at
-    ] with each-alias ;
 
 : record-computed-slot ( vreg -- )
     #! Computed load is like a load of every slot touched so far
-    [
+    [ recent-stores get at clear-assoc ] each-alias ;
-        history values [ load new-action swap push ] each
-    ] each-alias ;
 
-: remember-slot ( value slot#/f vreg -- )
+:: remember-slot ( value slot# vreg -- )
-    over
+    slot# [
-    [ [ record-constant-slot ] [ load-constant-slot ] 2bi ]
+        slot# vreg record-constant-slot
-    [ 2nip record-computed-slot ] if ;
+        value slot# vreg load-constant-slot
+    ] [ vreg record-computed-slot ] if ;
 
 SYMBOL: ac-counter
 
@@ -184,21 +172,19 @@ SYMBOL: heap-ac
 : kill-constant-set-slot ( slot# vreg -- )
     [ live-slots get at delete-at ] with each-alias ;
 
-: record-constant-set-slot ( slot# vreg -- )
+:: record-constant-set-slot ( insn# slot# vreg -- )
-    history [
+    vreg recent-stores get at :> recent-stores
-        dup empty? [ dup last store? [ dup pop* ] when ] unless
+    slot# recent-stores at [ dead-store ] when*
-        store new-action swap ?push
+    insn# slot# recent-stores set-at ;
-    ] change-at ;
 
-: kill-computed-set-slot ( ac -- )
+: kill-computed-set-slot ( vreg -- )
     [ live-slots get at clear-assoc ] each-alias ;
 
-: remember-set-slot ( slot#/f vreg -- )
+:: remember-set-slot ( insn# slot# vreg -- )
-    over [
+    slot# [
-        [ record-constant-set-slot ]
+        insn# slot# vreg record-constant-set-slot
-        [ kill-constant-set-slot ]
+        slot# vreg kill-constant-set-slot
-        2bi
+    ] [ vreg kill-computed-set-slot ] if ;
-    ] [ nip kill-computed-set-slot ] if ;
 
 GENERIC: insn-slot# ( insn -- slot#/f )
 GENERIC: insn-object ( insn -- vreg )
@@ -219,24 +205,11 @@ M: ##alien-global insn-object drop \ ##alien-global ;
 M: ##vm-field insn-object drop \ ##vm-field ;
 M: ##set-vm-field insn-object drop \ ##vm-field ;
 
-: init-alias-analysis ( insns -- insns' )
+GENERIC: analyze-aliases ( insn -- insn' )
-    H{ } clone histories set
-    H{ } clone vregs>acs set
-    H{ } clone acs>vregs set
-    H{ } clone live-slots set
-    H{ } clone copies set
 
-    0 ac-counter set
+M: insn analyze-aliases ;
-    next-ac heap-ac set
 
-    \ ##vm-field set-new-ac
+M: vreg-insn analyze-aliases
-    \ ##alien-global set-new-ac
-
-    dup local-live-in [ set-heap-ac ] each ;
-
-GENERIC: analyze-aliases* ( insn -- insn' )
-
-M: insn analyze-aliases*
     ! If an instruction defines a value with a non-integer
     ! representation it means that the value will be boxed
     ! anywhere its used as a tagged pointer. Boxing allocates
@@ -247,23 +220,23 @@ M: insn analyze-aliases*
         [ set-heap-ac ] [ set-new-ac ] if
     ] when* ;
 
-M: ##phi analyze-aliases*
+M: ##phi analyze-aliases
     dup defs-vreg set-heap-ac ;
 
-M: ##allocation analyze-aliases*
+M: ##allocation analyze-aliases
     #! A freshly allocated object is distinct from any other
     #! object.
     dup dst>> set-new-ac ;
 
-M: ##box-displaced-alien analyze-aliases*
+M: ##box-displaced-alien analyze-aliases
     [ call-next-method ]
     [ base>> heap-ac get merge-acs ] bi ;
 
-M: ##read analyze-aliases*
+M: ##read analyze-aliases
     call-next-method
     dup [ dst>> ] [ insn-slot# ] [ insn-object ] tri
     2dup live-slot dup
-    [ 2nip <copy> analyze-aliases* nip ]
+    [ 2nip <copy> analyze-aliases nip ]
     [ drop remember-slot ]
     if ;
 
@@ -272,17 +245,21 @@ M: ##read analyze-aliases*
     #! from?
     live-slot = ;
 
-M: ##write analyze-aliases*
+M:: ##write analyze-aliases ( insn -- insn )
-    dup
+    insn src>> resolve :> src
-    [ src>> resolve ] [ insn-slot# ] [ insn-object ] tri
+    insn insn-slot# :> slot#
-    3dup idempotent? [ 3drop ] [
+    insn insn-object :> vreg
-        [ 2drop heap-ac get merge-acs ]
+    insn insn#>> :> insn#
-        [ remember-set-slot drop ]
-        [ load-slot ]
-        3tri
-    ] if ;
 
-M: ##copy analyze-aliases*
+    src slot# vreg idempotent? [ insn# dead-store ] [
+        src heap-ac get merge-acs
+        insn insn#>> slot# vreg remember-set-slot
+        src slot# vreg load-slot
+    ] if
+
+    insn ;
+
+M: ##copy analyze-aliases
     #! The output vreg gets the same alias class as the input
     #! vreg, since they both contain the same value.
     dup record-copy ;
@@ -293,48 +270,47 @@ M: ##copy analyze-aliases*
         [ [ src1>> ] [ src2>> ] bi [ resolve vreg>ac ] bi@ = not ]
     } 1&& ; inline
 
-M: ##compare analyze-aliases*
+M: ##compare analyze-aliases
     call-next-method
     dup useless-compare? [
         dst>> f \ ##load-reference new-insn
-        analyze-aliases*
+        analyze-aliases
     ] when ;
 
-: analyze-aliases ( insns -- insns' )
+GENERIC: eliminate-dead-stores ( insn -- ? )
-    [ insn# set analyze-aliases* ] map-index sift ;
 
-SYMBOL: live-stores
+M: ##set-slot-imm eliminate-dead-stores
+    insn#>> dead-stores get in? not ;
 
-: compute-live-stores ( -- )
+M: insn eliminate-dead-stores drop t ;
-    histories get
-    values [
-        values [ [ store? ] filter [ insn#>> ] map ] map concat
-    ] map concat fast-set
-    live-stores set ;
 
-GENERIC: eliminate-dead-stores* ( insn -- insn' )
+: init-alias-analysis ( -- )
+    H{ } clone vregs>acs set
+    H{ } clone acs>vregs set
+    H{ } clone live-slots set
+    H{ } clone copies set
+    H{ } clone recent-stores set
+    HS{ } clone dead-stores set
+    0 ac-counter set ;
 
-: (eliminate-dead-stores) ( insn -- insn' )
+: reset-alias-analysis ( -- )
-    dup insn-slot# [
+    recent-stores get clear-assoc
-        insn# get live-stores get in? [
+    vregs>acs get clear-assoc
-            drop f
+    acs>vregs get clear-assoc
-        ] unless
+    live-slots get clear-assoc
-    ] when ;
+    copies get clear-assoc
+    dead-stores get table>> clear-assoc
 
-M: ##set-slot eliminate-dead-stores* (eliminate-dead-stores) ;
+    next-ac heap-ac set
-
+    \ ##vm-field set-new-ac
-M: ##set-slot-imm eliminate-dead-stores* (eliminate-dead-stores) ;
+    \ ##alien-global set-new-ac ;
-
-M: insn eliminate-dead-stores* ;
-
-: eliminate-dead-stores ( insns -- insns' )
-    [ insn# set eliminate-dead-stores* ] map-index sift ;
 
 : alias-analysis-step ( insns -- insns' )
-    init-alias-analysis
+    reset-alias-analysis
-    analyze-aliases
+    [ local-live-in [ set-heap-ac ] each ]
-    compute-live-stores
+    [ 0 [ [ insn#<< ] [ drop 1 + ] 2bi ] reduce drop ]
-    eliminate-dead-stores ;
+    [ [ analyze-aliases ] map! [ eliminate-dead-stores ] filter! ] tri ;
 
 : alias-analysis ( cfg -- cfg )
+    init-alias-analysis
     dup [ alias-analysis-step ] simple-optimization ;

basis/compiler/cfg/linear-scan/numbering/numbering.factor

@@ -4,13 +4,8 @@ USING: kernel accessors math sequences grouping namespaces
 compiler.cfg.linearization ;
 IN: compiler.cfg.linear-scan.numbering
 
-ERROR: already-numbered insn ;
-
 : number-instruction ( n insn -- n' )
-    [ nip dup insn#>> [ already-numbered ] [ drop ] if ]
+    [ insn#<< ] [ drop 2 + ] 2bi ;
-    [ insn#<< ]
-    [ drop 2 + ]
-    2tri ;
 
 : number-instructions ( cfg -- )
     linearization-order