Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh |
2 | * Jagannathan, and Stephen Weeks. | |
3 | * Copyright (C) 1997-2000 NEC Research Institute. | |
4 | * | |
5 | * MLton is released under a BSD-style license. | |
6 | * See the file MLton-LICENSE for details. | |
7 | *) | |
8 | ||
9 | functor x86EntryTransfer(S: X86_ENTRY_TRANSFER_STRUCTS) : X86_ENTRY_TRANSFER = | |
10 | struct | |
11 | open S | |
12 | open x86 | |
13 | ||
14 | val tracer = x86.tracer | |
15 | ||
16 | fun verifyEntryTransfer {chunk = Chunk.T {blocks, ...}} | |
17 | = let | |
18 | val {get : Label.t -> Block.t option, | |
19 | set, destroy} | |
20 | = Property.destGetSetOnce(Label.plist, | |
21 | Property.initConst NONE) | |
22 | ||
23 | val _ | |
24 | = List.foreach | |
25 | (blocks, | |
26 | fn block as Block.T {entry,...} | |
27 | => set(Entry.label entry, SOME block)) | |
28 | ||
29 | fun isJump l = case get l | |
30 | of SOME (Block.T {entry = Entry.Jump _, ...}) => true | |
31 | | _ => false | |
32 | fun isFunc l = case get l | |
33 | of SOME (Block.T {entry = Entry.Func _, ...}) => true | |
34 | | NONE => true | |
35 | | _ => false | |
36 | fun isCont l = case get l | |
37 | of SOME (Block.T {entry = Entry.Cont _, ...}) => true | |
38 | | _ => false | |
39 | fun isHandler l = case get l | |
40 | of SOME (Block.T {entry = Entry.Handler _, ...}) => true | |
41 | | _ => false | |
42 | fun isCReturn l f = case get l | |
43 | of SOME (Block.T {entry = Entry.CReturn {func, ...}, ...}) | |
44 | => CFunction.equals (f, func) | |
45 | | _ => false | |
46 | val b = List.forall | |
47 | (blocks, | |
48 | fn Block.T {transfer, ...} | |
49 | => (case transfer | |
50 | of Transfer.Goto {target, ...} | |
51 | => isJump 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, ...} | |
58 | => isFunc target | |
59 | | Transfer.NonTail {target, return, handler, ...} | |
60 | => isFunc target andalso | |
61 | isCont return andalso | |
62 | (case handler | |
63 | of SOME handler => isHandler handler | |
64 | | NONE => true) | |
65 | | Transfer.Return {...} => true | |
66 | | Transfer.Raise {...} => true | |
67 | | Transfer.CCall {return, func, ...} | |
68 | => (case return | |
69 | of NONE => true | |
70 | | SOME l => isCReturn l func))) | |
71 | val _ = destroy () | |
72 | val _ = if b then () | |
73 | else List.foreach(blocks, Block.printBlock) | |
74 | in | |
75 | b | |
76 | end | |
77 | ||
78 | val (verifyEntryTransfer, verifyEntryTransfer_msg) | |
79 | = tracer | |
80 | "verifyEntryTransfer" | |
81 | verifyEntryTransfer | |
82 | ||
83 | end |