1 (* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh
2 * Jagannathan, and Stephen Weeks.
3 * Copyright (C) 1997-2000 NEC Research Institute.
5 * MLton is released under a BSD-style license.
6 * See the file MLton-LICENSE for details.
9 functor LocalRef (S: SSA_TRANSFORM_STRUCTS): SSA_TRANSFORM =
19 val isReff: 'a t -> bool =
26 structure FuncLattice = FlatLattice (structure Point = Func)
28 structure GlobalInfo =
30 datatype t = T of {isGlobalRef: bool,
31 funcUses: FuncLattice.t}
33 fun layout (T {isGlobalRef, funcUses, ...})
35 in record [("isGlobalRef", Bool.layout isGlobalRef),
36 ("funcUses", FuncLattice.layout funcUses)]
40 fun make f (T r) = f r
42 val isGlobalRef = make #isGlobalRef
43 val funcUses = make #funcUses
46 fun new isGlobalRef = T {isGlobalRef = isGlobalRef,
47 funcUses = FuncLattice.new ()}
52 structure L = TwoPointLattice (val bottom = "local"
53 val top = "non local")
55 val isLocal = isBottom
56 val nonLocal = makeTop
61 datatype t = T of {reff: (Label.t * Type.t) option,
62 assigns: Label.t list ref,
63 derefs: Label.t list ref,
65 threadCopyCurrent: {assign: bool ref,
68 fun layout (T {reff, assigns, derefs, locall,
69 threadCopyCurrent = {assign, deref, ...}, ...})
71 in record [("reff", Option.layout (tuple2 (Label.layout, Type.layout)) reff),
72 ("assigns", List.layout Label.layout (!assigns)),
73 ("derefs", List.layout Label.layout (!derefs)),
74 ("locall", Local.layout locall),
75 ("threadCopyCurrent", record [("assign", Bool.layout (!assign)),
76 ("deref", Bool.layout (!deref))])]
80 fun make f (T r) = f r
81 fun make' f = (make f, ! o (make f))
84 val (assigns, _) = make' #assigns
85 val (derefs, _) = make' #derefs
86 val locall = make #locall
87 val threadCopyCurrent = make #threadCopyCurrent
89 val isLocal = Local.isLocal o locall
90 val nonLocal = Local.nonLocal o locall
92 fun make f = f o threadCopyCurrent
93 fun make' f = (make f, ! o (make f))
95 val (threadCopyCurrentAssign,threadCopyCurrentAssign') = make' #assign
96 val (threadCopyCurrentDeref,threadCopyCurrentDeref') = make' #deref
99 fun new reff: t = T {reff = reff,
103 val locall = Local.new ()
104 val _ = if isSome reff
106 else Local.nonLocal locall
110 threadCopyCurrent = {assign = ref false,
114 structure LabelInfo =
116 datatype t = T of {reffs: Var.t list ref,
117 assigns: Var.t list ref,
118 derefs: Var.t list ref,
119 preds: Label.t list ref,
123 fun make f (T r) = f r
124 fun make' f = (make f, ! o (make f))
126 val (reffs, reffs') = make' #reffs
127 val (assigns, assigns') = make' #assigns
128 val (derefs, derefs') = make' #derefs
129 val (preds, preds') = make' #preds
130 val (visited, visited') = make' #visited
133 fun new (): t = T {reffs = ref [],
140 structure Multi = Multi (S)
142 fun transform (program: Program.t): Program.t =
144 val program as Program.T {datatypes, globals, functions, main} =
145 eliminateDeadBlocks program
147 val multi = Control.trace (Control.Detail, "multi") Multi.multi
148 val {usesThreadsOrConts: bool,
149 funcIsMultiUsed: Func.t -> bool,
150 labelDoesThreadCopyCurrent: Label.t -> bool, ...} = multi program
151 (* Initialize globalInfo *)
152 val {get = globalInfo: Var.t -> GlobalInfo.t,
153 set = setGlobalInfo, ...} =
155 (Var.plist, Property.initFun (fn _ => GlobalInfo.new false))
156 val varFuncUses = GlobalInfo.funcUses o globalInfo
159 (globals, fn Statement.T {var, exp, ...} =>
160 Option.app (var, fn var =>
162 PrimApp {prim, ...} =>
164 then setGlobalInfo (var, GlobalInfo.new true)
167 (* Compute funcUses *)
170 val gi = globalInfo x
172 if GlobalInfo.isGlobalRef gi
173 then ignore (FuncLattice.lowerBound (GlobalInfo.funcUses gi, f))
176 val dummy = Func.newNoname ()
179 (globals, fn Statement.T {var, exp, ...} =>
181 fun default () = Exp.foreachVar (exp, addFunc dummy)
184 PrimApp {prim, args, ...} =>
188 (FuncLattice.<= (varFuncUses (valOf var),
189 varFuncUses (Vector.first args)))
197 val {name, blocks, ...} = Function.dest f
200 (blocks, fn Block.T {statements, transfer, ...} =>
201 (Vector.foreach (statements, fn Statement.T {exp, ...} =>
202 Exp.foreachVar (exp, addFunc name))
203 ; Transfer.foreachVar (transfer, addFunc name)))
212 display (str "\n\nGlobals:")
214 (globals, fn Statement.T {var, ...} =>
217 if GlobalInfo.isGlobalRef (globalInfo x)
218 then display (seq [Var.layout x,
220 GlobalInfo.layout (globalInfo x)])
223 (* Localize global refs *)
224 val {get = funcInfo: Func.t -> {locals: Statement.t list ref}, ...} =
225 Property.get (Func.plist,
226 Property.initFun (fn _ => {locals = ref []}))
229 (globals, fn (s as Statement.T {var, ...}) =>
234 val GlobalInfo.T {isGlobalRef, funcUses} = globalInfo x
239 (case FuncLattice.getPoint funcUses of
243 orelse Func.equals (f, dummy)
246 (List.push (#locals (funcInfo f), s)
249 (* restore and shrink *)
250 val restore = restoreFunction {globals = globals}
251 val shrink = shrinkFunction {globals = globals}
253 val {get = varInfo: Var.t -> VarInfo.t,
254 set = setVarInfo, ...}
255 = Property.getSetOnce
256 (Var.plist, Property.initFun (fn _ => VarInfo.new NONE))
257 fun nonLocal x = VarInfo.nonLocal (varInfo x)
258 fun isLocal x = VarInfo.isLocal (varInfo x)
260 val {get = labelInfo: Label.t -> LabelInfo.t,
261 set = setLabelInfo, ...}
262 = Property.getSetOnce
263 (Label.plist, Property.initRaise ("localRef.labelInfo", Label.layout))
264 fun rewrite (f: Function.t, refs): Function.t =
266 val {args, blocks, mayInline, name, raises, returns, start} =
275 display (seq [Func.layout name,
281 VarInfo.layout (varInfo x)])
285 fun rewriteStatement (s: Statement.t as Statement.T {exp, var, ...})
287 datatype z = datatype Prim.Name.t
290 of PrimApp {prim, args, ...}
292 fun arg n = Vector.sub (args, n)
294 fun rewriteReffAssign rvar var
296 val vi = varInfo rvar
298 if VarInfo.isLocal vi
301 ty = #2 (valOf (VarInfo.reff vi)),
308 | SOME var => rewriteReffAssign var (arg 0)
309 fun rewriteAssign () = rewriteReffAssign (arg 0) (arg 1)
310 fun rewriteDeref rvar
312 val vi = varInfo rvar
314 if VarInfo.isLocal vi
319 ty = #2 (valOf (VarInfo.reff vi)),
325 = fn () => rewriteDeref (arg 0)
328 of Ref_ref => rewriteReff ()
329 | Ref_assign => rewriteAssign ()
330 | Ref_deref => rewriteDeref ()
335 fun rewriteBlock (Block.T {label, args, statements, transfer})
337 val li = labelInfo label
338 (* Don't need to rewrite the statements
339 * if this block doesn't mention localizable refs.
342 = if List.exists (LabelInfo.reffs' li, isLocal)
344 List.exists (LabelInfo.assigns' li, isLocal)
346 List.exists (LabelInfo.derefs' li, isLocal)
347 then Vector.map (statements, rewriteStatement)
350 Block.T {label = label,
352 statements = statements,
355 val blocks = Vector.map (blocks, rewriteBlock)
356 val f = Function.new {args = args,
358 mayInline = mayInline,
372 val {name, ...} = Function.dest f
373 val {locals, ...} = funcInfo name
376 if List.isEmpty locals
380 val {args, blocks, mayInline, name, raises, returns,
381 start} = Function.dest f
382 val locals = Vector.fromListRev locals
383 val localsLabel = Label.newNoname ()
385 Block.T {label = localsLabel,
386 args = Vector.new0 (),
388 transfer = Goto {dst = start,
389 args = Vector.new0 ()}}
391 Vector.concat [Vector.new1 localsBlock, blocks]
393 Function.new {args = args,
395 mayInline = mayInline,
401 (* Find all localizable refs. *)
403 fun visitStatement label (Statement.T {var, ty, exp})
405 val li = labelInfo label
410 val vi = VarInfo.new (SOME (label, Type.deRef ty))
411 val _ = setVarInfo (var, vi)
413 List.push (refs, var) ;
414 List.push (LabelInfo.reffs li, var)
417 = (List.push (VarInfo.assigns (varInfo var), label) ;
418 List.push (LabelInfo.assigns li, var))
420 = (List.push (VarInfo.derefs (varInfo var), label) ;
421 List.push (LabelInfo.derefs li, var))
422 fun default () = Exp.foreachVar (exp, nonLocal)
423 datatype z = datatype Prim.Name.t
426 of PrimApp {prim, args, ...}
428 fun arg n = Vector.sub (args, n)
431 of Ref_ref => (setReff (); default ())
432 | Ref_assign => (setAssign (arg 0);
434 | Ref_deref => setDeref (arg 0)
439 fun visitBlock (Block.T {label, statements, transfer, ...})
441 val li = LabelInfo.new ()
442 val _ = setLabelInfo (label, li)
443 val _ = Vector.foreach (statements, visitStatement label)
444 val _ = Transfer.foreachVar (transfer, nonLocal)
446 if usesThreadsOrConts
447 then fn () => Transfer.foreachLabel
449 List.push (LabelInfo.preds (labelInfo l), label))
452 val _ = Function.dfs (f, visitBlock)
453 val refs = List.keepAll (!refs, isLocal)
454 (* Thread criteria *)
456 = if usesThreadsOrConts
461 val def = #1 (valOf (VarInfo.reff vi))
462 fun doit (threadCopyCurrent, uses)
469 if LabelInfo.visited' li
471 else (List.push (visited, l);
472 LabelInfo.visited li := true;
473 if labelDoesThreadCopyCurrent l
474 then threadCopyCurrent := true
476 if Label.equals (def, l)
479 (LabelInfo.preds' li, doit'))
485 (LabelInfo.preds' (labelInfo l), doit')) ;
488 LabelInfo.visited (labelInfo l) := false)
490 val _ = doit (VarInfo.threadCopyCurrentAssign vi,
491 !(VarInfo.assigns vi))
492 val _ = doit (VarInfo.threadCopyCurrentDeref vi,
493 !(VarInfo.derefs vi))
495 if VarInfo.threadCopyCurrentAssign' vi
497 VarInfo.threadCopyCurrentDeref' vi
498 then VarInfo.nonLocal vi
501 List.keepAll (refs, isLocal))
504 if 0 < List.length refs
505 then rewrite (f, refs)
508 ; (Control.diagnostics
513 display (seq [Func.layout name,
518 val program = Program.T {datatypes = datatypes,
520 functions = functions,
522 val _ = Program.clearTop program