1 (* Copyright (C) 2009 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.
11 * The goal of limit check insertion is to ensure that
12 * 1. At any allocation of b bytes, frontier + b <= base + heapSize
13 * 2. At entry to each function, stackTop <= stackLimit
15 * It assumes that runtime provides several operands to help with this.
22 * There are three different kinds of checks inserted, depending on the
23 * amount being allocated and whether or not the program uses signal
26 * 1. If b <= LIMIT_SLOP, then continue (don't GC) if
30 * The reason this works is that if frontier <= limit and b <=
32 * frontier + b <= limit + LIMIT_SLOP
35 * This works even if the program uses signal handlers, which set
36 * limit to zero, since frontier <= 0 will always be false.
38 * 2. If b > LIMIT_SLOP and if the program doesn't use signal handlers,
39 * then continue (don't GC) if
41 * b <= limitPlusSlop - frontier
43 * The reason this works is that the condition is equivalent to
45 * b + frontier <= limitPlusSlop = base + heapSize
47 * We write the condition the way we do instead of the more obvious way
48 * because "b + frontier" may overflow, while limitPlusSlop - frontier
49 * can not, unless the program uses signal handlers.
51 * 3. If b > LIMIT_SLOP and if the program uses signal handlers, then
52 * continue (don't GC) if
55 * and b <= limitPlusSlop - frontier
57 * This is like case (2), except that because the program uses signal
58 * handlers, the runtime may have set limit to zero to indicate that a
59 * signal needs to be handled. So, we first check that this is not
60 * the case before continuing as in case (2).
62 * Stack limit checks are completely orthogonal to heap checks, and are simply
63 * inserted at the start of each function.
65 functor LimitCheck (S: RSSA_TRANSFORM_STRUCTS): RSSA_TRANSFORM =
71 structure LimitCheck =
76 | LoopHeaders of {fullCFG: bool,
84 datatype limitCheck = datatype LimitCheck.t
87 ref (LoopHeaders {fullCFG = false,
91 datatype z = datatype Transfer.t
95 open CFunction Type.BuiltInCFunction
102 fun bytesAllocated (s: t): Bytes.t =
104 Object {size, ...} => size
112 datatype bytesAllocated =
116 fun bytesAllocated (t: t): bytesAllocated =
118 CCall {args, func, ...} =>
119 (case CFunction.bytesNeeded func of
120 NONE => Small Bytes.zero
123 val z = Vector.sub (args, i)
130 val w = WordX.toIntInf w
132 (* 512 is small and arbitrary *)
134 then Small (Bytes.fromIntInf w)
137 | _ => Error.bug "LimitCheck.Transfer.bytesAllocated: strange numBytes")
140 | _ => Small Bytes.zero
147 fun objectBytesAllocated (T {statements, transfer, ...}): Bytes.t =
149 (Vector.fold (statements, Bytes.zero, fn (s, ac) =>
150 Bytes.+ (ac, Statement.bytesAllocated s)),
151 case Transfer.bytesAllocated transfer of
152 Transfer.Big _ => Bytes.zero
153 | Transfer.Small b => b)
156 val extraGlobals: Var.t list ref = ref []
158 fun insertFunction (f: Function.t,
159 handlesSignals: bool,
160 blockCheckAmount: {blockIndex: int} -> Bytes.t,
161 ensureFree: Label.t -> Bytes.t) =
163 val {args, blocks, name, raises, returns, start} = Function.dest f
164 val lessThan = Prim.wordLt (WordSize.csize (), {signed = false})
165 val newBlocks = ref []
167 val r: Label.t option ref = ref NONE
169 fun heapCheckTooLarge () =
174 val l = Label.newNoname ()
177 CFunction.T {args = Vector.new0 (),
178 convention = CFunction.Convention.Cdecl,
179 kind = CFunction.Kind.Runtime {bytesNeeded = NONE,
180 ensuresBytesFree = false,
182 maySwitchThreads = false,
183 modifiesFrontier = false,
184 readsStackTop = false,
185 writesStackTop = false},
186 prototype = (Vector.new0 (), NONE),
188 symbolScope = CFunction.SymbolScope.Private,
189 target = CFunction.Target.Direct "MLton_heapCheckTooLarge"}
192 Block.T {args = Vector.new0 (),
195 statements = Vector.new0 (),
197 Transfer.CCall {args = Vector.new0 (),
207 (blocks, fn (i, Block.T {args, kind, label, statements, transfer}) =>
211 Transfer.CCall {args, func, return} =>
212 (if CFunction.ensuresBytesFree func
218 Operand.EnsuresBytesFree =>
222 (ensureFree (valOf return)),
229 val stack = Label.equals (start, label)
230 fun insert (amount: Operand.t (* of type word *)) =
232 val collect = Label.newNoname ()
233 val collectReturn = Label.newNoname ()
234 val dontCollect = Label.newNoname ()
235 val (dontCollect', collectReturnStatements, force) =
236 case !Control.gcCheck of
239 val global = Var.newNoname ()
240 val _ = List.push (extraGlobals, global)
242 Operand.Var {var = global,
244 val dontCollect' = Label.newNoname ()
249 {args = Vector.new0 (),
251 label = dontCollect',
252 statements = Vector.new0 (),
255 (global, {falsee = dontCollect,
260 (Statement.Move {dst = global,
261 src = Operand.bool false}),
265 (dontCollect, Vector.new0 (), Operand.bool false)
267 (collect, Vector.new0 (), Operand.bool true)
268 val func = CFunction.gc {maySwitchThreads = handlesSignals}
271 Block.T {args = Vector.new0 (),
274 statements = Vector.new0 (),
275 transfer = (Transfer.CCall
276 {args = Vector.new3 (Operand.GCState,
280 return = SOME collectReturn})}
282 {args = Vector.new0 (),
283 kind = Kind.CReturn {func = func},
284 label = collectReturn,
285 statements = collectReturnStatements,
286 transfer = Transfer.Goto {dst = dontCollect,
287 args = Vector.new0 ()}})
288 :: Block.T {args = Vector.new0 (),
291 statements = statements,
296 dontCollect = dontCollect'}
298 fun newBlock (isFirst, statements, transfer) =
300 val (args, kind, label) =
302 then (args, kind, label)
303 else (Vector.new0 (), Kind.Jump, Label.newNoname ())
307 Block.T {args = args,
310 statements = statements,
311 transfer = transfer})
315 fun gotoHeapCheckTooLarge () =
319 Transfer.Goto {args = Vector.new0 (),
320 dst = heapCheckTooLarge ()})
321 fun primApp (prim, op1, op2, {collect, dontCollect}) =
323 val res = Var.newNoname ()
325 Statement.PrimApp {args = Vector.new2 (op1, op2),
326 dst = SOME (res, Type.bool),
330 (Operand.Var {var = res, ty = Type.bool},
331 {falsee = dontCollect,
334 (Vector.new1 s, transfer)
336 datatype z = datatype Runtime.GCField.t
337 fun stackCheck (maybeFirst, z): Label.t =
339 val (statements, transfer) =
340 primApp (Prim.cpointerLt,
341 Operand.Runtime StackLimit,
342 Operand.Runtime StackTop,
345 newBlock (maybeFirst, statements, transfer)
347 fun maybeStack (): unit =
349 then ignore (stackCheck
352 (WordX.zero (WordSize.csize ())))))
354 (* No limit check, just keep the block around. *)
355 List.push (newBlocks,
356 Block.T {args = args,
359 statements = statements,
360 transfer = transfer})
361 fun frontierCheck (isFirst,
363 z as {collect, dontCollect = _}): Label.t =
365 val (statements, transfer) = primApp (prim, op1, op2, z)
366 val l = newBlock (isFirst andalso not stack,
367 statements, transfer)
370 then stackCheck (isFirst, {collect = collect,
374 fun heapCheck (isFirst: bool,
375 amount: Operand.t (* of type word *)): Label.t =
377 val z as {collect, ...} = insert amount
378 val res = Var.newNoname ()
380 (* Can't do Limit - Frontier, because don't know that
384 {args = Vector.new2 (Operand.Runtime LimitPlusSlop,
385 Operand.Runtime Frontier),
386 dst = SOME (res, Type.csize ()),
387 prim = Prim.cpointerDiff}
388 val (statements, transfer) =
390 Operand.Var {var = res, ty = Type.csize ()},
393 val statements = Vector.concat [Vector.new1 s, statements]
397 frontierCheck (isFirst,
399 Operand.Runtime Limit,
402 dontCollect = newBlock (false,
411 newBlock (false, statements, transfer)})
412 else newBlock (isFirst, statements, transfer)
414 fun heapCheckNonZero (bytes: Bytes.t): unit =
416 (if Bytes.<= (bytes, Runtime.limitSlop)
417 then frontierCheck (true,
419 Operand.Runtime Limit,
420 Operand.Runtime Frontier,
422 (WordX.zero (WordSize.csize ()))))
429 (Bytes.toIntInf bytes,
433 end handle Overflow => NONE
436 NONE => gotoHeapCheckTooLarge ()
437 | SOME bytes => heapCheck (true, Operand.word bytes)
439 fun smallAllocation (): unit =
441 val b = blockCheckAmount {blockIndex = i}
445 else heapCheckNonZero b
447 fun bigAllocation (bytesNeeded: Operand.t): unit =
449 val extraBytes = blockCheckAmount {blockIndex = i}
457 (Bytes.fromIntInf (WordX.toIntInf w),
459 | _ => Error.bug "LimitCheck.bigAllocation: strange constant bytesNeeded")
462 val bytes = Var.newNoname ()
467 (Bytes.toIntInf extraBytes,
471 end handle Overflow => NONE
474 NONE => ignore (gotoHeapCheckTooLarge ())
480 {args = Vector.new2 (Operand.word extraBytes,
483 overflow = heapCheckTooLarge (),
484 prim = Prim.wordAddCheck (WordSize.csize (),
490 ty = Type.csize ()})),
495 case Transfer.bytesAllocated transfer of
496 Transfer.Big z => bigAllocation z
497 | Transfer.Small _ => smallAllocation ()
500 Function.new {args = args,
501 blocks = Vector.fromList (!newBlocks),
508 fun insertPerBlock (f: Function.t, handlesSignals) =
510 val {blocks, ...} = Function.dest f
511 fun blockCheckAmount {blockIndex} =
512 Block.objectBytesAllocated (Vector.sub (blocks, blockIndex))
514 insertFunction (f, handlesSignals, blockCheckAmount, fn _ => Bytes.zero)
517 structure Graph = DirectedGraph
518 structure Node = Graph.Node
519 structure Edge = Graph.Edge
520 structure Forest = Graph.LoopForest
522 val traceMaxPath = Trace.trace ("LimitCheck.maxPath", Int.layout, Bytes.layout)
524 fun isolateBigTransfers (f: Function.t): Function.t =
526 val {args, blocks, name, raises, returns, start} = Function.dest f
527 val newBlocks = ref []
531 fn block as Block.T {args, kind, label, statements, transfer} =>
532 case Transfer.bytesAllocated transfer of
535 val l = Label.newNoname ()
537 List.push (newBlocks,
538 Block.T {args = args,
541 statements = statements,
542 transfer = Goto {args = Vector.new0 (),
544 ; List.push (newBlocks,
545 Block.T {args = Vector.new0 (),
548 statements = Vector.new0 (),
549 transfer = transfer})
551 | Transfer.Small _ => List.push (newBlocks, block))
552 val blocks = Vector.fromListRev (!newBlocks)
554 Function.new {args = args,
562 fun insertCoalesce (f: Function.t, handlesSignals) =
564 val f = isolateBigTransfers f
565 val {blocks, start, ...} = Function.dest f
566 val n = Vector.length blocks
567 val {get = labelIndex, set = setLabelIndex, ...} =
570 Property.initRaise ("LimitCheck.labelIndex", Label.layout))
571 val {get = nodeIndex, set = setNodeIndex, ...} =
573 (Node.plist, Property.initRaise ("LimitCheck.nodeIndex", Node.layout))
576 (blocks, fn (i, Block.T {label, ...}) =>
577 setLabelIndex (label, i))
578 (* Build the graph. *)
584 val n = Graph.newNode g
585 val _ = setNodeIndex (n, i)
589 fun indexNode i = Vector.sub (nodes, i)
590 val labelNode = indexNode o labelIndex
591 val root = Graph.newNode g
592 (* mayHaveCheck == E U D
593 * E = set of entry nodes
594 * = start, Cont, Handler,
595 * or CReturn that doesn't ensure bytesFree
596 * Jump that calls a cfunction with bytesneeded
597 * D = set of decycling nodes
603 val Block.T {kind, transfer, ...} = Vector.sub (blocks, i)
604 datatype z = datatype Kind.t
606 case Transfer.bytesAllocated transfer of
607 Transfer.Big _ => true
608 | Transfer.Small _ => false
612 | CReturn {func, ...} =>
614 andalso not (CFunction.ensuresBytesFree func)
618 Transfer.CCall {args, func, ...} =>
619 (case CFunction.bytesNeeded func of
622 (case Vector.sub (args, i) of
623 Operand.Const _ => false
629 val _ = Array.update (mayHaveCheck, labelIndex start, true)
631 val _ = Graph.addEdge (g, {from = root, to = labelNode start})
632 datatype z = datatype Control.limitCheck
634 case !Control.limitCheck of
635 ExtBasicBlocks => true
636 | LoopHeaders {fullCFG, ...} => fullCFG
637 | _ => Error.bug "LimitCheck.insertCoalesce: fullCFG"
640 (blocks, fn (i, Block.T {transfer, ...}) =>
642 val from = indexNode i
644 Transfer.foreachLabel
647 val i' = labelIndex l
648 val to = indexNode i'
650 (ignore o Graph.addEdge)
651 (g, {from = from, to = to})
655 else if Array.sub (mayHaveCheck, i')
660 val objectBytesAllocated = Vector.map (blocks, Block.objectBytesAllocated)
661 fun insertCoalesceExtBasicBlocks () =
663 val preds = Array.new (n, 0)
665 Array.update (preds, i, 1 + (Array.sub (preds, i)))
670 (Node.successors node,
671 incPred o nodeIndex o Edge.to))
675 if n > 1 then Array.update (mayHaveCheck, i, true) else ())
679 fun insertCoalesceLoopHeaders loopExits =
681 (* Set equivalence classes, where two nodes are equivalent if they
682 * are in the same loop in the loop forest.
683 * Also mark loop headers as mayHaveCheck.
685 val classes = Array.array (n, ~1)
686 fun indexClass i = Array.sub (classes, i)
687 val c = Counter.new 0
688 fun setClass (f: unit Forest.t) =
690 val {loops, notInLoop} = Forest.dest f
691 val class = Counter.next c
695 if Node.equals (n, root)
697 else Array.update (classes, nodeIndex n, class))
700 (loops, fn {headers, child} =>
703 Array.update (mayHaveCheck, nodeIndex n, true))
708 val _ = setClass (Graph.loopForestSteensgaard (g, {root = root}))
709 val numClasses = Counter.value c
710 datatype z = datatype Control.limitCheck
714 (* Determine which classes allocate. *)
715 val classDoesAllocate =
716 Array.array (numClasses, false)
719 (Graph.nodes g, fn n =>
720 if Node.equals (n, root)
728 Vector.sub (objectBytesAllocated, i)))
729 then Array.update (classDoesAllocate,
734 (* Mark nodes that are post-exits of non-allocating
735 * loops as mayHaveCheck.
739 (Graph.nodes g, fn n =>
740 if Node.equals (n, root)
747 if Array.sub (classDoesAllocate, c)
750 (Node.successors n, fn e =>
752 val i' = nodeIndex (Edge.to e)
754 if c <> indexClass i'
756 (mayHaveCheck, i', true)
767 datatype z = datatype Control.limitCheck
769 case !Control.limitCheck of
770 ExtBasicBlocks => insertCoalesceExtBasicBlocks ()
771 | LoopHeaders {loopExits, ...} => insertCoalesceLoopHeaders loopExits
772 | _ => Error.bug "LimitCheck.insertCoalesce"
773 (* If we remove edges into nodes that are mayHaveCheck, we have an
775 * So, we can compute a function, maxPath, inductively that for each node
776 * tells the maximum amount allocated along any path that passes only
777 * through nodes that are not mayHaveCheck.
780 val a = Array.array (n, NONE)
782 fun maxPath arg : Bytes.t = (* i is a node index *)
785 case Array.sub (a, i) of
789 val x = Vector.sub (objectBytesAllocated, i)
792 (Node.successors (indexNode i), Bytes.zero,
795 val i' = nodeIndex (Edge.to e)
797 if Array.sub (mayHaveCheck, i')
799 else Bytes.max (max, maxPath i')
801 val x = Bytes.+ (x, max)
802 val _ = Array.update (a, i, SOME x)
808 fun blockCheckAmount {blockIndex} =
809 if Array.sub (mayHaveCheck, blockIndex)
810 then maxPath blockIndex
812 val f = insertFunction (f, handlesSignals, blockCheckAmount,
813 maxPath o labelIndex)
818 (blocks, fn Block.T {label, ...} =>
819 display (let open Layout
820 in seq [Label.layout label, str " ",
821 Bytes.layout (maxPath (labelIndex label))]
823 val _ = Function.clear f
828 fun transform (Program.T {functions, handlesSignals, main, objectTypes}) =
830 val _ = Control.diagnostic (fn () => Layout.str "Limit Check maxPaths")
831 datatype z = datatype Control.limitCheck
833 case !Control.limitCheck of
834 PerBlock => insertPerBlock (f, handlesSignals)
835 | _ => insertCoalesce (f, handlesSignals)
836 val functions = List.revMap (functions, insert)
837 val {args, blocks, name, raises, returns, start} =
838 Function.dest (insert main)
839 val newStart = Label.newNoname ()
841 Block.T {args = Vector.new0 (),
844 statements = (Vector.fromListMap
845 (!extraGlobals, fn x =>
847 {dst = (x, Type.bool),
849 src = Operand.cast (Operand.bool true,
851 transfer = Transfer.Goto {args = Vector.new0 (),
853 val blocks = Vector.concat [Vector.new1 block, blocks]
854 val main = Function.new {args = args,
861 Program.T {functions = functions,
862 handlesSignals = handlesSignals,
864 objectTypes = objectTypes}