@@ -25,7 +25,7 @@ type valnum = int
2525type op_class =
2626 | Op_pure (* pure arithmetic, produce one or several result *)
2727 | Op_checkbound (* checkbound-style: no result, can raise an exn *)
28- | Op_load (* memory load *)
28+ | Op_load of Asttypes .mutable_flag (* memory load *)
2929 | Op_store of bool (* memory store, false = init, true = assign *)
3030 | Op_other (* anything else that does not allocate nor store in memory *)
3131
@@ -40,29 +40,30 @@ module Equations = struct
4040 Map. Make (struct type t = rhs let compare = Stdlib. compare end )
4141
4242 type 'a t =
43- { load_equations : 'a Rhs_map .t ;
43+ { mutable_load_equations : 'a Rhs_map .t ;
4444 other_equations : 'a Rhs_map .t }
4545
4646 let empty =
47- { load_equations = Rhs_map. empty;
47+ { mutable_load_equations = Rhs_map. empty;
4848 other_equations = Rhs_map. empty }
4949
5050 let add op_class op v m =
5151 match op_class with
52- | Op_load ->
53- { m with load_equations = Rhs_map. add op v m.load_equations }
52+ | Op_load Mutable ->
53+ { m with mutable_load_equations =
54+ Rhs_map. add op v m.mutable_load_equations }
5455 | _ ->
5556 { m with other_equations = Rhs_map. add op v m.other_equations }
5657
5758 let find op_class op m =
5859 match op_class with
59- | Op_load ->
60- Rhs_map. find op m.load_equations
60+ | Op_load Mutable ->
61+ Rhs_map. find op m.mutable_load_equations
6162 | _ ->
6263 Rhs_map. find op m.other_equations
6364
64- let remove_loads m =
65- { load_equations = Rhs_map. empty;
65+ let remove_mutable_loads m =
66+ { mutable_load_equations = Rhs_map. empty;
6667 other_equations = m.other_equations }
6768end
6869
@@ -190,8 +191,8 @@ let set_unknown_regs n rs =
190191
191192(* Keep only the equations satisfying the given predicate. *)
192193
193- let remove_load_numbering n =
194- { n with num_eqs = Equations. remove_loads n.num_eqs }
194+ let remove_mutable_load_numbering n =
195+ { n with num_eqs = Equations. remove_mutable_loads n.num_eqs }
195196
196197(* Forget everything we know about registers of type [Addr]. *)
197198
@@ -225,7 +226,7 @@ method class_of_operation op =
225226 | Icall_ind | Icall_imm _ | Itailcall_ind | Itailcall_imm _
226227 | Iextcall _ | Iprobe _ | Iopaque -> assert false (* treated specially *)
227228 | Istackoffset _ -> Op_other
228- | Iload (_ ,_ ) -> Op_load
229+ | Iload (_ ,_ , mut ) -> Op_load mut
229230 | Istore (_ ,_ ,asg ) -> Op_store asg
230231 | Ialloc _ -> assert false (* treated specially *)
231232 | Iintop (Icheckbound) -> Op_checkbound
@@ -246,11 +247,11 @@ method is_cheap_operation op =
246247 | Iconst_int _ -> true
247248 | _ -> false
248249
249- (* Forget all equations involving memory loads. Performed after a
250- non-initializing store *)
250+ (* Forget all equations involving mutable memory loads.
251+ Performed after a non-initializing store *)
251252
252253method private kill_loads n =
253- remove_load_numbering n
254+ remove_mutable_load_numbering n
254255
255256(* Perform CSE on the given instruction [i] and its successors.
256257 [n] is the value numbering current at the beginning of [i]. *)
@@ -292,13 +293,13 @@ method private cse n i =
292293 Moreover, allocation can trigger the asynchronous execution
293294 of arbitrary Caml code (finalizer, signal handler, context
294295 switch), which can contain non-initializing stores.
295- Hence, all equations over loads must be removed. *)
296+ Hence, all equations over mutable loads must be removed. *)
296297 let n1 = kill_addr_regs (self#kill_loads n) in
297298 let n2 = set_unknown_regs n1 i.res in
298299 {i with next = self#cse n2 i.next}
299300 | Iop op ->
300301 begin match self#class_of_operation op with
301- | (Op_pure | Op_checkbound | Op_load ) as op_class ->
302+ | (Op_pure | Op_checkbound | Op_load _ ) as op_class ->
302303 let (n1, varg) = valnum_regs n i.arg in
303304 let n2 = set_unknown_regs n1 (Proc. destroyed_at_oper i.desc) in
304305 begin match find_equation op_class n1 (op, varg) with
@@ -336,7 +337,7 @@ method private cse n i =
336337 {i with next = self#cse n2 i.next}
337338 | Op_store true ->
338339 (* A non-initializing store can invalidate
339- anything we know about prior loads. *)
340+ anything we know about prior mutable loads. *)
340341 let n1 = set_unknown_regs n (Proc. destroyed_at_oper i.desc) in
341342 let n2 = set_unknown_regs n1 i.res in
342343 let n3 = self#kill_loads n2 in
0 commit comments