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 /sml/trunk/src/MLRISC/flowgraph/buildFlowgraph.sml
ViewVC logotype

Annotation of /sml/trunk/src/MLRISC/flowgraph/buildFlowgraph.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1020 - (view) (download)

1 : george 906 (* buildFlowgraph.sml
2 :     *
3 :     * COPYRIGHT (c) 2001 Bell Labs, Lucent Technologies
4 :     *)
5 :     signature CONTROL_FLOWGRAPH_GEN =
6 :     sig
7 :    
8 :     structure S : INSTRUCTION_STREAM
9 :     structure I : INSTRUCTIONS
10 : george 984 structure P : PSEUDO_OPS
11 : george 906 structure CFG : CONTROL_FLOW_GRAPH
12 : george 933 where I = I
13 : george 984 and P = P
14 : george 933 (*
15 : george 906 * This creates an emitter which can be used to build a CFG incrementally
16 :     *)
17 :     type instrStream =
18 :     (I.instruction, Annotations.annotations, I.C.cellset, CFG.cfg) S.stream
19 :    
20 : george 933 val build : unit -> instrStream
21 : george 906
22 :     end
23 :    
24 : george 984
25 :    
26 :    
27 : george 906 functor BuildFlowgraph
28 :     (structure Props : INSN_PROPERTIES
29 :     structure Stream : INSTRUCTION_STREAM
30 :     structure CFG : CONTROL_FLOW_GRAPH
31 : george 984 where I = Props.I
32 :     and P = Stream.P
33 : george 906 ) : CONTROL_FLOWGRAPH_GEN =
34 :     struct
35 :     structure CFG = CFG
36 : george 984 structure P = CFG.P
37 : george 906 structure I = Props.I
38 :     structure G = Graph
39 :     structure S = Stream
40 :     structure Fmt = Format
41 : george 984 structure PB = PseudoOpsBasisTyp
42 :    
43 : george 906 exception LabelNotFound
44 :    
45 :     type instrStream =
46 :     (I.instruction, Annotations.annotations, CFG.I.C.cellset, CFG.cfg) S.stream
47 :    
48 :     fun error msg = MLRiscErrorMsg.error ("BuildFlowGraph", msg)
49 :    
50 :     val hashLabel = Word.toInt o Label.hash
51 :    
52 : george 933 fun build () = let
53 :     val cfg as ref(G.GRAPH graph) = ref(CFG.new())
54 : george 906
55 :     (* list of blocks generated so far *)
56 :     val blockList = ref ([] : CFG.block list)
57 :    
58 :     (* list of entry labels to patch successors of ENTRY *)
59 :     val entryLabels = ref ([] : Label.label list)
60 : george 984
61 : george 906 (* block id associated with a label*)
62 :     val labelMap = IntHashTable.mkTable(32, LabelNotFound)
63 : jhr 950 val findLabel = IntHashTable.find labelMap
64 : george 906 val addLabel = IntHashTable.insert labelMap
65 :    
66 : george 984 (* Data in text segment is read-only *)
67 : jhr 1014 datatype segment_t = TEXT | DATA | RO_DATA | BSS
68 : george 984 val segmentF = ref TEXT
69 :    
70 :     (* the block names *)
71 : george 906 val blockNames = ref [] : Annotations.annotations ref
72 :    
73 : george 984 (* can instructions be reordered *)
74 :     val reorder = ref [] : Annotations.annotations ref
75 :    
76 : george 906 (* noblock or invalid block has id of ~1 *)
77 :     val noBlock = CFG.newBlock(~1, ref 0)
78 : george 984
79 : george 906 (* current block being built up *)
80 :     val currentBlock = ref noBlock
81 :    
82 :    
83 :     (* add a new block and make it the current block being built up *)
84 :     fun newBlock(freq) = let
85 :     val G.GRAPH graph = !cfg
86 :     val id = #new_id graph ()
87 :     val blk as CFG.BLOCK{annotations, ...} = CFG.newBlock(id, ref freq)
88 :     in
89 :     currentBlock := blk;
90 : george 984 annotations := !blockNames @ !reorder;
91 : george 906 blockList := blk :: !blockList;
92 :     #add_node graph (id, blk);
93 :     blk
94 :     end
95 :    
96 :    
97 :     (* get current basic block *)
98 :     fun getBlock () =
99 :     (case !currentBlock of CFG.BLOCK{id= ~1, ...} => newBlock(1) | blk => blk)
100 :    
101 :    
102 :     (* ------------------------cluster---------------------------*)
103 :     (* start a new cluster *)
104 : george 984 fun beginCluster _ =
105 :     (blockList := [];
106 :     entryLabels := [];
107 :     IntHashTable.clear labelMap;
108 :     blockNames := [];
109 :     currentBlock := noBlock)
110 : george 906
111 :     (* emit an instruction *)
112 :     fun emit i = let
113 :     val CFG.BLOCK{insns, ...} = getBlock()
114 :     fun terminate() = currentBlock := noBlock;
115 :     in
116 :     insns := i:: !insns;
117 :     case Props.instrKind(i)
118 :     of Props.IK_JUMP => terminate()
119 :     | Props.IK_CALL_WITH_CUTS => terminate()
120 :     | _ => ()
121 :     (*esac*)
122 :     end
123 :    
124 :     (* make current block an exit block *)
125 :     fun exitBlock liveout = let
126 :     fun setLiveOut(CFG.BLOCK{annotations, ...}) =
127 :     annotations := #create CFG.LIVEOUT liveout :: !annotations
128 :     in
129 :     case !currentBlock
130 :     of CFG.BLOCK{id= ~1, ...} =>
131 :     (case !blockList
132 :     of [] => error "exitBlocks"
133 :     | blk::_ => setLiveOut blk
134 :     (*esac*))
135 :     | blk => setLiveOut blk
136 :     end (* exitBlock *)
137 :    
138 :    
139 :     (* end cluster --- all done *)
140 :     fun endCluster (annotations) = let
141 :     val cfg as G.GRAPH graph = (!cfg before cfg := CFG.new())
142 :     val _ = CFG.init(cfg) (* create unique ENTRY/EXIT nodes *)
143 :    
144 :     val ENTRY = hd(#entries graph ())
145 :     val EXIT = hd(#exits graph ())
146 :    
147 :     fun addEdge(from, to, kind) =
148 :     #add_edge graph (from, to, CFG.EDGE{k=kind, w=ref 0, a=ref[]})
149 :    
150 :     fun target lab =
151 :     (case (IntHashTable.find labelMap (hashLabel lab))
152 :     of SOME bId => bId
153 :     | NONE => EXIT)
154 :    
155 :     fun jump(from, [Props.ESCAPES], _) = addEdge(from, EXIT, CFG.FALLSTHRU)
156 :     | jump(from, [Props.LABELLED lab], _) = addEdge(from, target lab, CFG.JUMP)
157 :     | jump(from, [Props.LABELLED lab, Props.FALLTHROUGH], blks) = let
158 :     fun next(CFG.BLOCK{id, ...}::_) = id
159 : george 984 | next [] = error "jump.next"
160 : george 906 in
161 :     addEdge(from, target lab, CFG.BRANCH true);
162 :     addEdge(from, next blks, CFG.BRANCH false)
163 :     end
164 :     | jump(from, [f as Props.FALLTHROUGH, l as Props.LABELLED _], blks) =
165 :     jump(from, [l, f], blks)
166 :     | jump(from, targets, _) = let
167 :     fun switch(Props.LABELLED lab, n) =
168 :     (addEdge(from, target lab, CFG.SWITCH(n)); n+1)
169 :     | switch _ = error "jump.switch"
170 :     in List.foldl switch 0 targets; ()
171 :     end
172 :    
173 : george 1017 and fallsThru(id, blks) =
174 : george 906 case blks
175 : george 1017 of [] => addEdge(id, EXIT, CFG.FALLSTHRU)
176 : george 1020 | CFG.BLOCK{id=next, ...}::_ => addEdge(id, next, CFG.FALLSTHRU)
177 :     (*esac*)
178 : george 906
179 : george 1020 and addEdges [] = ()
180 :     | addEdges(CFG.BLOCK{id, insns=ref[], ...}::blocks) = fallsThru(id, blocks)
181 :     | addEdges(CFG.BLOCK{id, insns=ref(instr::_), ...}::blocks) = let
182 :     fun doJmp () = jump(id, Props.branchTargets instr, blocks)
183 :     in
184 :     case Props.instrKind instr
185 :     of Props.IK_JUMP => doJmp()
186 :     | Props.IK_CALL_WITH_CUTS => doJmp()
187 :     | _ => fallsThru(id, blocks)
188 :     (*esac*);
189 :     addEdges(blocks)
190 :     end
191 :     in
192 :     addEdges (rev(!blockList));
193 :     app (fn lab => addEdge(ENTRY, target lab, CFG.ENTRY)) (!entryLabels);
194 :     let val an = CFG.annotations cfg in an := annotations @ (!an) end;
195 :     cfg
196 :     end (* endCluster *)
197 : george 906
198 :    
199 : george 1020 (* ------------------------annotations-----------------------*)
200 :     (* XXX: Bug: EMPTYBLOCK does not really generate an empty block
201 :     * but merely terminates the current block. Contradicts the comment
202 :     * in instructions/mlriscAnnotations.sig.
203 :     * It should be (newBlock(1); newBlock(1); ())
204 :     *)
205 : george 906
206 : george 1020 (* Add a new annotation *)
207 :     fun addAnnotation a =
208 :     (case a
209 :     of MLRiscAnnotations.BLOCKNAMES names =>
210 :     (blockNames := names; newBlock(1); ())
211 :     | MLRiscAnnotations.EMPTYBLOCK => (newBlock(1); ())
212 :     | MLRiscAnnotations.EXECUTIONFREQ f =>
213 :     (case !currentBlock
214 :     of CFG.BLOCK{id= ~1, ...} => (newBlock(f); ())
215 :     | CFG.BLOCK{freq, ...} => freq := f
216 :     (*esac*))
217 :     | a => let
218 :     val CFG.BLOCK{annotations,...} = getBlock()
219 :     in annotations := a :: !annotations
220 :     end
221 :     (*esac*))
222 : george 984
223 : george 1020 (* get annotation associated with flow graph *)
224 :     fun getAnnotations () = CFG.annotations(!cfg)
225 : george 984
226 : george 1020 (* add a comment annotation to the current block *)
227 :     fun comment msg =
228 :     case !segmentF
229 :     of TEXT => addAnnotation (#create MLRiscAnnotations.COMMENT msg)
230 :     | _ => let
231 :     val Graph.GRAPH graph = !cfg
232 :     val CFG.INFO{data, ...} = #graph_info graph
233 :     in data := PB.COMMENT msg :: !data
234 :     end
235 : george 984
236 :    
237 : george 1020 (* -------------------------labels---------------------------*)
238 :     (* BUG: Does not respect any ordering between labels and pseudoOps.
239 :     * This could be a problem with jump tables.
240 :     *)
241 :     fun addPseudoOp p = let
242 :     val Graph.GRAPH graph = !cfg
243 :     val CFG.INFO{data, ...} = #graph_info graph
244 : george 1016
245 : george 1020 fun addAlignment () = let
246 :     val CFG.BLOCK{align, ...} = newBlock(1)
247 :     in align := SOME p
248 :     end
249 : george 1016
250 : george 1020 fun startSegment(seg) = (data := p :: !data; segmentF := seg)
251 : george 984
252 : george 1020 fun addData () = data := p :: !data
253 :    
254 :     fun chkAddData(seg) =
255 : george 984 (case !segmentF
256 : george 1020 of TEXT =>
257 :     error (Fmt.format "addPseudoOp: %s in TEXT segment" [Fmt.STR seg])
258 :     | _ => addData()
259 :     (*esac*))
260 : george 984
261 : george 1020 in
262 :     case p
263 :     of PB.ALIGN_SZ _ => addAlignment()
264 :     | PB.ALIGN_ENTRY => addAlignment()
265 :     | PB.ALIGN_LABEL => addAlignment()
266 :     | PB.DATA_LABEL _ =>
267 :     (case !segmentF
268 :     of TEXT => error "addPseudoOp: DATA_LABEL in TEXT segment"
269 :     | _ => (data := p:: !data)
270 :     (*esac*))
271 : george 984
272 : george 1020 | PB.DATA_READ_ONLY => startSegment(RO_DATA)
273 :     | PB.DATA => startSegment(DATA)
274 :     | PB.TEXT => startSegment(TEXT)
275 :     | PB.BSS => startSegment(BSS)
276 :     | PB.SECTION _ =>
277 :     (case !segmentF
278 :     of TEXT => error "addPseudoOp: SECTION in TEXT segment"
279 :     | _ => data := p :: !data
280 :     (*esac*))
281 :     | PB.REORDER => (reorder := []; newBlock(1); ())
282 :     | PB.NOREORDER =>
283 :     (reorder := [#create MLRiscAnnotations.NOREORDER ()]; newBlock(1); ())
284 :    
285 :     | PB.INT _ => chkAddData("INT")
286 :     | PB.FLOAT _ => chkAddData("FLOAT")
287 :     | PB.ASCII _ => chkAddData("ASCII")
288 :     | PB.ASCIIZ _ => chkAddData("ASCIIZ")
289 :     | PB.SPACE _ => chkAddData("SPACE")
290 :     | PB.IMPORT _ => addData()
291 :     | PB.EXPORT _ => addData()
292 :     | PB.EXT _ => chkAddData("EXT")
293 :     end
294 :    
295 :     fun defineLabel lab =
296 :     (case !segmentF
297 :     of TEXT =>
298 :     (case findLabel (hashLabel lab)
299 :     of NONE => let
300 :     fun newBlk () =
301 :     (case !currentBlock
302 :     of CFG.BLOCK{id= ~1, ...} => newBlock(1)
303 :     | CFG.BLOCK{insns=ref[], ...} => !currentBlock (* probably aligned block *)
304 :     | _ => newBlock(1)
305 :     (*esac*))
306 :     val CFG.BLOCK{id, labels, ...} = newBlk()
307 :     in
308 :     labels := lab :: !labels;
309 :     addLabel(hashLabel lab, id)
310 :     end
311 :     | SOME _ =>
312 :     error (concat
313 :     ["multiple definitions of label \"", Label.toString lab, "\""])
314 :     (*esac*))
315 :     | _ => let
316 :     (* non-text segment *)
317 :     val Graph.GRAPH graph = !cfg
318 :     val CFG.INFO{data, ...} = #graph_info graph
319 :     in
320 :     data := PB.DATA_LABEL lab :: !data
321 :     end
322 :     (*esac*))
323 : george 984
324 :     fun entryLabel lab = (defineLabel lab; entryLabels := lab :: !entryLabels)
325 : george 906 in
326 :     S.STREAM
327 :     {
328 :     comment = comment,
329 :     getAnnotations= getAnnotations,
330 :     annotation = addAnnotation,
331 :     defineLabel = defineLabel,
332 :     entryLabel = entryLabel,
333 :     pseudoOp = addPseudoOp,
334 :     beginCluster = beginCluster,
335 :     emit = emit,
336 :     exitBlock = exitBlock,
337 :     endCluster = endCluster
338 :     }
339 : george 1020 end (* build *)
340 : george 906 end

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