1 (* Copyright (C) 2009,2017 Matthew Fluet.
2 * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
3 * Jagannathan, and Stephen Weeks.
4 * Copyright (C) 1997-2000 NEC Research Institute.
6 * MLton is released under a BSD-style license.
7 * See the file MLton-LICENSE for details.
12 * Based primarily on Section 19.1 of Appel's "Modern Compiler Implementation in ML",
13 * (but see the caveats in the comments below).
14 * The main deviation is the calculation of liveness of the violating variables,
15 * which is used to predicate the insertion of phi arguments. This is due to
16 * the algorithm's bias towards imperative languages, for which it makes the
17 * assumption that all variables are defined in the start block and all variables
19 * This is "optimized" for restoration of functions with small numbers of violating
20 * variables -- use bool vectors to represent sets of violating variables.
21 * Also, we use a Promise.t to suspend part of the dominance frontier computation.
23 * Requirements: no violation in globals; this is checked.
26 functor Restore (S: RESTORE_STRUCTS): RESTORE =
32 fun diagnostics _ = ()
40 datatype t = T of {args: (Var.t * Type.t) vector ref,
41 preds: Label.t list ref,
42 defs: bool vector ref,
43 uses: bool vector ref,
46 df: Label.t vector Promise.t ref,
48 phiArgs: Var.t vector ref,
51 fun layout (T {preds, defs, uses, live, dtindex, df, phiArgs, ...})
53 in record [("preds", List.layout Label.layout (!preds)),
54 ("defs", Vector.layout Bool.layout (!defs)),
55 ("uses", Vector.layout Bool.layout (!uses)),
56 ("live", Array.layout Bool.layout (!live)),
57 ("dtindex", Int.layout (!dtindex)),
58 ("df", Promise.layout (Vector.layout Label.layout) (!df)),
59 ("phiArgs", Vector.layout Var.layout (!phiArgs))]
63 fun make f (T r) = f r
64 fun make' f = (make f, ! o (make f))
66 val (args, args') = make' #args
67 val (preds, preds') = make' #preds
68 val (defs, defs') = make' #defs
69 val (uses, uses') = make' #uses
70 val (live, live') = make' #live
71 val (dtindex, dtindex') = make' #dtindex
72 val (df, df') = make' #df
73 val (phi, _) = make' #phi
74 val (phiArgs, phiArgs') = make' #phiArgs
75 val (queued, _) = make' #queued
78 fun new (): t = T {args = ref (Vector.new0 ()),
80 defs = ref (Vector.new0 ()),
81 uses = ref (Vector.new0 ()),
82 live = ref (Array.new0 ()),
84 df = ref (Promise.delay (fn () => Vector.new0 ())),
86 phiArgs = ref (Vector.new0 ()),
90 structure Cardinality =
92 structure L = ThreePointLattice(val bottom = "zero"
101 val makeMany = makeTop
102 val whenMany = whenTop
105 = fn c => if isZero c
114 datatype t = T of {defs: Cardinality.t,
117 defSites: Label.t list ref,
118 useSites: Label.t list ref,
119 vars: Var.t list ref}
121 fun layout (T {defs, index, defSites, useSites, vars, ...})
123 in record [("defs", Cardinality.layout defs),
124 ("index", Int.layout (!index)),
125 ("defSites", List.layout Label.layout (!defSites)),
126 ("useSites", List.layout Label.layout (!useSites)),
127 ("vars", List.layout Var.layout (!vars))]
131 fun make f (T r) = f r
132 fun make' f = (make f, ! o (make f))
134 val defs = make #defs
135 val (index,index') = make' #index
136 val (_,defSites') = make' #defSites
137 val (_,useSites') = make' #useSites
138 val (ty,ty') = make' #ty
140 fun addDef (T {defs, ...}) = Cardinality.inc defs
141 fun addDefSite (T {defSites, ...}, l) = List.push(defSites, l)
142 fun addUseSite (T {useSites, ...}, l) = List.push(useSites, l)
143 val violates = Cardinality.isMany o defs
144 fun whenViolates (T {defs, ...}, th) = Cardinality.whenMany (defs, th)
146 fun new (): t = T {defs = Cardinality.new (),
153 fun pushVar (T {vars, ...}, var) = List.push (vars, var)
154 fun popVar (T {vars, ...}) = ignore (List.pop vars)
155 fun peekVar (T {vars, ...}) = case !vars
160 fun restoreFunction {globals: Statement.t vector}
162 exception NoViolations
164 val {get = varInfo: Var.t -> VarInfo.t, ...}
166 (Var.plist, Property.initFun (fn _ => VarInfo.new ()))
168 val {get = labelInfo: Label.t -> LabelInfo.t, ...}
170 (Label.plist, Property.initFun (fn _ => LabelInfo.new ()))
176 {enque = fn (l, li) => let
177 val queued = LabelInfo.queued li
181 else (queued := true ;
182 List.push (todo, (l,li)))
184 deque = fn () => case !todo
188 LabelInfo.queued li := false;
196 {addPost = fn th => List.push (post, th),
197 post = fn () => List.foreach(!post, fn th => th ())}
200 (* check for violations in globals *)
205 VarInfo.ty vi := ty ;
208 (vi, fn () => Error.bug "Restore.restore: violation in globals")
212 (globals, fn Statement.T {var, ty, ...} =>
213 Option.app (var, fn x => addDef (x, ty)))
215 fn (f: Function.t) =>
217 val {args, blocks, mayInline, name, returns, raises, start} =
219 (* check for violations *)
220 val violations = ref []
225 if VarInfo.violates vi
227 else (VarInfo.ty vi := ty ;
229 if VarInfo.violates vi
230 then List.push (violations, x)
233 val _ = Function.foreachVar (f, addDef)
236 val _ = if List.isEmpty (!violations)
237 then (Control.diagnostics
242 display (seq [Func.layout name,
243 str " NoViolations"])
248 (* init violations *)
252 (!violations, fn x =>
255 val _ = VarInfo.index vi := (!index)
256 val _ = Int.inc index
260 val numViolations = !index
263 val _ = Control.diagnostics
268 display (seq [Func.layout name,
270 Vector.layout Var.layout violations])
273 (* init entryBlock *)
274 val entry = Label.newNoname ()
275 val entryBlock = Block.T {label = entry,
277 statements = Vector.new0 (),
278 transfer = Goto {dst = start,
279 args = Vector.new0 ()}}
281 (* compute dominator tree *)
282 val dt = Function.dominatorTree f
283 val dt' = Tree.T (entryBlock, Vector.new1 dt)
285 (* compute df (dominance frontier) *)
286 (* based on section 19.1 of Appel's "Modern Compiler Implementation in ML" *)
287 (* also computes defSites and useSites of violating variables *)
288 (* also computes preds, defs, and uses *)
290 fun doitTree (Tree.T (Block.T {label, args, statements, transfer},
293 val li = labelInfo label
295 val _ = LabelInfo.args li := args
297 val _ = Transfer.foreachLabel
299 List.push (LabelInfo.preds (labelInfo l), label))
301 val defs = Array.new (numViolations, false)
302 val uses = Array.new (numViolations, false)
307 if VarInfo.violates vi
309 val index = VarInfo.index' vi
311 VarInfo.addDefSite (varInfo x, label);
312 Array.update (defs, index, true);
313 Array.update (uses, index, false)
321 if VarInfo.violates vi
323 val index = VarInfo.index' vi
325 VarInfo.addUseSite (varInfo x, label);
326 Array.update (uses, index, true)
330 val _ = Transfer.foreachVar (transfer, addUse)
331 val _ = Vector.foreachr
332 (statements, fn Statement.T {var, exp, ...} =>
333 (Option.app (var, addDef);
334 Exp.foreachVar (exp, addUse)))
335 val _ = Vector.foreach (args, addDef o #1)
336 val _ = LabelInfo.defs li := Array.toVector defs
337 val _ = LabelInfo.uses li := Array.toVector uses
338 val _ = LabelInfo.live li := Array.new (numViolations, false)
340 val _ = Int.inc dtindex
341 val dtindexMin = !dtindex
342 val _ = LabelInfo.dtindex li := dtindexMin
343 val _ = Vector.foreach(children, doitTree)
344 val dtindexMax = !dtindex
346 = let val dtindex = LabelInfo.dtindex' (labelInfo l)
347 in dtindexMin < dtindex andalso dtindex <= dtindexMax
354 = if List.contains(!df, l, Label.equals)
357 val _ = Transfer.foreachLabel
360 (children, fn Tree.T (b, _) =>
361 Label.equals (Block.label b, l))
364 val _ = Vector.foreach
365 (children, fn Tree.T (Block.T {label, ...}, _) =>
367 val li = labelInfo label
370 (Promise.force (LabelInfo.df' li), fn l =>
376 Vector.fromList (!df)
378 val _ = LabelInfo.df li := Promise.delay promise
384 (* compute liveness *)
389 val {enque, deque} = mkQueue ()
390 val enque = fn l => enque (l, labelInfo l)
393 val index = VarInfo.index' vi
394 val useSites = VarInfo.useSites' vi
395 val _ = List.foreach (useSites, enque)
399 val uses = LabelInfo.uses' li
400 val defs = LabelInfo.defs' li
401 val live = LabelInfo.live' li
403 if Array.sub (live, index)
405 (Vector.sub(defs, index)
407 not (Vector.sub (uses, index)))
409 else (Array.update(live, index, true) ;
410 List.foreach (LabelInfo.preds' li, enque))
415 | SOME (l,li) => (doit (l, li); loop ())
420 (* insert phi-functions *)
421 (* based on section 19.1 of Appel's "Modern Compiler Implementation in ML"
422 * (beware: Alg. 19.6 (both in the book and as corrected by the
423 * errata) has numerous typos; and this implementation computes sets of
424 * variables that must have phi-functions at a node, which is close to
425 * the algorithm in the book, but the reverse of the algorithm as
426 * corrected by the errata, which computes sets of nodes that must have
427 * a phi-functions for a variable.)
433 val {enque, deque} = mkQueue ()
436 val index = VarInfo.index' vi
437 val defSites = VarInfo.defSites' vi
440 enque (l, labelInfo l))
444 (Promise.force (LabelInfo.df' li), fn l =>
447 val live = LabelInfo.live' li
448 val phi = LabelInfo.phi li
450 if Array.sub(live, index)
452 not (List.contains(!phi, x, Var.equals))
453 then (List.push(phi, x);
460 | SOME (l,li) => (doit (l, li); loop ())
465 (* finalize phi args *)
466 fun visitBlock (Block.T {label, ...})
468 val li = labelInfo label
469 val phi = LabelInfo.phi li
470 val phiArgs = LabelInfo.phiArgs li
472 phiArgs := Vector.fromList (!phi) ;
475 val _ = visitBlock entryBlock
476 val _ = Vector.foreach (blocks, visitBlock)
479 val _ = Control.diagnostics
486 display (seq [Var.layout x,
488 VarInfo.layout (varInfo x)]));
490 (blocks, fn Block.T {label, ...} =>
491 display (seq [Label.layout label,
493 LabelInfo.layout (labelInfo label)]))
498 fun rewriteVar (x: Var.t)
499 = case VarInfo.peekVar (varInfo x)
502 fun rewriteStatement (addPost: (unit -> unit) -> unit) (Statement.T {var, ty, exp})
504 val exp = Exp.replaceVar (exp, rewriteVar)
511 if VarInfo.violates vi
515 addPost (fn _ => VarInfo.popVar vi) ;
516 VarInfo.pushVar (vi, x');
522 Statement.T {var = var,
527 type t = {dst: Label.t,
528 phiArgs: Var.t vector,
531 val routeTable : t HashSet.t = HashSet.new {hash = #hash}
535 val li = labelInfo dst
536 val phiArgs = LabelInfo.phiArgs' li
538 if Vector.isEmpty phiArgs
541 val phiArgs = Vector.map
542 (phiArgs, valOf o VarInfo.peekVar o varInfo)
543 val hash = Vector.fold
544 (phiArgs, Label.hash dst, fn (x, h) =>
545 Word.xorb(Var.hash x, h))
547 = HashSet.lookupOrInsert
549 fn {dst = dst', phiArgs = phiArgs', ... } =>
550 Label.equals (dst, dst')
552 Vector.equals (phiArgs, phiArgs', Var.equals),
555 val route = Label.new dst
556 val args = Vector.map
557 (LabelInfo.args' li, fn (x,ty) =>
559 val args' = Vector.concat
560 [Vector.map(args, #1),
565 statements = Vector.new0 (),
566 transfer = Goto {dst = dst,
568 val _ = List.push (blocks, block)
580 fun rewriteTransfer (t: Transfer.t)
581 = Transfer.replaceLabelVar (t, route, rewriteVar)
582 fun visitBlock' (Block.T {label, args, statements, transfer})
584 val {addPost, post} = mkPost ()
585 val li = labelInfo label
588 val ty = VarInfo.ty' vi
590 if VarInfo.violates vi
594 addPost (fn _ => VarInfo.popVar vi) ;
595 VarInfo.pushVar (vi, x') ;
600 val args = Vector.map
601 (args, fn (x, _) => doit x)
602 val phiArgs = Vector.map
603 (LabelInfo.phiArgs' li, fn x => doit x)
604 val args = Vector.concat [args, phiArgs]
606 = if Vector.exists(LabelInfo.defs' li, fn b => b)
608 Vector.exists(LabelInfo.uses' li, fn b => b)
609 then Vector.map (statements, rewriteStatement addPost)
611 val transfer = rewriteTransfer transfer
612 val block = Block.T {label = label,
614 statements = statements,
620 = let val (block, post) = visitBlock' block
621 in List.push (blocks, block) ; post
626 val (Block.T {label, args, statements, transfer}, post)
627 = visitBlock' entryBlock
628 val entryBlock = Block.T {label = label,
629 args = Vector.new0 (),
630 statements = statements,
632 val _ = List.push (blocks, entryBlock)
637 val _ = Tree.traverse (Function.dominatorTree f, visitBlock)
640 Function.new {args = args,
641 blocks = Vector.fromList (!blocks),
642 mayInline = mayInline,
652 handle NoViolations => f
655 val traceRestoreFunction
656 = Trace.trace ("Restore.restoreFunction",
657 Func.layout o Function.name,
658 Func.layout o Function.name)
663 val r = restoreFunction g
665 fn f => traceRestoreFunction r f
668 fun restore (Program.T {datatypes, globals, functions, main})
670 val r = restoreFunction {globals = globals}
672 Program.T {datatypes = datatypes,
674 functions = List.revMap (functions, r),
677 (* quell unused warning *)