SYMBOL: input-expr-counter
-! assoc mapping vregs to *optimistic* value numbers
-! initialized per iteration of global value numbering
+! assoc mapping vregs to value numbers
! this is the identity on canonical representatives
SYMBOL: vregs>vns
! assoc mapping value numbers to instructions
SYMBOL: vns>insns
-! assoc mapping vregs to value numbers
-! once this stops changing, we know the value numbers are sound
-SYMBOL: valid-vns
-
-! boolean to track whether valid-vns changes
+! boolean to track whether vregs>vns changes
SYMBOL: changed?
: vn>insn ( vn -- insn ) vns>insns get at ;
-: vreg>vn ( vreg -- vn ) valid-vns get at ;
-
-: optimistic-vn ( default-vn vreg -- vn )
- vregs>vns get ?at
- [ nip ]
- [ dupd vregs>vns get set-at ] if ;
+: vreg>vn ( vreg -- vn ) vregs>vns get at ;
-: set-vn ( default-vn vreg -- )
- [ optimistic-vn ] keep
- valid-vns get maybe-set-at [ changed? on ] when ;
+: set-vn ( vn vreg -- )
+ vregs>vns get maybe-set-at [ changed? on ] when ;
: vreg>insn ( vreg -- insn ) vreg>vn vn>insn ;
-: clear-optimistic-value-graph ( -- )
- vregs>vns get clear-assoc
+: clear-exprs ( -- )
exprs>vns get clear-assoc
vns>insns get clear-assoc ;
: init-value-graph ( -- )
0 input-expr-counter set
- H{ } clone valid-vns set
H{ } clone vregs>vns set
H{ } clone exprs>vns set
H{ } clone vns>insns set ;
! comparisons.factor, alien.factor, and slots.factor
: value-numbering-iteration ( cfg -- )
- clear-optimistic-value-graph
+ clear-exprs
[ value-numbering-step drop ] simple-analysis ;
: identify-redundancies ( cfg -- )
] loop ;
: eliminate-redundancies ( cfg -- )
- clear-optimistic-value-graph
+ clear-exprs
[ value-numbering-step ] simple-optimization ;
: value-numbering ( cfg -- cfg )
M: object expr>str [ unparse ] map " " join ;
-: local-value-mapping ( from to -- str )
+: value-mapping ( from to -- str )
over exprs>vns get value-at* [
expr>str "%d -> <%d> (%s)\\l" sprintf
] [
drop "%d -> <%d>\\l" sprintf
] if ;
-: optimistic ( -- str )
+: gvns ( -- str )
vregs>vns get >alist natural-sort [
- first2 local-value-mapping
+ first2 value-mapping
] map "" concat-as ;
: invert-assoc ( assoc -- inverted )
[ push-at ] curry assoc-each
] keep ;
-: valid ( -- str )
- valid-vns get invert-assoc >alist natural-sort [
+: congruence-classes ( -- str )
+ vregs>vns get invert-assoc >alist natural-sort [
first2
natural-sort [ number>string ] map ", " join
"<%d> : {%s}\\l" sprintf
: basic-block# ( -- n )
basic-block get number>> ;
-: add-valid-vns ( graph -- graph' )
- <anon>
- "valid" add-node[ valid =label "plaintext" =shape ];
- "valid" 0 add-edge[ "invis" =style ];
- add ;
-
-: add-optimistic-vns ( graph -- graph' )
- "opt" <cluster>
- "invis" =style
- "opt" add-node[ optimistic =label "plaintext" =shape ];
- basic-block# add-node[ "bold" =style ];
- add ;
+: add-gvns ( graph -- graph' )
+ "gvns" add-node[
+ gvns congruence-classes "\\l\\l" glue =label
+ "plaintext" =shape
+ ];
+ "gvns" 0 add-edge[ "invis" =style ];
+ basic-block# add-node[ "bold" =style ];
+ ;
SYMBOL: iteration
: draw-annotated-cfg ( -- )
iteration-dir [
- cfg get cfgviz add-valid-vns add-optimistic-vns
+ cfg get cfgviz add-gvns
basic-block# number>string "bb" prepend png
] with-directory ;
0 iteration [ watch-optimizer* ] with-variable
] with-variable
] [ reset-gvn ] [ ] cleanup ;
+
+USING: io.pathnames math math.private ;
+
+: test-gvn ( path -- )
+ "resource:work" prepend-path
+ [ 0 100 [ 1 fixnum+fast ] times ]
+ watch-gvn ;