compiler.cfg.gvn: I'm stupid; don't think a separate assoc is needed
Alex Vondrak
John Benediktsson
parent
087329bbec
commit
67053cd540
|
|
@ -5,8 +5,7 @@ IN: compiler.cfg.gvn.graph
|
|||
|
||||
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
|
||||
|
||||
|
|
@ -16,36 +15,24 @@ SYMBOL: exprs>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 ;
|
||||
: vreg>vn ( vreg -- vn ) vregs>vns get at ;
|
||||
|
||||
: optimistic-vn ( default-vn vreg -- vn )
|
||||
vregs>vns get ?at
|
||||
[ 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 ;
|
||||
: 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 ;
|
||||
|
|
|
|||
|
|
@ -73,7 +73,7 @@ M: array process-instruction
|
|||
! 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 -- )
|
||||
|
|
@ -85,7 +85,7 @@ M: array process-instruction
|
|||
] loop ;
|
||||
|
||||
: eliminate-redundancies ( cfg -- )
|
||||
clear-optimistic-value-graph
|
||||
clear-exprs
|
||||
[ value-numbering-step ] simple-optimization ;
|
||||
|
||||
: value-numbering ( cfg -- cfg )
|
||||
|
|
|
|||
|
|
@ -16,16 +16,16 @@ M: reference-expr expr>str value>> unparse ;
|
|||
|
||||
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 )
|
||||
|
|
@ -33,8 +33,8 @@ M: object expr>str [ unparse ] map " " join ;
|
|||
[ 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
|
||||
|
|
@ -43,18 +43,14 @@ M: object expr>str [ unparse ] map " " join ;
|
|||
: 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 ];
|
||||
: 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 ];
|
||||
add ;
|
||||
;
|
||||
|
||||
SYMBOL: iteration
|
||||
|
||||
|
|
@ -66,7 +62,7 @@ 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 ;
|
||||
|
||||
|
|
@ -94,3 +90,10 @@ SYMBOL: iteration
|
|||
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 ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue