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{
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
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
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
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
[
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
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
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
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
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
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
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
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
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
! 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
! Map vregs -> slot# -> vreg
SYMBOL: live-slots
-! Current instruction number
-SYMBOL: insn#
+! Maps vreg -> slot# -> insn# of last store or f
+SYMBOL: recent-stores
-! Load/store history, for dead store elimination
-TUPLE: load insn# ;
-TUPLE: store insn# ;
+! A set of insn#s of dead stores
+SYMBOL: dead-stores
-: new-action ( class -- action )
- insn# get swap boa ; inline
+: dead-store ( insn# -- ) dead-stores get adjoin ;
-! Maps vreg -> slot# -> sequence of loads/stores
-SYMBOL: histories
-
-: history ( vreg -- history ) histories get at ;
-
-: set-ac ( vreg ac -- )
+:: 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 ;
+ H{ } clone vreg recent-stores get set-at
+ H{ } clone vreg live-slots get set-at
+ ac vreg vregs>acs get set-at
+ vreg ac acs>vregs get push-at ;
: live-slot ( slot#/f vreg -- vreg' )
#! If the slot number is unknown, we never reuse a previous
: 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 ;
+ [ recent-stores get at delete-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 ;
+ [ recent-stores get at clear-assoc ] each-alias ;
-: remember-slot ( value slot#/f vreg -- )
- over
- [ [ record-constant-slot ] [ load-constant-slot ] 2bi ]
- [ 2nip record-computed-slot ] if ;
+:: remember-slot ( value slot# vreg -- )
+ slot# [
+ slot# vreg record-constant-slot
+ value slot# vreg load-constant-slot
+ ] [ vreg record-computed-slot ] if ;
SYMBOL: ac-counter
: 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 last store? [ dup pop* ] when ] unless
- store new-action swap ?push
- ] change-at ;
+:: record-constant-set-slot ( insn# slot# vreg -- )
+ vreg recent-stores get at :> recent-stores
+ slot# recent-stores at [ dead-store ] when*
+ insn# slot# recent-stores set-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 -- )
- over [
- [ record-constant-set-slot ]
- [ kill-constant-set-slot ]
- 2bi
- ] [ nip kill-computed-set-slot ] if ;
+:: remember-set-slot ( insn# slot# vreg -- )
+ slot# [
+ insn# slot# vreg record-constant-set-slot
+ slot# vreg kill-constant-set-slot
+ ] [ vreg kill-computed-set-slot ] if ;
GENERIC: insn-slot# ( insn -- slot#/f )
GENERIC: insn-object ( insn -- vreg )
M: ##vm-field insn-object drop \ ##vm-field ;
M: ##set-vm-field insn-object drop \ ##vm-field ;
-: init-alias-analysis ( insns -- insns' )
- H{ } clone histories set
- H{ } clone vregs>acs set
- H{ } clone acs>vregs set
- H{ } clone live-slots set
- H{ } clone copies set
+GENERIC: analyze-aliases ( insn -- insn' )
- 0 ac-counter set
- next-ac heap-ac set
-
- \ ##vm-field set-new-ac
- \ ##alien-global set-new-ac
-
- dup local-live-in [ set-heap-ac ] each ;
+M: insn analyze-aliases ;
-GENERIC: analyze-aliases* ( insn -- insn' )
-
-M: insn analyze-aliases*
+M: vreg-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
[ 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 ;
#! from?
live-slot = ;
-M: ##write analyze-aliases*
- dup
- [ src>> resolve ] [ insn-slot# ] [ insn-object ] tri
- 3dup idempotent? [ 3drop ] [
- [ 2drop heap-ac get merge-acs ]
- [ remember-set-slot drop ]
- [ load-slot ]
- 3tri
- ] if ;
+M:: ##write analyze-aliases ( insn -- insn )
+ insn src>> resolve :> src
+ insn insn-slot# :> slot#
+ insn insn-object :> vreg
+ insn insn#>> :> insn#
+
+ 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
-M: ##copy analyze-aliases*
+ 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 ;
[ [ 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' )
- [ insn# set analyze-aliases* ] map-index sift ;
-
-SYMBOL: live-stores
+GENERIC: eliminate-dead-stores ( insn -- ? )
-: compute-live-stores ( -- )
- histories get
- values [
- values [ [ store? ] filter [ insn#>> ] map ] map concat
- ] map concat fast-set
- live-stores set ;
+M: ##set-slot-imm eliminate-dead-stores
+ insn#>> dead-stores get in? not ;
-GENERIC: eliminate-dead-stores* ( insn -- insn' )
-
-: (eliminate-dead-stores) ( insn -- insn' )
- dup insn-slot# [
- insn# get live-stores get in? [
- drop f
- ] unless
- ] when ;
+M: insn eliminate-dead-stores drop t ;
-M: ##set-slot eliminate-dead-stores* (eliminate-dead-stores) ;
-
-M: ##set-slot-imm eliminate-dead-stores* (eliminate-dead-stores) ;
-
-M: insn eliminate-dead-stores* ;
+: 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 ;
+
+: reset-alias-analysis ( -- )
+ recent-stores get clear-assoc
+ vregs>acs get clear-assoc
+ acs>vregs get clear-assoc
+ live-slots get clear-assoc
+ copies get clear-assoc
+ dead-stores get table>> clear-assoc
-: eliminate-dead-stores ( insns -- insns' )
- [ insn# set eliminate-dead-stores* ] map-index sift ;
+ next-ac heap-ac set
+ \ ##vm-field set-new-ac
+ \ ##alien-global set-new-ac ;
: alias-analysis-step ( insns -- insns' )
- init-alias-analysis
- analyze-aliases
- compute-live-stores
- eliminate-dead-stores ;
+ reset-alias-analysis
+ [ local-live-in [ set-heap-ac ] each ]
+ [ 0 [ [ insn#<< ] [ drop 1 + ] 2bi ] reduce drop ]
+ [ [ analyze-aliases ] map! [ eliminate-dead-stores ] filter! ] tri ;
: alias-analysis ( cfg -- cfg )
+ init-alias-analysis
dup [ alias-analysis-step ] simple-optimization ;
projects / factor.git / commitdiff