1 (* Copyright (C) 1999-2007 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 amd64EntryTransfer(S: AMD64_ENTRY_TRANSFER_STRUCTS) : AMD64_ENTRY_TRANSFER =
14 val tracer = amd64.tracer
16 fun verifyEntryTransfer {chunk = Chunk.T {blocks, ...}}
18 val {get : Label.t -> Block.t option,
20 = Property.destGetSetOnce(Label.plist,
21 Property.initConst NONE)
26 fn block as Block.T {entry,...}
27 => set(Entry.label entry, SOME block))
29 fun isJump l = case get l
30 of SOME (Block.T {entry = Entry.Jump _, ...}) => true
32 fun isFunc l = case get l
33 of SOME (Block.T {entry = Entry.Func _, ...}) => true
36 fun isCont l = case get l
37 of SOME (Block.T {entry = Entry.Cont _, ...}) => true
39 fun isHandler l = case get l
40 of SOME (Block.T {entry = Entry.Handler _, ...}) => true
42 fun isCReturn l f = case get l
43 of SOME (Block.T {entry = Entry.CReturn {func, ...}, ...})
44 => CFunction.equals (f, func)
48 fn Block.T {transfer, ...}
50 of Transfer.Goto {target, ...}
52 | Transfer.Iff {truee, falsee, ...}
53 => isJump truee andalso isJump falsee
54 | Transfer.Switch {cases, default, ...}
55 => isJump default andalso
56 Transfer.Cases.forall(cases, isJump o #2)
57 | Transfer.Tail {target, ...}
59 | Transfer.NonTail {target, return, handler, ...}
60 => isFunc target andalso
63 of SOME handler => isHandler handler
65 | Transfer.Return {...} => true
66 | Transfer.Raise {...} => true
67 | Transfer.CCall {return, func, ...}
70 | SOME l => isCReturn l func)))
73 else List.foreach(blocks, Block.printBlock)
78 val (verifyEntryTransfer, verifyEntryTransfer_msg)