1 (* Copyright (C) 1999-2006 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.
11 A label is exactly-multi-threaded if it may be executed by two
12 different threads during some run of the program. The initial call to
13 main counts as one thread.
16 A label is actually-multi-used if it may be executed more than once
17 during the execution of the program.
20 functor Multi (S: MULTI_STRUCTS): MULTI =
26 structure Graph = DirectedGraph
34 datatype t = T of value ref
35 and value = Zero | One | Many
36 fun new (): t = T (ref Zero)
42 = fn (T (ref Many)) => true
46 structure ThreadCopyCurrent =
48 structure L = TwoPointLattice (val bottom = "false"
56 structure MultiThreaded =
58 structure L = TwoPointLattice (val bottom = "false"
68 structure L = TwoPointLattice (val bottom = "false"
79 datatype t = T of {calls: Calls.t,
80 threadCopyCurrent: ThreadCopyCurrent.t,
81 multiThreaded: MultiThreaded.t,
82 multiUsed: MultiUsed.t}
85 fun make f (T r) = f r
87 val calls = make #calls
88 val threadCopyCurrent = make #threadCopyCurrent
89 val multiThreaded = make #multiThreaded
90 val multiUsed = make #multiUsed
93 fun new (): t = T {calls = Calls.new (),
94 threadCopyCurrent = ThreadCopyCurrent.new (),
95 multiUsed = MultiUsed.new (),
96 multiThreaded = MultiThreaded.new ()}
101 datatype t = T of {threadCopyCurrent: ThreadCopyCurrent.t,
102 multiThreaded: MultiThreaded.t,
103 multiUsed: MultiUsed.t}
106 fun make f (T r) = f r
108 val threadCopyCurrent = make #threadCopyCurrent
109 val multiThreaded = make #multiThreaded
110 val multiUsed = make #multiUsed
113 fun new (): t = T {threadCopyCurrent = ThreadCopyCurrent.new (),
114 multiThreaded = MultiThreaded.new (),
115 multiUsed = MultiUsed.new ()}
120 datatype t = T of {multiThreaded: MultiThreaded.t,
121 multiUsed: MultiUsed.t}
124 fun make f (T r) = f r
126 val multiThreaded = make #multiThreaded
127 val multiUsed = make #multiUsed
130 fun new (): t = T {multiThreaded = MultiThreaded.new (),
131 multiUsed = MultiUsed.new ()}
134 fun multi (p as Program.T {functions, main, ...})
136 val usesThreadsOrConts
137 = Program.hasPrim (p, fn p =>
139 Prim.Name.Thread_switchTo => true
143 val {get = funcNode: Func.t -> unit Node.t,
145 rem = remFuncNode, ...}
146 = Property.getSetOnce
147 (Func.plist, Property.initRaise ("Multi.funcNode", Func.layout))
150 val {get = nodeFunction: unit Node.t -> Function.t,
151 set = setNodeFunction, ...}
152 = Property.getSetOnce
153 (Node.plist, Property.initRaise ("Multi.nodeFunc", Node.layout))
156 val {get = funcInfo: Func.t -> FuncInfo.t, ...}
158 (Func.plist, Property.initFun (fn _ => FuncInfo.new ()))
161 val {get = labelInfo: Label.t -> LabelInfo.t, ...}
163 (Label.plist, Property.initFun (fn _ => LabelInfo.new ()))
166 val {get = varInfo: Var.t -> VarInfo.t, ...}
168 (Var.plist, Property.initFun (fn _ => VarInfo.new ()))
170 (* construct call graph
172 * compute threadCopyCurrent
175 fun newNode () = Graph.newNode G
176 fun addEdge edge = ignore (Graph.addEdge (G, edge))
182 setFuncNode (Function.name f, n) ;
183 setNodeFunction (n, f)
185 val _ = Calls.inc (FuncInfo.calls (funcInfo main))
189 val {name = f, blocks, ...} = Function.dest f
193 (blocks, fn Block.T {label, transfer, ...} =>
195 val li = labelInfo label
198 of Call {func = g, ...}
202 Calls.inc (FuncInfo.calls gi) ;
203 addEdge {from = funcNode f,
205 if usesThreadsOrConts
206 then ThreadCopyCurrent.when
207 (FuncInfo.threadCopyCurrent gi,
209 (ThreadCopyCurrent.force
210 (LabelInfo.threadCopyCurrent li) ;
211 ThreadCopyCurrent.force
212 (FuncInfo.threadCopyCurrent fi)))
215 | Runtime {prim, ...}
216 => if usesThreadsOrConts
218 (case Prim.name prim of
219 Prim.Name.Thread_copyCurrent => true
221 then (ThreadCopyCurrent.force
222 (LabelInfo.threadCopyCurrent li) ;
223 ThreadCopyCurrent.force
224 (FuncInfo.threadCopyCurrent fi))
229 val () = Graph.removeDuplicateEdges G
230 val rec forceMultiThreadedVar
235 MultiThreaded.force (VarInfo.multiThreaded vi) ;
236 MultiUsed.force (VarInfo.multiUsed vi)
238 val rec forceMultiUsedVar
243 MultiUsed.force (VarInfo.multiUsed vi)
245 val rec forceMultiThreadedFunc
250 MultiThreaded.force (FuncInfo.multiThreaded fi) ;
251 MultiUsed.force (FuncInfo.multiUsed fi)
253 val rec forceMultiUsedFunc
258 MultiUsed.force (FuncInfo.multiUsed fi)
260 val rec forceMultiThreadedBlock
261 = fn Block.T {label, args, statements, transfer} =>
263 val li = labelInfo label
265 if MultiThreaded.is (LabelInfo.multiThreaded li)
267 else (MultiThreaded.force (LabelInfo.multiThreaded li) ;
268 MultiUsed.force (LabelInfo.multiUsed li) ;
269 Vector.foreach (args, forceMultiThreadedVar o #1) ;
271 (statements, fn Statement.T {var, ...} =>
272 Option.app (var, forceMultiThreadedVar)) ;
274 (transfer, forceMultiThreadedFunc))
276 val rec forceMultiThreadedBlockDFS
277 = fn controlFlow as {graph = _, labelNode, nodeBlock} =>
278 fn block as Block.T {label, transfer, ...} =>
280 val li = labelInfo label
282 if MultiThreaded.is (LabelInfo.multiThreaded li)
284 else (forceMultiThreadedBlock block ;
285 Transfer.foreachLabel
287 forceMultiThreadedBlockDFS controlFlow
288 (nodeBlock (labelNode l))))
290 val rec forceMultiUsedBlock
291 = fn Block.T {label, args, statements, transfer} =>
293 val li = labelInfo label
295 if MultiUsed.is (LabelInfo.multiUsed li)
297 else (MultiUsed.force (LabelInfo.multiUsed li) ;
298 Vector.foreach (args, forceMultiUsedVar o #1) ;
300 (statements, fn Statement.T {var, ...} =>
301 Option.app (var, forceMultiUsedVar)) ;
303 (transfer, forceMultiUsedFunc))
306 = fn controlFlow as {graph = _, labelNode, nodeBlock} =>
307 fn Block.T {label, transfer, ...} =>
308 if ThreadCopyCurrent.does (LabelInfo.threadCopyCurrent (labelInfo label))
309 then Transfer.foreachLabel
311 forceMultiThreadedBlockDFS controlFlow
312 (nodeBlock (labelNode l)))
314 val rec visitForceMultiUsedBlock
317 (forceMultiUsedBlock block ;
318 visitBlock controlFlow block)
320 val rec forceMultiThreadedFunc
323 val {args, blocks, ...} = Function.dest f
326 (args, forceMultiThreadedVar o #1) ;
328 (blocks, forceMultiThreadedBlock)
330 val rec forceMultiUsedFunc
333 val {args, blocks, ...} = Function.dest f
336 (args, forceMultiUsedVar o #1) ;
338 (blocks, forceMultiUsedBlock)
341 fun visitFunc multiUsed f
343 val _ = remFuncNode (Function.name f)
345 val fi = funcInfo (Function.name f)
348 Calls.isMany (FuncInfo.calls fi)
349 then MultiUsed.force (FuncInfo.multiUsed fi)
352 if MultiThreaded.is (FuncInfo.multiThreaded fi)
353 then forceMultiThreadedFunc f
354 else if MultiUsed.is (FuncInfo.multiUsed fi)
355 then (forceMultiUsedFunc f ;
356 if usesThreadsOrConts
358 val _ = MultiThreaded.when
359 (FuncInfo.multiThreaded fi,
360 fn () => forceMultiThreadedFunc f)
361 val controlFlow = Function.controlFlow f
364 (Function.blocks f, visitBlock controlFlow)
367 else if usesThreadsOrConts
369 val _ = MultiThreaded.when
370 (FuncInfo.multiThreaded fi,
371 fn () => forceMultiThreadedFunc f)
372 val _ = MultiUsed.when
373 (FuncInfo.multiUsed fi,
374 fn () => forceMultiUsedFunc f)
375 val controlFlow as {graph, nodeBlock, ...}
376 = Function.controlFlow f
379 (Graph.stronglyConnectedComponents graph,
381 | [n] => if Node.hasEdge {from = n, to = n}
382 then visitForceMultiUsedBlock controlFlow
384 else visitBlock controlFlow
388 visitForceMultiUsedBlock controlFlow
392 val _ = MultiUsed.when
393 (FuncInfo.multiUsed fi,
394 fn () => forceMultiUsedFunc f)
395 val {graph, nodeBlock, ...} = Function.controlFlow f
398 (Graph.stronglyConnectedComponents graph,
400 | [n] => if Node.hasEdge {from = n, to = n}
401 then forceMultiUsedBlock (nodeBlock n)
405 forceMultiUsedBlock (nodeBlock n)))
410 (Graph.stronglyConnectedComponents G,
413 visitFunc (Node.hasEdge {from = n, to = n}) (nodeFunction n)
416 visitFunc true (nodeFunction n)))
419 val _ = Control.diagnostics
423 display (Layout.str "\n\nMulti:") ;
424 display (seq [Layout.str "usesThreadsOrConts: ",
425 Bool.layout usesThreadsOrConts]) ;
429 val {name = f, blocks, ...} = Function.dest f
431 display (seq [Func.layout f,
433 FuncInfo.layout (funcInfo f)]) ;
435 (blocks, fn Block.T {label, ...} =>
436 display (seq [Label.layout label,
438 LabelInfo.layout (labelInfo label)]))
444 usesThreadsOrConts = usesThreadsOrConts,
446 funcDoesThreadCopyCurrent
447 = ThreadCopyCurrent.does o FuncInfo.threadCopyCurrent o funcInfo,
449 = MultiThreaded.is o FuncInfo.multiThreaded o funcInfo,
451 = MultiUsed.is o FuncInfo.multiUsed o funcInfo,
453 labelDoesThreadCopyCurrent
454 = ThreadCopyCurrent.does o LabelInfo.threadCopyCurrent o labelInfo,
456 = MultiThreaded.is o LabelInfo.multiThreaded o labelInfo,
458 = MultiUsed.is o LabelInfo.multiUsed o labelInfo,
461 = MultiUsed.is o VarInfo.multiUsed o varInfo