99 open Hints_declaration
123 (** val examine_internal :
124 AST.ident List.list -> Joint.joint_internal_function -> Positive.pos
125 Identifiers.identifier_map **)
126 let examine_internal globals fun0 =
127 let incr = fun r map ->
128 match Identifiers.lookup PreIdentifiers.RegisterTag map r with
130 Identifiers.add PreIdentifiers.RegisterTag map r Positive.One
132 Identifiers.add PreIdentifiers.RegisterTag map r (Positive.succ v)
134 let incr_arg = fun arg map ->
136 | Joint.Reg r -> incr r map
139 let f = fun x instr map ->
141 | Joint.Sequential (s, x0) ->
143 | Joint.COST_LABEL x1 -> map
144 | Joint.CALL (id, x1, x2) ->
146 | Types.Inl x3 -> map
148 Obj.magic incr_arg pr.Types.fst
149 (Obj.magic incr_arg pr.Types.snd map))
150 | Joint.COND (r, x1) -> Obj.magic incr r map
151 | Joint.Step_seq s0 ->
153 | Joint.COMMENT x1 -> map
155 let { Types.fst = r1; Types.snd = r2 } = Obj.magic pair in
156 let incr_dst = fun arg map0 ->
158 | ERTL.PSD r -> incr r map0
159 | ERTL.HDW x1 -> map0
163 | Joint.Reg a -> incr_dst a map
164 | Joint.Imm x1 -> map)
165 | Joint.POP r -> Obj.magic incr r map
166 | Joint.PUSH r -> Obj.magic incr_arg r map
167 | Joint.ADDRESS (x1, x3, x4, x5) -> map
168 | Joint.OPACCS (x1, r1, r2, r3, r4) ->
171 (Obj.magic incr_arg r3 (Obj.magic incr_arg r4 map)))
172 | Joint.OP1 (x1, r1, r2) ->
173 Obj.magic incr r1 (Obj.magic incr r2 map)
174 | Joint.OP2 (x1, r1, r2, r3) ->
176 (Obj.magic incr_arg r2 (Obj.magic incr_arg r3 map))
177 | Joint.CLEAR_CARRY -> map
178 | Joint.SET_CARRY -> map
179 | Joint.LOAD (r1, x1, x2) -> Obj.magic incr r1 map
180 | Joint.STORE (x1, x2, r) -> Obj.magic incr_arg r map
181 | Joint.Extension_seq s1 ->
182 (match Obj.magic s1 with
183 | ERTL.Ertl_new_frame -> map
184 | ERTL.Ertl_del_frame -> map
185 | ERTL.Ertl_frame_size r -> incr r map)))
186 | Joint.Final x0 -> map
187 | Joint.FCOND (x0, x1, x2) -> assert false (* absurd case *)
189 Identifiers.foldi PreIdentifiers.LabelTag f
190 (Obj.magic fun0.Joint.joint_if_code)
191 (Identifiers.empty_map PreIdentifiers.RegisterTag)