Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /MLRISC/releases/release-110.64/IR/mlrisc-ir.sml
ViewVC logotype

Annotation of /MLRISC/releases/release-110.64/IR/mlrisc-ir.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 624 - (view) (download)
Original Path: sml/trunk/src/MLRISC/IR/mlrisc-ir.sml

1 : monnier 411 (*
2 :     * MLRISC IR
3 :     *
4 :     * This is for performing whole program analysis.
5 :     * All optimizations are based on this representation.
6 :     * It provides a few useful views: dominator tree, control dependence graph,
7 :     * loop nesting (interval) structure etc. Also there is a mechanism to
8 :     * incrementally attach additional views to the IR. The SSA infrastructure
9 :     * is implemented in such a manner.
10 :     *
11 :     * -- Allen
12 :     *)
13 :    
14 : george 545 functor MLRISC_IR
15 : monnier 245 (structure CFG : CONTROL_FLOW_GRAPH
16 :     structure CDG : CONTROL_DEPENDENCE_GRAPH
17 :     structure Loop : LOOP_STRUCTURE
18 :     structure GraphViewer : GRAPH_VIEWER
19 :     structure Util : CFG_UTIL
20 :     sharing Loop.Dom = CDG.Dom
21 :     sharing Util.CFG = CFG
22 :     ) : MLRISC_IR =
23 :     struct
24 :    
25 :     structure I = CFG.I
26 :     structure CFG = CFG
27 :     structure Dom = Loop.Dom
28 :     structure CDG = CDG
29 :     structure Loop = Loop
30 :     structure G = Graph
31 :     structure A = Annotations
32 :     structure Util = Util
33 :     structure L = GraphLayout
34 :    
35 :     type cfg = CFG.cfg
36 :     type IR = CFG.cfg
37 :     type dom = (CFG.block,CFG.edge_info,CFG.info) Dom.dominator_tree
38 :     type pdom = (CFG.block,CFG.edge_info,CFG.info) Dom.postdominator_tree
39 :     type cdg = (CFG.block,CFG.edge_info,CFG.info) CDG.cdg
40 :     type loop = (CFG.block,CFG.edge_info,CFG.info) Loop.loop_structure
41 :    
42 :     val layouts = ref [] : (string * (IR -> L.layout)) list ref
43 :    
44 :     fun addLayout name layout =
45 :     let fun f((x,y)::rest) = if x = name then (x,layout)::rest
46 :     else (x,y)::f rest
47 :     | f [] = [(name,layout)]
48 :     in layouts := f(!layouts) end
49 :    
50 : monnier 411 exception NoLayout
51 :    
52 :     fun findLayout name =
53 :     let fun f [] = (print ("[Can't find "^name^"]\n"); raise NoLayout)
54 :     | f((x,layout)::rest) = if x = name then layout else f rest
55 : monnier 245 in f(!layouts) end
56 :    
57 : monnier 411 fun view name IR = GraphViewer.view(findLayout name IR)
58 :     handle NoLayout => ()
59 :    
60 :     fun views names IR =
61 :     let val layouts = map (fn n => findLayout n IR) names
62 :     in GraphViewer.view(GraphCombinations.sums layouts)
63 :     end handle NoLayout => ()
64 :    
65 : monnier 245 fun viewSubgraph IR subgraph =
66 :     GraphViewer.view (CFG.subgraphLayout{cfg=IR,subgraph=subgraph})
67 :    
68 :     (*
69 :     * This function defines how we compute a new view
70 :     *)
71 :    
72 : monnier 429 val verbose = MLRiscControl.getFlag "verbose"
73 : monnier 411
74 :     fun memo name compute =
75 : leunga 624 let val {get,set,...} = A.new(SOME(fn _ => name))
76 :     fun getView(IR as G.GRAPH ir : IR)=
77 :     let val CFG.INFO{annotations, ...} = #graph_info ir
78 :     fun process(SOME(ref(SOME info))) =
79 : monnier 411 (if !verbose then print ("[reusing "^name^"]") else (); info)
80 :     | process(SOME r) =
81 : leunga 624 let val _ =
82 :     if !verbose then print("[computing "^name) else ()
83 : monnier 411 val info = compute IR
84 :     val _ = if !verbose then print "]" else ()
85 :     in r := SOME info; info end
86 :     | process NONE =
87 :     let val r = ref NONE
88 :     fun kill() = (r := NONE;
89 :     if !verbose then print("[uncaching "^name^"]")
90 :     else ())
91 : leunga 624 in annotations := #create CFG.CHANGED(name, kill) ::
92 : monnier 469 set(r,!annotations);
93 : monnier 411 process(SOME r)
94 :     end
95 :     in process(get (!annotations)) end
96 : monnier 245 in getView
97 :     end
98 :    
99 :     (*
100 :     * Extract various views from an IR
101 :     *)
102 :    
103 : monnier 429 val dom = memo "dom" Dom.makeDominator
104 :     val pdom = memo "pdom" Dom.makePostdominator
105 :     fun doms IR = (dom IR,pdom IR)
106 : monnier 411 val cdg = memo "cdg"
107 : monnier 429 (fn IR => CDG.control_dependence_graph CFG.cdgEdge (pdom IR))
108 : monnier 411 val loop = memo "loop" (Loop.loop_structure o dom)
109 : monnier 245 val changed = CFG.changed
110 :    
111 :     (*
112 :     * Methods to layout various graphs
113 :     *)
114 :     fun defaultEdge _ = [L.COLOR "red"]
115 :     fun defaultGraph _ = []
116 :     fun layoutDom' IR G =
117 :     let val {node,...} = CFG.viewStyle IR
118 :     in L.makeLayout {edge = defaultEdge,
119 :     graph= defaultGraph,
120 : monnier 429 node = node} G
121 : monnier 245 end
122 :    
123 :     fun layoutDom IR = layoutDom' IR (dom IR)
124 :     fun layoutPdom IR = layoutDom' IR (pdom IR)
125 :     fun layoutDoms IR = layoutDom' IR
126 :     let val (dom,pdom) = doms IR
127 :     in GraphCombinations.sum(dom,ReversedGraphView.rev_view pdom)
128 :     end
129 :     fun layoutCDG IR = CFG.viewLayout(cdg IR)
130 :     fun layoutLoop (IR as G.GRAPH cfg) =
131 : monnier 429 let val loop = loop IR
132 : monnier 245 val regmap = CFG.regmap IR
133 : leunga 624 val an = !(CFG.annotations IR)
134 : monnier 245 fun mkNodes nodes =
135 :     String.concat(map (fn i => Int.toString i^" ") nodes)
136 :     fun mkEdges edges =
137 :     String.concat(map
138 :     (fn (i,j,_) => Int.toString i^"->"^Int.toString j^" ") edges)
139 :     fun node(_,Loop.LOOP{nesting,header,loop_nodes,
140 :     backedges,exits,...}) =
141 : monnier 469 [L.LABEL
142 :     ("nesting: "^Int.toString nesting^"\n"^
143 :     CFG.show_block an regmap (#node_info cfg header)^
144 :     "entry edges: "^mkEdges(Loop.entryEdges loop header)^"\n"^
145 :     "loop_nodes: "^mkNodes loop_nodes^"\n"^
146 :     "backedges: "^mkEdges backedges^"\n"^
147 :     "exits: "^mkEdges exits^"\n"
148 :     )]
149 : monnier 245 in L.makeLayout {edge=defaultEdge,
150 :     graph=defaultGraph,
151 :     node=node} loop
152 :     end
153 :    
154 :     (*
155 :     * Insert the layout methods here.
156 :     *)
157 :     val _ = addLayout "cfg" CFG.viewLayout
158 :     val _ = addLayout "dom" layoutDom
159 :     val _ = addLayout "pdom" layoutPdom
160 :     val _ = addLayout "doms" layoutDoms
161 :     val _ = addLayout "cdg" layoutCDG
162 :     val _ = addLayout "loop" layoutLoop
163 :    
164 :     end
165 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0