1 (* Copyright (C) 2009,2017 Matthew Fluet.
2 * Copyright (C) 1999-2006 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 Restore2 (S: RESTORE2_STRUCTS): RESTORE2 =
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 "Restore2.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, name, returns, raises, start} = Function.dest f
218 (* check for violations *)
219 val violations = ref []
224 if VarInfo.violates vi
226 else (VarInfo.ty vi := ty ;
228 if VarInfo.violates vi
229 then List.push (violations, x)
232 val _ = Function.foreachVar (f, addDef)
235 val _ = if List.isEmpty (!violations)
236 then (Control.diagnostics
241 display (seq [Func.layout name,
242 str " NoViolations"])
247 (* init violations *)
251 (!violations, fn x =>
254 val _ = VarInfo.index vi := (!index)
255 val _ = Int.inc index
259 val numViolations = !index
262 val _ = Control.diagnostics
267 display (seq [Func.layout name,
269 Vector.layout Var.layout violations])
272 (* init entryBlock *)
273 val entry = Label.newNoname ()
274 val entryBlock = Block.T {label = entry,
276 statements = Vector.new0 (),
277 transfer = Goto {dst = start,
278 args = Vector.new0 ()}}
280 (* compute dominator tree *)
281 val dt = Function.dominatorTree f
282 val dt' = Tree.T (entryBlock, Vector.new1 dt)
284 (* compute df (dominance frontier) *)
285 (* based on section 19.1 of Appel's "Modern Compiler Implementation in ML" *)
286 (* also computes defSites and useSites of violating variables *)
287 (* also computes preds, defs, and uses *)
289 fun doitTree (Tree.T (Block.T {label, args, statements, transfer},
292 val li = labelInfo label
294 val _ = LabelInfo.args li := args
296 val _ = Transfer.foreachLabel
298 List.push (LabelInfo.preds (labelInfo l), label))
300 val defs = Array.new (numViolations, false)
301 val uses = Array.new (numViolations, false)
306 if VarInfo.violates vi
308 val index = VarInfo.index' vi
310 VarInfo.addDefSite (varInfo x, label);
311 Array.update (defs, index, true);
312 Array.update (uses, index, false)
320 if VarInfo.violates vi
322 val index = VarInfo.index' vi
324 VarInfo.addUseSite (varInfo x, label);
325 Array.update (uses, index, true)
329 val _ = Transfer.foreachVar (transfer, addUse)
330 val _ = Vector.foreachr
331 (statements, fn Statement.T {var, exp, ...} =>
332 (Option.app (var, addDef);
333 Exp.foreachVar (exp, addUse)))
334 val _ = Vector.foreach (args, addDef o #1)
335 val _ = LabelInfo.defs li := Array.toVector defs
336 val _ = LabelInfo.uses li := Array.toVector uses
337 val _ = LabelInfo.live li := Array.new (numViolations, false)
339 val _ = Int.inc dtindex
340 val dtindexMin = !dtindex
341 val _ = LabelInfo.dtindex li := dtindexMin
342 val _ = Vector.foreach(children, doitTree)
343 val dtindexMax = !dtindex
345 = let val dtindex = LabelInfo.dtindex' (labelInfo l)
346 in dtindexMin < dtindex andalso dtindex <= dtindexMax
353 = if List.contains(!df, l, Label.equals)
356 val _ = Transfer.foreachLabel
359 (children, fn Tree.T (b, _) =>
360 Label.equals (Block.label b, l))
363 val _ = Vector.foreach
364 (children, fn Tree.T (Block.T {label, ...}, _) =>
366 val li = labelInfo label
369 (Promise.force (LabelInfo.df' li), fn l =>
375 Vector.fromList (!df)
377 val _ = LabelInfo.df li := Promise.delay promise
383 (* compute liveness *)
388 val {enque, deque} = mkQueue ()
389 val enque = fn l => enque (l, labelInfo l)
392 val index = VarInfo.index' vi
393 val useSites = VarInfo.useSites' vi
394 val _ = List.foreach (useSites, enque)
398 val uses = LabelInfo.uses' li
399 val defs = LabelInfo.defs' li
400 val live = LabelInfo.live' li
402 if Array.sub (live, index)
404 (Vector.sub(defs, index)
406 not (Vector.sub (uses, index)))
408 else (Array.update(live, index, true) ;
409 List.foreach (LabelInfo.preds' li, enque))
414 | SOME (l,li) => (doit (l, li); loop ())
419 (* insert phi-functions *)
420 (* based on section 19.1 of Appel's "Modern Compiler Implementation in ML"
421 * (beware: Alg. 19.6 (both in the book and as corrected by the
422 * errata) has numerous typos; and this implementation computes sets of
423 * variables that must have phi-functions at a node, which is close to
424 * the algorithm in the book, but the reverse of the algorithm as
425 * corrected by the errata, which computes sets of nodes that must have
426 * a phi-functions for a variable.)
432 val {enque, deque} = mkQueue ()
435 val index = VarInfo.index' vi
436 val defSites = VarInfo.defSites' vi
439 enque (l, labelInfo l))
443 (Promise.force (LabelInfo.df' li), fn l =>
446 val live = LabelInfo.live' li
447 val phi = LabelInfo.phi li
449 if Array.sub(live, index)
451 not (List.contains(!phi, x, Var.equals))
452 then (List.push(phi, x);
459 | SOME (l,li) => (doit (l, li); loop ())
464 (* finalize phi args *)
465 fun visitBlock (Block.T {label, ...})
467 val li = labelInfo label
468 val phi = LabelInfo.phi li
469 val phiArgs = LabelInfo.phiArgs li
471 phiArgs := Vector.fromList (!phi) ;
474 val _ = visitBlock entryBlock
475 val _ = Vector.foreach (blocks, visitBlock)
478 val _ = Control.diagnostics
485 display (seq [Var.layout x,
487 VarInfo.layout (varInfo x)]));
489 (blocks, fn Block.T {label, ...} =>
490 display (seq [Label.layout label,
492 LabelInfo.layout (labelInfo label)]))
497 fun rewriteVar (x: Var.t)
498 = case VarInfo.peekVar (varInfo x)
501 fun rewriteStatement addPost (Statement.T {var, ty, exp})
503 val exp = Exp.replaceVar (exp, rewriteVar)
510 if VarInfo.violates vi
514 addPost (fn _ => VarInfo.popVar vi) ;
515 VarInfo.pushVar (vi, x');
521 Statement.T {var = var,
526 type t = {dst: Label.t,
527 phiArgs: Var.t vector,
530 val routeTable : t HashSet.t = HashSet.new {hash = #hash}
534 val li = labelInfo dst
535 val phiArgs = LabelInfo.phiArgs' li
537 if Vector.isEmpty phiArgs
540 val phiArgs = Vector.map
541 (phiArgs, valOf o VarInfo.peekVar o varInfo)
542 val hash = Vector.fold
543 (phiArgs, Label.hash dst, fn (x, h) =>
544 Word.xorb(Var.hash x, h))
546 = HashSet.lookupOrInsert
548 fn {dst = dst', phiArgs = phiArgs', ... } =>
549 Label.equals (dst, dst')
551 Vector.equals (phiArgs, phiArgs', Var.equals),
554 val route = Label.new dst
555 val args = Vector.map
556 (LabelInfo.args' li, fn (x,ty) =>
558 val args' = Vector.concat
559 [Vector.map(args, #1),
564 statements = Vector.new0 (),
565 transfer = Goto {dst = dst,
567 val _ = List.push (blocks, block)
579 fun rewriteTransfer (t: Transfer.t)
580 = Transfer.replaceLabelVar (t, route, rewriteVar)
581 fun visitBlock' (Block.T {label, args, statements, transfer})
583 val {addPost, post} = mkPost ()
584 val li = labelInfo label
587 val ty = VarInfo.ty' vi
589 if VarInfo.violates vi
593 addPost (fn _ => VarInfo.popVar vi) ;
594 VarInfo.pushVar (vi, x') ;
599 val args = Vector.map
600 (args, fn (x, _) => doit x)
601 val phiArgs = Vector.map
602 (LabelInfo.phiArgs' li, fn x => doit x)
603 val args = Vector.concat [args, phiArgs]
605 = if Vector.exists(LabelInfo.defs' li, fn b => b)
607 Vector.exists(LabelInfo.uses' li, fn b => b)
608 then Vector.map (statements, rewriteStatement addPost)
610 val transfer = rewriteTransfer transfer
611 val block = Block.T {label = label,
613 statements = statements,
619 = let val (block, post) = visitBlock' block
620 in List.push (blocks, block) ; post
625 val (Block.T {label, args, statements, transfer}, post)
626 = visitBlock' entryBlock
627 val entryBlock = Block.T {label = label,
628 args = Vector.new0 (),
629 statements = statements,
631 val _ = List.push (blocks, entryBlock)
636 val _ = Tree.traverse (Function.dominatorTree f, visitBlock)
639 Function.new {args = args,
640 blocks = Vector.fromList (!blocks),
650 handle NoViolations => f
653 val traceRestoreFunction
654 = Trace.trace ("Restore2.restoreFunction",
655 Func.layout o Function.name,
656 Func.layout o Function.name)
661 val r = restoreFunction g
663 fn f => traceRestoreFunction r f
666 fun restore (Program.T {datatypes, globals, functions, main})
668 val r = restoreFunction globals
670 Program.T {datatypes = datatypes,
672 functions = List.revMap (functions, r),