source: extracted/uses.ml @ 2742

Last change on this file since 2742 was 2742, checked in by sacerdot, 7 years ago

Untrusted register colouring fully branched.

File size: 3.4 KB
Line 
1open Preamble
2
3open String
4
5open Sets
6
7open Listb
8
9open LabelledObjects
10
11open Graphs
12
13open I8051
14
15open Order
16
17open Registers
18
19open BitVectorTrie
20
21open CostLabel
22
23open Hide
24
25open Proper
26
27open PositiveMap
28
29open Deqsets
30
31open ErrorMessages
32
33open PreIdentifiers
34
35open Errors
36
37open Extralib
38
39open Setoids
40
41open Monad
42
43open Option
44
45open Lists
46
47open Identifiers
48
49open Integers
50
51open AST
52
53open Division
54
55open Exp
56
57open Arithmetic
58
59open Extranat
60
61open Vector
62
63open Div_and_mod
64
65open Jmeq
66
67open Russell
68
69open List
70
71open Util
72
73open FoldStuff
74
75open BitVector
76
77open Types
78
79open Bool
80
81open Relations
82
83open Nat
84
85open Hints_declaration
86
87open Core_notation
88
89open Pts
90
91open Logic
92
93open Positive
94
95open Z
96
97open BitVectorZ
98
99open Pointers
100
101open ByteValues
102
103open BackEndOps
104
105open Joint
106
107open ERTL
108
109open ERTLptr
110
111(** val examine_internal :
112    AST.ident List.list -> Joint.joint_internal_function -> Positive.pos
113    Identifiers.identifier_map **)
114let examine_internal globals fun0 =
115  let incr = fun r map1 ->
116    match Identifiers.lookup0 PreIdentifiers.RegisterTag map1 r with
117    | Types.None ->
118      Identifiers.add PreIdentifiers.RegisterTag map1 r Positive.One
119    | Types.Some v ->
120      Identifiers.add PreIdentifiers.RegisterTag map1 r (Positive.succ v)
121  in
122  let incr_arg = fun arg map1 ->
123    match arg with
124    | Joint.Reg r -> incr r map1
125    | Joint.Imm x -> map1
126  in
127  let f = fun x instr map1 ->
128    match instr with
129    | Joint.Sequential (s, x0) ->
130      (match s with
131       | Joint.COST_LABEL x1 -> map1
132       | Joint.CALL (x1, x2, x3) -> map1
133       | Joint.COND (r, x1) -> Obj.magic incr r map1
134       | Joint.Step_seq s0 ->
135         (match s0 with
136          | Joint.COMMENT x1 -> map1
137          | Joint.MOVE pair ->
138            let { Types.fst = r5; Types.snd = r6 } = Obj.magic pair in
139            let incr_dst = fun arg map4 ->
140              match arg with
141              | ERTL.PSD r -> incr r map4
142              | ERTL.HDW x1 -> map4
143            in
144            incr_dst r5
145              (match r6 with
146               | Joint.Reg a -> incr_dst a map1
147               | Joint.Imm x1 -> map1)
148          | Joint.POP r -> Obj.magic incr r map1
149          | Joint.PUSH r -> Obj.magic incr_arg r map1
150          | Joint.ADDRESS (x1, x3, x4) -> map1
151          | Joint.OPACCS (x1, r5, r6, r7, r8) ->
152            Obj.magic incr r5
153              (Obj.magic incr r6
154                (Obj.magic incr_arg r7 (Obj.magic incr_arg r8 map1)))
155          | Joint.OP1 (x1, r5, r6) ->
156            Obj.magic incr r5 (Obj.magic incr r6 map1)
157          | Joint.OP2 (x1, r5, r6, r7) ->
158            Obj.magic incr r5
159              (Obj.magic incr_arg r6 (Obj.magic incr_arg r7 map1))
160          | Joint.CLEAR_CARRY -> map1
161          | Joint.SET_CARRY -> map1
162          | Joint.LOAD (r5, x1, x2) -> Obj.magic incr r5 map1
163          | Joint.STORE (x1, x2, r) -> Obj.magic incr_arg r map1
164          | Joint.Extension_seq s1 ->
165            (match Obj.magic s1 with
166             | ERTLptr.Ertlptr_ertl s2 ->
167               (match s2 with
168                | ERTL.Ertl_new_frame -> map1
169                | ERTL.Ertl_del_frame -> map1
170                | ERTL.Ertl_frame_size r -> incr r map1)
171             | ERTLptr.LOW_ADDRESS (r, x1) -> incr r map1
172             | ERTLptr.HIGH_ADDRESS (r, x1) -> incr r map1)))
173    | Joint.Final x0 -> map1
174    | Joint.FCOND (x0, x1, x2) -> assert false (* absurd case *)
175  in
176  Identifiers.foldi0 PreIdentifiers.LabelTag f
177    (Obj.magic fun0.Joint.joint_if_code)
178    (Identifiers.empty_map PreIdentifiers.RegisterTag)
179
Note: See TracBrowser for help on using the repository browser.