From f09813f6fd7b6611edf2e77d7507e84cabd67d02 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Wed, 22 Oct 2008 18:37:47 -0500
Subject: [PATCH] Alias analysis

---
 .../alias-analysis-tests.factor               | 122 +++++++
 .../cfg/alias-analysis/alias-analysis.factor  | 301 ++++++++++++++++++
 basis/compiler/cfg/copy-prop/copy-prop.factor |  12 +
 .../cfg/intrinsics/utilities/utilities.factor |  11 -
 basis/compiler/cfg/utilities/utilities.factor |  26 ++
 5 files changed, 461 insertions(+), 11 deletions(-)
 create mode 100644 basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor
 create mode 100644 basis/compiler/cfg/alias-analysis/alias-analysis.factor
 create mode 100644 basis/compiler/cfg/copy-prop/copy-prop.factor
 delete mode 100644 basis/compiler/cfg/intrinsics/utilities/utilities.factor
 create mode 100644 basis/compiler/cfg/utilities/utilities.factor

diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor b/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor
new file mode 100644
index 0000000000..1ac6fc8e6f
--- /dev/null
+++ b/basis/compiler/cfg/alias-analysis/alias-analysis-tests.factor
@@ -0,0 +1,122 @@
+USING: compiler.cfg.instructions compiler.cfg.registers
+compiler.cfg.alias-analysis cpu.architecture tools.test
+kernel ;
+IN: compiler.cfg.alias-analysis.tests
+
+[ ] [
+    {
+        T{ ##load-indirect f V int-regs 1 "hello" }
+        T{ ##slot-imm f V int-regs 0 V int-regs 1 0 3 }
+    } alias-analysis drop
+] unit-test
+
+[
+    {
+        T{ ##peek f V int-regs 1 D 1 }
+        T{ ##replace f V int-regs 1 D 0 }
+    }
+] [
+    {
+        T{ ##peek f V int-regs 1 D 1 }
+        T{ ##replace f V int-regs 1 D 0 }
+        T{ ##replace f V int-regs 1 D 1 }
+    } alias-analysis
+] unit-test
+
+[
+    {
+        T{ ##peek f V int-regs 1 D 1 }
+        T{ ##copy f V int-regs 2 V int-regs 1 }
+        T{ ##replace f V int-regs 2 D 0 }
+    }
+] [
+    {
+        T{ ##peek f V int-regs 1 D 1 }
+        T{ ##copy f V int-regs 2 V int-regs 1 }
+        T{ ##replace f V int-regs 2 D 0 }
+        T{ ##replace f V int-regs 2 D 1 }
+    } alias-analysis
+] unit-test
+
+[
+    {
+        T{ ##peek f V int-regs 1 D 1 }
+        T{ ##peek f V int-regs 2 D 0 }
+        T{ ##copy f V int-regs 3 V int-regs 2 }
+        T{ ##copy f V int-regs 4 V int-regs 1 }
+    }
+] [
+    {
+        T{ ##peek f V int-regs 1 D 1 }
+        T{ ##peek f V int-regs 2 D 0 }
+        T{ ##copy f V int-regs 3 V int-regs 2 }
+        T{ ##copy f V int-regs 4 V int-regs 1 }
+        T{ ##replace f V int-regs 3 D 0 }
+        T{ ##replace f V int-regs 4 D 1 }
+    } alias-analysis
+] unit-test
+
+[
+    {
+        T{ ##peek f V int-regs 1 D 1 f }
+        T{ ##peek f V int-regs 2 D 2 f }
+        T{ ##replace f V int-regs 1 D 0 f }
+    }
+] [
+    {
+        T{ ##peek f V int-regs 1 D 1 f }
+        T{ ##peek f V int-regs 2 D 2 f }
+        T{ ##replace f V int-regs 2 D 0 f }
+        T{ ##replace f V int-regs 1 D 0 f }
+    } alias-analysis
+] unit-test
+
+[
+    {
+        T{ ##peek f V int-regs 1 D 1 f }
+        T{ ##copy f V int-regs 3 V int-regs 1 f }
+    }
+] [
+    {
+        T{ ##peek f V int-regs 1 D 1 f }
+        T{ ##replace f V int-regs 1 D 1 f }
+        T{ ##peek f V int-regs 3 D 1 f }
+        T{ ##replace f V int-regs 4 D 1 f }
+    } alias-analysis
+] unit-test
+
+[
+    {
+        T{ ##peek f V int-regs 1 D 1 f }
+        T{ ##peek f V int-regs 2 D 0 f }
+    }
+] [
+    {
+        T{ ##peek f V int-regs 1 D 1 f }
+        T{ ##peek f V int-regs 2 D 0 f }
+        T{ ##replace f V int-regs 1 D 0 f }
+        T{ ##replace f V int-regs 2 D 1 f }
+        T{ ##replace f V int-regs 2 D 0 f }
+        T{ ##replace f V int-regs 1 D 1 f }
+    } alias-analysis
+] unit-test
+
+[
+    {
+        T{ ##peek f V int-regs 1 D 1 f }
+        T{ ##peek f V int-regs 2 D 0 f }
+        T{ ##copy f V int-regs 3 V int-regs 2 f }
+        T{ ##copy f V int-regs 4 V int-regs 1 f }
+    }
+] [
+    {
+        T{ ##peek f V int-regs 1 D 1 f }
+        T{ ##peek f V int-regs 2 D 0 f }
+        T{ ##replace f V int-regs 1 D 0 f }
+        T{ ##replace f V int-regs 2 D 1 f }
+        T{ ##peek f V int-regs 3 D 1 f }
+        T{ ##peek f V int-regs 4 D 0 f }
+        T{ ##replace f V int-regs 3 D 0 f }
+        T{ ##replace f V int-regs 4 D 1 f }
+    } alias-analysis
+] unit-test
diff --git a/basis/compiler/cfg/alias-analysis/alias-analysis.factor b/basis/compiler/cfg/alias-analysis/alias-analysis.factor
new file mode 100644
index 0000000000..e98f6e8bea
--- /dev/null
+++ b/basis/compiler/cfg/alias-analysis/alias-analysis.factor
@@ -0,0 +1,301 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel math namespaces assocs hashtables sequences
+accessors vectors combinators sets classes compiler.cfg
+compiler.cfg.registers compiler.cfg.instructions
+compiler.cfg.instructions.syntax compiler.cfg.copy-prop ;
+IN: compiler.cfg.alias-analysis
+
+! Alias analysis -- must be run after compiler.cfg.height.
+!
+! We try to eliminate redundant slot and stack
+! traffic using some simple heuristics.
+! 
+! All heap-allocated objects which are loaded from the stack, or
+! other object slots are pessimistically assumed to belong to
+! the same alias class.
+!
+! Freshly-allocated objects get their own alias class.
+!
+! The data and retain stack pointer registers are treated
+! uniformly, and each one gets its own alias class.
+! 
+! Simple pseudo-C example showing load elimination:
+! 
+! int *x, *y, z: inputs
+! int a, b, c, d, e: locals
+! 
+! Before alias analysis:
+!
+! a = x[2]
+! b = x[2]
+! c = x[3]
+! y[2] = z
+! d = x[2]
+! e = y[2]
+! f = x[3]
+!
+! After alias analysis:
+!
+! a = x[2]
+! b = a /* ELIMINATED */
+! c = x[3]
+! y[2] = z
+! d = x[2] /* if x=y, d=z, if x!=y, d=b; NOT ELIMINATED */
+! e = z /* ELIMINATED */
+! f = c /* ELIMINATED */
+!
+! Simple pseudo-C example showing store elimination:
+!
+! Before alias analysis:
+!
+! x[0] = a
+! b = x[n]
+! x[0] = c
+! x[1] = d
+! e = x[0]
+! x[1] = c
+!
+! After alias analysis:
+!
+! x[0] = a /* dead if n = 0, live otherwise; NOT ELIMINATED */
+! b = x[n]
+! x[0] = c
+! /* x[1] = d */  /* ELIMINATED */
+! e = c
+! x[1] = c
+
+! Map vregs -> alias classes
+SYMBOL: vregs>acs
+
+: check [ "BUG: static type error detected" throw ] unless* ; inline
+ 
+: vreg>ac ( vreg -- ac )
+    #! Only vregs produced by ##allot, ##peek and ##slot can
+    #! ever be used as valid inputs to ##slot and ##set-slot,
+    #! so we assert this fact by not giving alias classes to
+    #! other vregs.
+    vregs>acs get at check ;
+
+! Map alias classes -> sequence of vregs
+SYMBOL: acs>vregs
+
+: ac>vregs ( ac -- vregs ) acs>vregs get at ;
+
+: aliases ( vreg -- vregs )
+    #! All vregs which may contain the same value as vreg.
+    vreg>ac ac>vregs ;
+
+: each-alias ( vreg quot -- )
+    [ aliases ] dip each ; inline
+
+! Map vregs -> slot# -> vreg
+SYMBOL: live-slots
+
+! Current instruction number
+SYMBOL: insn#
+
+! Load/store history, for dead store elimination
+TUPLE: load insn# ;
+TUPLE: store insn# ;
+
+: new-action ( class -- action )
+    insn# get swap boa ; inline
+
+! Maps vreg -> slot# -> sequence of loads/stores
+SYMBOL: histories
+
+: history ( vreg -- history ) histories get at ;
+
+: set-ac ( vreg ac -- )
+    #! Set alias class of newly-seen vreg.
+    {
+        [ drop H{ } clone swap histories get set-at ]
+        [ drop H{ } clone swap live-slots get set-at ]
+        [ swap vregs>acs get set-at ]
+        [ acs>vregs get push-at ]
+    } 2cleave ;
+
+: live-slot ( slot#/f vreg -- vreg' )
+    #! If the slot number is unknown, we never reuse a previous
+    #! value.
+    over [ live-slots get at at ] [ 2drop f ] if ;
+
+: load-constant-slot ( value slot# vreg -- )
+    live-slots get at check set-at ;
+
+: load-slot ( value slot#/f vreg -- )
+    over [ load-constant-slot ] [ 3drop ] if ;
+
+: record-constant-slot ( slot# vreg -- )
+    #! A load can potentially read every store of this slot#
+    #! in that alias class.
+    [
+        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
+    [
+        history values [ load new-action swap push ] each
+    ] each-alias ;
+
+: remember-slot ( value slot#/f vreg -- )
+    over
+    [ [ record-constant-slot ] [ load-constant-slot ] 2bi ]
+    [ 2nip record-computed-slot ] if ;
+
+SYMBOL: ac-counter
+
+: next-ac ( -- n )
+    ac-counter [ dup 1+ ] change ;
+
+! Alias class for objects which are loaded from the data stack
+! or other object slots. We pessimistically assume that they
+! can all alias each other.
+SYMBOL: heap-ac
+
+: set-heap-ac ( vreg -- ) heap-ac get set-ac ;
+
+: set-new-ac ( vreg -- ) next-ac set-ac ;
+
+: kill-constant-set-slot ( slot# vreg -- )
+    [ live-slots get at delete-at ] with each-alias ;
+
+: record-constant-set-slot ( slot# vreg -- )
+    history [
+        dup empty? [ dup peek store? [ dup pop* ] when ] unless
+        store new-action swap ?push
+    ] change-at ;
+
+: kill-computed-set-slot ( ac -- )
+    [ live-slots get at clear-assoc ] each-alias ;
+
+: remember-set-slot ( slot#/f vreg -- )
+    over [
+        [ record-constant-set-slot ]
+        [ kill-constant-set-slot ] 2bi
+    ] [ nip kill-computed-set-slot ] if ;
+
+SYMBOL: constants
+
+: constant ( vreg -- n/f )
+    #! Return a ##load-immediate value, or f if the vreg was not
+    #! assigned by an ##load-immediate.
+    resolve constants get at ;
+
+! We treat slot accessors and stack traffic alike
+GENERIC: insn-slot# ( insn -- slot#/f )
+GENERIC: insn-object ( insn -- vreg )
+
+M: ##peek insn-slot# loc>> n>> ;
+M: ##replace insn-slot# loc>> n>> ;
+M: ##slot insn-slot# slot>> constant ;
+M: ##slot-imm insn-slot# slot>> ;
+M: ##set-slot insn-slot# slot>> constant ;
+M: ##set-slot-imm insn-slot# slot>> ;
+
+M: ##peek insn-object loc>> class ;
+M: ##replace insn-object loc>> class ;
+M: ##slot insn-object obj>> resolve ;
+M: ##slot-imm insn-object obj>> resolve ;
+M: ##set-slot insn-object obj>> resolve ;
+M: ##set-slot-imm insn-object obj>> resolve ;
+
+: init-alias-analysis ( -- )
+    H{ } clone histories set
+    H{ } clone vregs>acs set
+    H{ } clone acs>vregs set
+    H{ } clone live-slots set
+    H{ } clone constants set
+    H{ } clone copies set
+
+    0 ac-counter set
+    next-ac heap-ac set
+
+    ds-loc next-ac set-ac
+    rs-loc next-ac set-ac ;
+
+GENERIC: analyze-aliases* ( insn -- insn' )
+
+M: ##load-immediate analyze-aliases*
+    dup [ val>> ] [ dst>> ] bi constants get set-at ;
+
+M: ##load-indirect analyze-aliases*
+    dup dst>> set-heap-ac ;
+
+M: ##allot analyze-aliases*
+    #! A freshly allocated object is distinct from any other
+    #! object.
+    dup dst>> set-new-ac ;
+
+M: ##read analyze-aliases*
+    dup dst>> set-heap-ac
+    dup [ dst>> ] [ insn-slot# ] [ insn-object ] tri
+    2dup live-slot dup [
+        2nip f \ ##copy boa analyze-aliases* nip
+    ] [
+        drop remember-slot
+    ] if ;
+
+: idempotent? ( value slot#/f vreg -- ? )
+    #! Are we storing a value back to the same slot it was read
+    #! from?
+    live-slot = ;
+
+M: ##write analyze-aliases*
+    dup
+    [ src>> resolve ] [ insn-slot# ] [ insn-object ] tri
+    [ remember-set-slot drop ] [ load-slot ] 3bi ;
+
+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 ;
+
+M: insn analyze-aliases* ;
+
+: analyze-aliases ( insns -- insns' )
+    [ insn# set analyze-aliases* ] map-index sift ;
+
+SYMBOL: live-stores
+
+: compute-live-stores ( -- )
+    histories get
+    values [
+        values [ [ store? ] filter [ insn#>> ] map ] map concat
+    ] map concat unique
+    live-stores set ;
+
+GENERIC: eliminate-dead-stores* ( insn -- insn' )
+
+: (eliminate-dead-stores) ( insn -- insn' )
+    dup insn-slot# [
+        insn# get live-stores get key? [
+            drop f
+        ] unless
+    ] when ;
+
+M: ##replace eliminate-dead-stores*
+    #! Writes to above the top of the stack can be pruned also.
+    #! This is sound since any such writes are not observable
+    #! after the basic block, and any reads of those locations
+    #! will have been converted to copies by analyze-slot,
+    #! and the final stack height of the basic block is set at
+    #! the beginning by compiler.cfg.stack.
+    dup loc>> n>> 0 < [ drop f ] [ (eliminate-dead-stores) ] if ;
+
+M: ##set-slot eliminate-dead-stores* (eliminate-dead-stores) ;
+
+M: ##set-slot-imm eliminate-dead-stores* (eliminate-dead-stores) ;
+
+M: insn eliminate-dead-stores* ;
+
+: eliminate-dead-stores ( insns -- insns' )
+    [ insn# set eliminate-dead-stores* ] map-index sift ;
+
+: alias-analysis ( insns -- insns' )
+    init-alias-analysis
+    analyze-aliases
+    compute-live-stores
+    eliminate-dead-stores ;
diff --git a/basis/compiler/cfg/copy-prop/copy-prop.factor b/basis/compiler/cfg/copy-prop/copy-prop.factor
new file mode 100644
index 0000000000..52cc75f047
--- /dev/null
+++ b/basis/compiler/cfg/copy-prop/copy-prop.factor
@@ -0,0 +1,12 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: kernel namespaces assocs accessors ;
+IN: compiler.cfg.copy-prop
+
+SYMBOL: copies
+
+: resolve ( vreg -- vreg )
+    dup copies get at swap or ;
+
+: record-copy ( insn -- )
+    [ src>> resolve ] [ dst>> ] bi copies get set-at ; inline
diff --git a/basis/compiler/cfg/intrinsics/utilities/utilities.factor b/basis/compiler/cfg/intrinsics/utilities/utilities.factor
deleted file mode 100644
index bc6442886c..0000000000
--- a/basis/compiler/cfg/intrinsics/utilities/utilities.factor
+++ /dev/null
@@ -1,11 +0,0 @@
-! Copyright (C) 2008 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors kernel math layouts cpu.architecture
-compiler.cfg.instructions ;
-IN: compiler.cfg.intrinsics.utilities
-
-: value-info-small-tagged? ( value-info -- ? )
-    literal>> dup fixnum? [ tag-fixnum small-enough? ] [ drop f ] if ;
-
-: emit-primitive ( node -- )
-    word>> ##call ;
diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor
new file mode 100644
index 0000000000..0c452f8f3c
--- /dev/null
+++ b/basis/compiler/cfg/utilities/utilities.factor
@@ -0,0 +1,26 @@
+! Copyright (C) 2008 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors kernel math layouts namespaces cpu.architecture
+namespaces compiler.cfg compiler.cfg.instructions ;
+IN: compiler.cfg.utilities
+
+: value-info-small-tagged? ( value-info -- ? )
+    literal>> dup fixnum? [ tag-fixnum small-enough? ] [ drop f ] if ;
+
+: set-basic-block ( basic-block -- )
+    [ basic-block set ] [ instructions>> building set ] bi ;
+
+: begin-basic-block ( -- )
+    <basic-block> basic-block get [
+        dupd successors>> push
+    ] when*
+    set-basic-block ;
+
+: end-basic-block ( -- )
+    building off
+    basic-block off ;
+
+: emit-primitive ( node -- )
+    word>> ##call begin-basic-block ;
+
+: need-gc ( -- ) basic-block get t >>gc drop ;