Home My Page Projects Code Snippets Project Openings diderot
Summary Activity Tracker Tasks SCM

SCM Repository

[diderot] Annotation of /trunk/src/compiler/IL/ssa-fn.sml
ViewVC logotype

Annotation of /trunk/src/compiler/IL/ssa-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 257 - (view) (download)

1 : jhr 137 (* ssa-fn.sml
2 : jhr 124 *
3 :     * COPYRIGHT (c) 2010 The Diderot Project (http://diderot.cs.uchicago.edu)
4 :     * All rights reserved.
5 : jhr 137 *
6 :     * The IL is a combination of a block-structured tree and an SSA control-flow
7 :     * graph of blocks.
8 : jhr 124 *)
9 :    
10 : jhr 198 signature SSA =
11 :     sig
12 :    
13 :     structure Op : OPERATORS
14 :    
15 : jhr 256 (***** CFG *****)
16 : jhr 198
17 : jhr 256 datatype node = ND of {
18 :     id : Stamp.stamp,
19 :     props : PropList.holder,
20 :     kind : node_kind
21 : jhr 198 }
22 :    
23 : jhr 256 and node_kind
24 :     = NULL
25 :     | ENTRY of {
26 :     succ : node ref
27 :     }
28 :     | JOIN of {
29 :     preds : node list ref,
30 :     phis : (var * var list) list ref, (* phi statements *)
31 :     succ : node ref
32 :     }
33 :     | COND of {
34 :     pred : node ref,
35 :     cond : var,
36 :     trueBranch : node ref,
37 :     falseBranch : node ref
38 :     }
39 :     | BLOCK of {
40 :     pred : node ref,
41 :     body : assign list ref,
42 :     succ : node ref
43 :     }
44 :     | NEW of {
45 :     pred : node ref,
46 :     actor : Atom.atom,
47 :     args : var list,
48 :     succ : node ref
49 :     }
50 :     | DIE of {
51 :     pred : node ref
52 :     }
53 :     | STABILIZE of {
54 :     pred : node ref
55 :     }
56 :     | EXIT of {
57 :     pred : node ref
58 :     }
59 : jhr 198
60 : jhr 256 (***** Statements *****)
61 :    
62 : jhr 198 and stmt = STM of {
63 :     id : Stamp.stamp,
64 :     props : PropList.holder,
65 : jhr 256 kind : stmt_kind,
66 :     next : stmt option (* next statement at this structural level *)
67 : jhr 198 }
68 :    
69 :     and stmt_kind
70 : jhr 256 = S_SIMPLE of node (* ENTRY, JOIN, BLOCK, NEW, DIE, STABILIZE, or EXIT node *)
71 :     | S_IF of {
72 :     cond : node, (* COND node *)
73 : jhr 198 thenBranch : stmt,
74 :     elseBranch : stmt
75 :     }
76 : jhr 256 | S_LOOP of {
77 : jhr 198 hdr : stmt,
78 : jhr 256 cond : node, (* COND node *)
79 :     body : stmt
80 : jhr 198 }
81 :    
82 :     and rhs
83 :     = VAR of var
84 :     | LIT of Literal.literal
85 :     | OP of Op.rator * var list
86 :     | CONS of var list (* tensor-value construction *)
87 :    
88 :     and var = V of {
89 :     name : string, (* name *)
90 :     id : Stamp.stamp, (* unique ID *)
91 :     useCnt : int ref, (* count of uses *)
92 :     props : PropList.holder
93 :     }
94 :    
95 :     withtype assign = (var * rhs)
96 :    
97 : jhr 256 datatype program = Program of {
98 :     globals : var list,
99 :     globalInit : stmt,
100 :     actors : actor list
101 :     (* initialization *)
102 :     }
103 : jhr 198
104 : jhr 256 and actor = Actor of {
105 :     name : Atom.atom,
106 :     params : var list,
107 :     state : var list,
108 :     stateInit : stmt,
109 :     methods : method list
110 :     }
111 : jhr 198
112 : jhr 256 and method = Method of {
113 :     name : Atom.atom,
114 :     stateIn : var list, (* names of state variables on method entry *)
115 :     stateOut : var list, (* names of state variables on method exit *)
116 :     body : stmt (* method body *)
117 :     }
118 : jhr 198
119 : jhr 256 structure Node : sig
120 :     val same : node * node -> bool
121 :     val compare : node * node -> order
122 :     val hash : node -> word
123 :     val toString : node -> string
124 :     val preds : node -> node list
125 :     val setPred : node * node -> unit
126 :     val hasSucc : node -> bool
127 :     val succs : node -> node list
128 :     val setSucc : node * node -> unit
129 :     val setTrueBranch : node * node -> unit (* set trueBranch successor for COND node *)
130 :     val setFalseBranch : node * node -> unit (* set falseBranch successor for COND node *)
131 :     val addEdge : node * node -> unit
132 :     end
133 : jhr 198
134 : jhr 256 structure Stmt : sig
135 :     val same : stmt * stmt -> bool
136 :     val compare : stmt * stmt -> order
137 :     val hash : stmt -> word
138 :     val toString : stmt -> string
139 :     (* return the entry node of the statement *)
140 :     val entry : stmt -> node
141 :     (* return the tail-end node of a statement (not applicable to S_IF or S_LOOP) *)
142 :     val tail : stmt -> node
143 :     (* statement constructor functions *)
144 :     val mkENTRY : stmt option -> stmt
145 :     val mkJOIN : (var * var list) list * stmt option -> stmt
146 :     val mkIF : var * stmt * stmt * stmt option -> stmt
147 :     val mkBLOCK : assign list * stmt option -> stmt
148 :     val mkNEW : Atom.atom * var list * stmt option -> stmt
149 :     val mkDIE : unit -> stmt
150 :     val mkSTABILIZE : unit -> stmt
151 :     val mkEXIT : unit -> stmt
152 :     end
153 : jhr 198
154 : jhr 199 structure Var : sig
155 :     val new : string -> var
156 :     val same : var * var -> bool
157 :     val compare : var * var -> order
158 :     val hash : var -> word
159 :     val toString : var -> string
160 :     structure Map : ORD_MAP where type Key.ord_key = var
161 :     structure Set : ORD_SET where type Key.ord_key = var
162 :     structure Tbl : MONO_HASH_TABLE where type Key.hash_key = var
163 :     end
164 : jhr 198
165 : jhr 257 (* DFS sorting of the graph rooted at the entry to a statement *)
166 :     val sortNodes : stmt -> node list
167 :    
168 : jhr 198 end
169 :    
170 :     functor SSAFn (Op : OPERATORS) : SSA =
171 : jhr 192 struct
172 : jhr 137
173 : jhr 192 structure Op = Op
174 : jhr 137
175 : jhr 256 datatype node = ND of {
176 :     id : Stamp.stamp,
177 :     props : PropList.holder,
178 :     kind : node_kind
179 : jhr 197 }
180 :    
181 : jhr 256 and node_kind
182 :     = NULL
183 :     | ENTRY of {
184 :     succ : node ref
185 :     }
186 :     | JOIN of {
187 :     preds : node list ref,
188 :     phis : (var * var list) list ref, (* phi statements *)
189 :     succ : node ref
190 :     }
191 :     | COND of {
192 :     pred : node ref,
193 :     cond : var,
194 :     trueBranch : node ref,
195 :     falseBranch : node ref
196 :     }
197 :     | BLOCK of {
198 :     pred : node ref,
199 :     body : assign list ref,
200 :     succ : node ref
201 :     }
202 :     | NEW of {
203 :     pred : node ref,
204 :     actor : Atom.atom,
205 :     args : var list,
206 :     succ : node ref
207 :     }
208 :     | DIE of {
209 :     pred : node ref
210 :     }
211 :     | STABILIZE of {
212 :     pred : node ref
213 :     }
214 :     | EXIT of {
215 :     pred : node ref
216 :     }
217 : jhr 197
218 : jhr 256 (***** Statements *****)
219 : jhr 197
220 :     and stmt = STM of {
221 : jhr 188 id : Stamp.stamp,
222 :     props : PropList.holder,
223 : jhr 256 kind : stmt_kind,
224 :     next : stmt option (* next statement at this structural level *)
225 : jhr 188 }
226 :    
227 : jhr 192 and stmt_kind
228 : jhr 256 = S_SIMPLE of node (* ENTRY, JOIN, BLOCK, NEW, DIE, STABILIZE, or EXIT node *)
229 :     | S_IF of {
230 :     cond : node, (* COND node *)
231 : jhr 192 thenBranch : stmt,
232 :     elseBranch : stmt
233 :     }
234 : jhr 256 | S_LOOP of {
235 : jhr 192 hdr : stmt,
236 : jhr 256 cond : node, (* COND node *)
237 :     body : stmt
238 : jhr 192 }
239 :    
240 : jhr 188 and rhs
241 :     = VAR of var
242 :     | LIT of Literal.literal
243 :     | OP of Op.rator * var list
244 :     | CONS of var list (* tensor-value construction *)
245 :    
246 : jhr 192 and var = V of {
247 : jhr 137 name : string, (* name *)
248 :     id : Stamp.stamp, (* unique ID *)
249 :     useCnt : int ref, (* count of uses *)
250 :     props : PropList.holder
251 : jhr 124 }
252 :    
253 : jhr 192 withtype assign = (var * rhs)
254 : jhr 188
255 : jhr 256 datatype program = Program of {
256 :     globals : var list,
257 :     globalInit : stmt,
258 :     actors : actor list
259 :     (* initialization *)
260 :     }
261 : jhr 188
262 : jhr 256 and actor = Actor of {
263 :     name : Atom.atom,
264 :     params : var list,
265 :     state : var list,
266 :     stateInit : stmt,
267 :     methods : method list
268 :     }
269 : jhr 188
270 : jhr 256 and method = Method of {
271 :     name : Atom.atom,
272 :     stateIn : var list, (* names of state variables on method entry *)
273 :     stateOut : var list, (* names of state variables on method exit *)
274 :     body : stmt (* method body *)
275 :     }
276 : jhr 188
277 : jhr 256 structure Node =
278 :     struct
279 :     fun same (ND{id=a, ...}, ND{id=b, ...}) = Stamp.same(a, b)
280 :     fun compare (ND{id=a, ...}, ND{id=b, ...}) = Stamp.compare(a, b)
281 :     fun hash (ND{id, ...}) = Stamp.hash id
282 :     fun toString (ND{id, kind, ...}) = let
283 :     val tag = (case kind
284 :     of NULL => "NULL"
285 :     | ENTRY _ => "ENTRY"
286 :     | JOIN _ => "JOIN"
287 :     | COND _ => "COND"
288 :     | BLOCK _ => "BLOCK"
289 :     | NEW _ => "NEW"
290 :     | DIE _ => "DIE"
291 :     | STABILIZE _ => "STABILIZE"
292 :     | EXIT _ => "EXIT"
293 :     (* end case *))
294 :     in
295 :     tag ^ Stamp.toString id
296 :     end
297 :     fun new kind = ND{id = Stamp.new(), props = PropList.newHolder(), kind = kind}
298 :     val dummy = new NULL
299 :     fun mkENTRY () = new (ENTRY{succ = ref dummy})
300 :     fun mkJOIN phis = new (JOIN{preds = ref [], phis = ref phis, succ = ref dummy})
301 :     fun mkCOND {cond, trueBranch, falseBranch} = new (COND{
302 :     pred = ref dummy, cond = cond,
303 :     trueBranch = ref trueBranch, falseBranch = ref falseBranch
304 :     })
305 :     fun mkBLOCK body = new (BLOCK{pred = ref dummy, body = ref body, succ = ref dummy})
306 :     fun mkNEW {actor, args} = new (NEW{
307 :     pred = ref dummy, actor = actor, args = args, succ = ref dummy
308 :     })
309 :     fun mkDIE () = new (DIE{pred = ref dummy})
310 :     fun mkSTABILIZE () = new (STABILIZE{pred = ref dummy})
311 :     fun mkEXIT () = new (EXIT{pred = ref dummy})
312 :     (* editing node edges *)
313 :     fun setPred (ND{kind, ...}, nd) = (case kind
314 :     of NULL => raise Fail "setPred on NULL node"
315 :     | ENTRY _ => raise Fail "setPred on ENTRY node"
316 :     | JOIN{preds, ...} => if List.exists (fn nd' => same(nd, nd')) (!preds)
317 :     then ()
318 :     else preds := nd :: !preds
319 :     | COND{pred, ...} => pred := nd
320 :     | BLOCK{pred, ...} => pred := nd
321 :     | NEW{pred, ...} => pred := nd
322 :     | DIE{pred} => pred := nd
323 :     | STABILIZE{pred} => pred := nd
324 :     | EXIT{pred} => pred := nd
325 :     (* end case *))
326 :     fun preds (ND{kind, ...}) = (case kind
327 :     of NULL => raise Fail "preds on NULL node"
328 :     | ENTRY _ => []
329 :     | JOIN{preds, ...} => !preds
330 :     | COND{pred, ...} => [!pred]
331 :     | BLOCK{pred, ...} => [!pred]
332 :     | NEW{pred, ...} => [!pred]
333 :     | DIE{pred} => [!pred]
334 :     | STABILIZE{pred} => [!pred]
335 :     | EXIT{pred} => [!pred]
336 :     (* end case *))
337 :     fun hasSucc (ND{kind, ...}) = (case kind
338 :     of NULL => false
339 :     | ENTRY{succ} => true
340 :     | JOIN{succ, ...} => true
341 :     | COND{trueBranch, falseBranch, ...} => true
342 :     | BLOCK{succ, ...} => true
343 :     | NEW{succ, ...} => true
344 :     | DIE _ => false
345 :     | STABILIZE _ => false
346 :     | EXIT _ => false
347 :     (* end case *))
348 :     fun setSucc (ND{kind, ...}, nd) = (case kind
349 :     of NULL => raise Fail "setSucc on NULL node"
350 :     | ENTRY{succ} => succ := nd
351 :     | JOIN{succ, ...} => succ := nd
352 :     | COND _ => raise Fail "setSucc on COND node"
353 :     | BLOCK{succ, ...} => succ := nd
354 :     | NEW{succ, ...} => succ := nd
355 :     | DIE _ => raise Fail "setSucc on DIE node"
356 :     | STABILIZE _ => raise Fail "setSucc on STABILIZE node"
357 :     | EXIT _ => raise Fail "setSucc on EXIT node"
358 :     (* end case *))
359 :     fun succs (ND{kind, ...}) = (case kind
360 :     of NULL => raise Fail "succs on NULL node"
361 :     | ENTRY{succ} => [!succ]
362 :     | JOIN{succ, ...} => [!succ]
363 :     | COND{trueBranch, falseBranch, ...} => [!trueBranch, !falseBranch]
364 :     | BLOCK{succ, ...} => [!succ]
365 :     | NEW{succ, ...} => [!succ]
366 :     | DIE _ => []
367 :     | STABILIZE _ => []
368 :     | EXIT _ => []
369 :     (* end case *))
370 :     fun setTrueBranch (ND{kind=COND{trueBranch, ...}, ...}, nd) = trueBranch := nd
371 :     | setTrueBranch (nd, _) = raise Fail("setTrueBranch on " ^ toString nd)
372 :     fun setFalseBranch (ND{kind=COND{falseBranch, ...}, ...}, nd) = falseBranch := nd
373 :     | setFalseBranch (nd, _) = raise Fail("setFalseBranch on " ^ toString nd)
374 :     fun addEdge (nd1, nd2) = (
375 :     if hasSucc nd1
376 :     then (
377 :     setSucc (nd1, nd2);
378 :     setPred (nd2, nd1))
379 :     else ())
380 :     (*DEBUG*)handle ex => (
381 :     print(concat["error in addEdge(", toString nd1, ",", toString nd2, ")\n"]);
382 :     raise ex)
383 :     end
384 : jhr 124
385 : jhr 256 structure Stmt =
386 :     struct
387 :     fun same (STM{id=a, ...}, STM{id=b, ...}) = Stamp.same(a, b)
388 :     fun compare (STM{id=a, ...}, STM{id=b, ...}) = Stamp.compare(a, b)
389 :     fun hash (STM{id, ...}) = Stamp.hash id
390 :     fun toString (STM{id, kind, ...}) = let
391 :     val tag = (case kind
392 :     of S_SIMPLE(ND{kind, ...}) => (case kind
393 :     of NULL => "NULL"
394 :     | ENTRY _ => "ENTRY"
395 :     | JOIN _ => "JOIN"
396 :     | COND _ => raise Fail "unexpected S_SIMPLE with COND node"
397 :     | BLOCK _ => "BLOCK"
398 :     | NEW _ => "NEW"
399 :     | DIE _ => "DIE"
400 :     | STABILIZE _ => "STABILIZE"
401 :     | EXIT _ => "EXIT"
402 :     (* end case *))
403 :     | S_IF _ => "IF"
404 :     | S_LOOP _ => "LOOP"
405 :     (* end case *))
406 :     in
407 :     tag ^ Stamp.toString id
408 :     end
409 :     (* return the entry node of the statement *)
410 :     fun entry (STM{kind, ...}) = (case kind
411 :     of S_SIMPLE nd => nd
412 :     | S_IF{cond, ...} => cond
413 :     | S_LOOP{hdr, ...} => entry hdr
414 :     (* end case *))
415 :     (* return the tail-end node of a statement (not applicable to S_IF or S_LOOP) *)
416 :     fun tail (STM{kind, ...}) = (case kind
417 :     of S_SIMPLE nd => nd
418 :     | S_IF{cond, ...} => raise Fail "tail of IF"
419 :     | S_LOOP{hdr, ...} => raise Fail "tail of LOOP"
420 :     (* end case *))
421 :     (* statement constructor functions *)
422 :     fun new (kind, next) = STM{
423 : jhr 137 id = Stamp.new(),
424 : jhr 188 props = PropList.newHolder(),
425 : jhr 256 kind = kind,
426 :     next = next
427 : jhr 137 }
428 : jhr 256 val dummy = new (S_SIMPLE(Node.dummy), NONE)
429 :     fun mkENTRY next = new (S_SIMPLE(Node.mkENTRY ()), next)
430 :     fun mkJOIN (phis, next) = new (S_SIMPLE(Node.mkJOIN phis), next)
431 :     fun mkIF (cond, thenBranch, elseBranch, next) = let
432 :     val cond = Node.mkCOND {
433 :     cond = cond,
434 :     trueBranch = entry thenBranch,
435 :     falseBranch = entry elseBranch
436 :     }
437 :     in
438 :     Node.setPred (entry thenBranch, cond);
439 :     Node.setPred (entry elseBranch, cond);
440 :     new (S_IF{cond = cond, thenBranch = thenBranch, elseBranch = elseBranch}, next)
441 :     end
442 :     fun mkBLOCK (body, next) = new (S_SIMPLE(Node.mkBLOCK body), next)
443 :     fun mkNEW (actor, args, next) = new (S_SIMPLE(Node.mkNEW{actor=actor, args=args}), next)
444 :     fun mkDIE () = new (S_SIMPLE(Node.mkDIE ()), NONE)
445 :     fun mkSTABILIZE () = new (S_SIMPLE(Node.mkSTABILIZE ()), NONE)
446 :     fun mkEXIT () = new (S_SIMPLE(Node.mkEXIT ()), NONE)
447 :     end
448 : jhr 137
449 : jhr 199 structure Var =
450 :     struct
451 :     fun new name = V{
452 :     name = name,
453 :     id = Stamp.new(),
454 :     useCnt = ref 0,
455 :     props = PropList.newHolder()
456 :     }
457 :     fun same (V{id=a, ...}, V{id=b, ...}) = Stamp.same(a, b)
458 :     fun compare (V{id=a, ...}, V{id=b, ...}) = Stamp.compare(a, b)
459 :     fun hash (V{id, ...}) = Stamp.hash id
460 :     fun toString (V{name, id, ...}) = name ^ Stamp.toString id
461 :     local
462 :     structure V =
463 :     struct
464 :     type ord_key = var
465 :     val compare = compare
466 :     end
467 :     in
468 :     structure Map = RedBlackMapFn (V)
469 :     structure Set = RedBlackSetFn (V)
470 :     end
471 :     structure Tbl = HashTableFn (
472 :     struct
473 :     type hash_key = var
474 :     val hashVal = hash
475 :     val sameKey = same
476 :     end)
477 :     end
478 : jhr 197
479 : jhr 257 (* DFS sorting of the graph rooted at the entry to a statement *)
480 :     fun sortNodes stmt = let
481 :     val {getFn, setFn} = PropList.newFlag (fn (ND{props, ...}) => props)
482 :     fun dfs (nd, l) =
483 :     if getFn nd
484 :     then l
485 :     else (
486 :     setFn (nd, true);
487 :     nd :: List.foldl dfs l (Node.succs nd))
488 :     in
489 :     dfs (Stmt.entry stmt, [])
490 :     end
491 :    
492 : jhr 124 end

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