compiler.cfg.gvn: I'm stupid; don't think a separate assoc is needed
parent
087329bbec
commit
67053cd540
|
@ -5,8 +5,7 @@ IN: compiler.cfg.gvn.graph
|
||||||
|
|
||||||
SYMBOL: input-expr-counter
|
SYMBOL: input-expr-counter
|
||||||
|
|
||||||
! assoc mapping vregs to *optimistic* value numbers
|
! assoc mapping vregs to value numbers
|
||||||
! initialized per iteration of global value numbering
|
|
||||||
! this is the identity on canonical representatives
|
! this is the identity on canonical representatives
|
||||||
SYMBOL: vregs>vns
|
SYMBOL: vregs>vns
|
||||||
|
|
||||||
|
@ -16,36 +15,24 @@ SYMBOL: exprs>vns
|
||||||
! assoc mapping value numbers to instructions
|
! assoc mapping value numbers to instructions
|
||||||
SYMBOL: vns>insns
|
SYMBOL: vns>insns
|
||||||
|
|
||||||
! assoc mapping vregs to value numbers
|
! boolean to track whether vregs>vns changes
|
||||||
! once this stops changing, we know the value numbers are sound
|
|
||||||
SYMBOL: valid-vns
|
|
||||||
|
|
||||||
! boolean to track whether valid-vns changes
|
|
||||||
SYMBOL: changed?
|
SYMBOL: changed?
|
||||||
|
|
||||||
: vn>insn ( vn -- insn ) vns>insns get at ;
|
: vn>insn ( vn -- insn ) vns>insns get at ;
|
||||||
|
|
||||||
: vreg>vn ( vreg -- vn ) valid-vns get at ;
|
: vreg>vn ( vreg -- vn ) vregs>vns get at ;
|
||||||
|
|
||||||
: optimistic-vn ( default-vn vreg -- vn )
|
: set-vn ( vn vreg -- )
|
||||||
vregs>vns get ?at
|
vregs>vns get maybe-set-at [ changed? on ] when ;
|
||||||
[ nip ]
|
|
||||||
[ dupd vregs>vns get set-at ] if ;
|
|
||||||
|
|
||||||
: set-vn ( default-vn vreg -- )
|
|
||||||
[ optimistic-vn ] keep
|
|
||||||
valid-vns get maybe-set-at [ changed? on ] when ;
|
|
||||||
|
|
||||||
: vreg>insn ( vreg -- insn ) vreg>vn vn>insn ;
|
: vreg>insn ( vreg -- insn ) vreg>vn vn>insn ;
|
||||||
|
|
||||||
: clear-optimistic-value-graph ( -- )
|
: clear-exprs ( -- )
|
||||||
vregs>vns get clear-assoc
|
|
||||||
exprs>vns get clear-assoc
|
exprs>vns get clear-assoc
|
||||||
vns>insns get clear-assoc ;
|
vns>insns get clear-assoc ;
|
||||||
|
|
||||||
: init-value-graph ( -- )
|
: init-value-graph ( -- )
|
||||||
0 input-expr-counter set
|
0 input-expr-counter set
|
||||||
H{ } clone valid-vns set
|
|
||||||
H{ } clone vregs>vns set
|
H{ } clone vregs>vns set
|
||||||
H{ } clone exprs>vns set
|
H{ } clone exprs>vns set
|
||||||
H{ } clone vns>insns set ;
|
H{ } clone vns>insns set ;
|
||||||
|
|
|
@ -73,7 +73,7 @@ M: array process-instruction
|
||||||
! comparisons.factor, alien.factor, and slots.factor
|
! comparisons.factor, alien.factor, and slots.factor
|
||||||
|
|
||||||
: value-numbering-iteration ( cfg -- )
|
: value-numbering-iteration ( cfg -- )
|
||||||
clear-optimistic-value-graph
|
clear-exprs
|
||||||
[ value-numbering-step drop ] simple-analysis ;
|
[ value-numbering-step drop ] simple-analysis ;
|
||||||
|
|
||||||
: identify-redundancies ( cfg -- )
|
: identify-redundancies ( cfg -- )
|
||||||
|
@ -85,7 +85,7 @@ M: array process-instruction
|
||||||
] loop ;
|
] loop ;
|
||||||
|
|
||||||
: eliminate-redundancies ( cfg -- )
|
: eliminate-redundancies ( cfg -- )
|
||||||
clear-optimistic-value-graph
|
clear-exprs
|
||||||
[ value-numbering-step ] simple-optimization ;
|
[ value-numbering-step ] simple-optimization ;
|
||||||
|
|
||||||
: value-numbering ( cfg -- cfg )
|
: value-numbering ( cfg -- cfg )
|
||||||
|
|
|
@ -16,16 +16,16 @@ M: reference-expr expr>str value>> unparse ;
|
||||||
|
|
||||||
M: object expr>str [ unparse ] map " " join ;
|
M: object expr>str [ unparse ] map " " join ;
|
||||||
|
|
||||||
: local-value-mapping ( from to -- str )
|
: value-mapping ( from to -- str )
|
||||||
over exprs>vns get value-at* [
|
over exprs>vns get value-at* [
|
||||||
expr>str "%d -> <%d> (%s)\\l" sprintf
|
expr>str "%d -> <%d> (%s)\\l" sprintf
|
||||||
] [
|
] [
|
||||||
drop "%d -> <%d>\\l" sprintf
|
drop "%d -> <%d>\\l" sprintf
|
||||||
] if ;
|
] if ;
|
||||||
|
|
||||||
: optimistic ( -- str )
|
: gvns ( -- str )
|
||||||
vregs>vns get >alist natural-sort [
|
vregs>vns get >alist natural-sort [
|
||||||
first2 local-value-mapping
|
first2 value-mapping
|
||||||
] map "" concat-as ;
|
] map "" concat-as ;
|
||||||
|
|
||||||
: invert-assoc ( assoc -- inverted )
|
: invert-assoc ( assoc -- inverted )
|
||||||
|
@ -33,8 +33,8 @@ M: object expr>str [ unparse ] map " " join ;
|
||||||
[ push-at ] curry assoc-each
|
[ push-at ] curry assoc-each
|
||||||
] keep ;
|
] keep ;
|
||||||
|
|
||||||
: valid ( -- str )
|
: congruence-classes ( -- str )
|
||||||
valid-vns get invert-assoc >alist natural-sort [
|
vregs>vns get invert-assoc >alist natural-sort [
|
||||||
first2
|
first2
|
||||||
natural-sort [ number>string ] map ", " join
|
natural-sort [ number>string ] map ", " join
|
||||||
"<%d> : {%s}\\l" sprintf
|
"<%d> : {%s}\\l" sprintf
|
||||||
|
@ -43,18 +43,14 @@ M: object expr>str [ unparse ] map " " join ;
|
||||||
: basic-block# ( -- n )
|
: basic-block# ( -- n )
|
||||||
basic-block get number>> ;
|
basic-block get number>> ;
|
||||||
|
|
||||||
: add-valid-vns ( graph -- graph' )
|
: add-gvns ( graph -- graph' )
|
||||||
<anon>
|
"gvns" add-node[
|
||||||
"valid" add-node[ valid =label "plaintext" =shape ];
|
gvns congruence-classes "\\l\\l" glue =label
|
||||||
"valid" 0 add-edge[ "invis" =style ];
|
"plaintext" =shape
|
||||||
add ;
|
];
|
||||||
|
"gvns" 0 add-edge[ "invis" =style ];
|
||||||
: add-optimistic-vns ( graph -- graph' )
|
|
||||||
"opt" <cluster>
|
|
||||||
"invis" =style
|
|
||||||
"opt" add-node[ optimistic =label "plaintext" =shape ];
|
|
||||||
basic-block# add-node[ "bold" =style ];
|
basic-block# add-node[ "bold" =style ];
|
||||||
add ;
|
;
|
||||||
|
|
||||||
SYMBOL: iteration
|
SYMBOL: iteration
|
||||||
|
|
||||||
|
@ -66,7 +62,7 @@ SYMBOL: iteration
|
||||||
|
|
||||||
: draw-annotated-cfg ( -- )
|
: draw-annotated-cfg ( -- )
|
||||||
iteration-dir [
|
iteration-dir [
|
||||||
cfg get cfgviz add-valid-vns add-optimistic-vns
|
cfg get cfgviz add-gvns
|
||||||
basic-block# number>string "bb" prepend png
|
basic-block# number>string "bb" prepend png
|
||||||
] with-directory ;
|
] with-directory ;
|
||||||
|
|
||||||
|
@ -94,3 +90,10 @@ SYMBOL: iteration
|
||||||
0 iteration [ watch-optimizer* ] with-variable
|
0 iteration [ watch-optimizer* ] with-variable
|
||||||
] with-variable
|
] with-variable
|
||||||
] [ reset-gvn ] [ ] cleanup ;
|
] [ reset-gvn ] [ ] cleanup ;
|
||||||
|
|
||||||
|
USING: io.pathnames math math.private ;
|
||||||
|
|
||||||
|
: test-gvn ( path -- )
|
||||||
|
"resource:work" prepend-path
|
||||||
|
[ 0 100 [ 1 fixnum+fast ] times ]
|
||||||
|
watch-gvn ;
|
||||||
|
|
Loading…
Reference in New Issue