1 (* Copyright (C) 1999-2006, 2008 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 x86JumpInfo(S: X86_JUMP_INFO_STRUCTS) : X86_JUMP_INFO =
14 val tracer = x86.tracer
16 datatype status = Count of int | None
19 = fn (None , None ) => true
20 | (Count i1, Count i2) => i1 = i2
25 | Count i => concat ["Count ", Int.toString i]
27 datatype t = T of {get: Label.t -> status ref}
31 val {get : Label.t -> status ref, ...}
32 = Property.get(Label.plist,
33 Property.initFun (fn _ => ref (Count 0)))
39 fun doit (status_ref, maybe_fn)
42 | Count i => status_ref := (maybe_fn i)
44 fun incNear (T {get}, label)
45 = doit (get label, fn i => Count (i+1))
46 fun decNear (T {get}, label)
47 = doit (get label, fn i => Count (i-1))
48 fun forceNear (T {get}, label)
49 = doit (get label, fn _ => None)
51 fun getNear (T {get}, label) = !(get label)
53 fun completeJumpInfo {chunk = Chunk.T {blocks, ...},
57 fn Block.T {entry, transfer,...}
60 | Entry.Func {label, ...} => forceNear (jumpInfo, label)
61 | Entry.Cont {label, ...} => forceNear (jumpInfo, label)
62 | Entry.Handler {label, ...} => forceNear (jumpInfo, label)
63 | Entry.CReturn {label, func, ...}
64 => if CFunction.maySwitchThreads func
65 then forceNear (jumpInfo, label)
68 (Transfer.nearTargets transfer,
70 => incNear (jumpInfo, label))))
72 val (completeJumpInfo, completeJumpInfo_msg)
77 fun verifyJumpInfo {chunk as Chunk.T {blocks, ...},
81 val {get : Label.t -> status ref,
83 = Property.destGet(Label.plist,
84 Property.initFun (fn _ => ref (Count 0)))
86 val jumpInfo' = T {get = get}
89 val _ = completeJumpInfo {chunk = chunk,
95 fn Block.T {entry,...}
97 val label = Entry.label entry
99 if status_eq(getNear(jumpInfo, label),
100 getNear(jumpInfo', label))
102 else (print "verifyJumpInfo: ";
103 print (Label.toString label);
106 print (status_toString (getNear(jumpInfo, label)));
109 print (status_toString (getNear(jumpInfo', label)));
119 val (verifyJumpInfo, verifyJumpInfo_msg)