compiler.cfg.gvn: I'm stupid; don't think a separate assoc is needed

db4
Alex Vondrak 2011-06-09 20:33:06 -07:00 committed by John Benediktsson
parent 087329bbec
commit 67053cd540
3 changed files with 29 additions and 39 deletions

View File

@ -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 ;

View File

@ -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 )

View File

@ -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 ;