Add Cvar_mut in Cmm to access mutable variables · anil.recoil.org/unpac-work@7a67af0

+5

.depend

··· 2997 2997 asmcomp/cmm_invariants.cmo : \ 2998 2998 utils/numbers.cmi \ 2999 2999 asmcomp/cmm.cmi \ 3000 + middle_end/backend_var.cmi \ 3000 3001 asmcomp/cmm_invariants.cmi 3001 3002 asmcomp/cmm_invariants.cmx : \ 3002 3003 utils/numbers.cmx \ 3003 3004 asmcomp/cmm.cmx \ 3005 + middle_end/backend_var.cmx \ 3004 3006 asmcomp/cmm_invariants.cmi 3005 3007 asmcomp/cmm_invariants.cmi : \ 3006 3008 asmcomp/cmm.cmi ··· 10597 10599 parsing/location.cmi \ 10598 10600 lambda/lambda.cmi \ 10599 10601 lambda/debuginfo.cmi \ 10602 + asmcomp/cmm.cmi \ 10600 10603 middle_end/backend_var.cmi \ 10601 10604 testsuite/tools/parsecmmaux.cmi 10602 10605 testsuite/tools/parsecmmaux.cmx : \ 10603 10606 parsing/location.cmx \ 10604 10607 lambda/lambda.cmx \ 10605 10608 lambda/debuginfo.cmx \ 10609 + asmcomp/cmm.cmx \ 10606 10610 middle_end/backend_var.cmx \ 10607 10611 testsuite/tools/parsecmmaux.cmi 10608 10612 testsuite/tools/parsecmmaux.cmi : \ 10609 10613 parsing/location.cmi \ 10610 10614 lambda/debuginfo.cmi \ 10615 + asmcomp/cmm.cmi \ 10611 10616 middle_end/backend_var.cmi 10612 10617 otherlibs/dynlink/byte/dynlink.cmo : \ 10613 10618 otherlibs/dynlink/dynlink_types.cmi \

+4

Changes

··· 471 471 type annotations. 472 472 (Chris Casinghino, review by Florian Angeletti and Gabriel Scherer) 473 473 474 + - #13875, #13878: Add dedicated constructor for mutable variable access in 475 + Cmm to prevent bugs linked to incorrect handling of coeffects. 476 + (Vincent Laviron, review by Gabriel Scherer) 477 + 474 478 OCaml 5.3.0 (8 January 2025) 475 479 ---------------------------- 476 480

+1 -1

asmcomp/afl_instrument.ml

+4

asmcomp/cmm.ml

+1

asmcomp/cmm.mli

··· 178 178 | Cconst_float of float * Debuginfo.t 179 179 | Cconst_symbol of string * Debuginfo.t 180 180 | Cvar of Backend_var.t 181 + | Cvar_mut of Backend_var.t 181 182 | Clet of Backend_var.With_provenance.t * expression * expression 182 183 | Clet_mut of Backend_var.With_provenance.t * machtype 183 184 * expression * expression

+4 -3

asmcomp/cmm_helpers.ml

··· 1800 1800 (Clet( 1801 1801 VP.create mi, 1802 1802 Cop(Cor, 1803 - [Cop(Clsr, [Cop(Caddi, [Cvar li; Cvar hi], dbg); cconst_int 1], 1803 + [Cop(Clsr, [Cop(Caddi, [Cvar_mut li; Cvar_mut hi], dbg); 1804 + cconst_int 1], 1804 1805 dbg); 1805 1806 cconst_int 1], 1806 1807 dbg), ··· 1817 1818 dbg, Cassign(li, Cvar mi), 1818 1819 dbg), 1819 1820 Cifthenelse 1820 - (Cop(Ccmpi Cge, [Cvar li; Cvar hi], dbg), 1821 + (Cop(Ccmpi Cge, [Cvar_mut li; Cvar_mut hi], dbg), 1821 1822 dbg, Cexit (raise_num, []), 1822 1823 dbg, Ctuple [], 1823 1824 dbg)))) ··· 1826 1827 dbg), 1827 1828 Clet ( 1828 1829 VP.create tagged, 1829 - Cop(Caddi, [lsl_const (Cvar li) log2_size_addr dbg; 1830 + Cop(Caddi, [lsl_const (Cvar_mut li) log2_size_addr dbg; 1830 1831 cconst_int(1 - 3 * size_addr)], dbg), 1831 1832 Csequence(Cop (Cstore (Word_int, Assignment), [cache; Cvar tagged], dbg), 1832 1833 Cvar tagged)))))

+1 -1

asmcomp/cmm_invariants.ml

+40 -11

asmcomp/cmmgen.ml

··· 39 39 40 40 type env = { 41 41 unboxed_ids : (V.t * boxed_number) V.tbl; 42 + mutable_ids : V.Set.t; 42 43 notify_catch : (Cmm.expression list -> unit) IntMap.t; 43 44 environment_param : V.t option; 44 45 } ··· 61 62 let empty_env = 62 63 { 63 64 unboxed_ids = V.empty; 65 + mutable_ids = V.Set.empty; 64 66 notify_catch = IntMap.empty; 65 67 environment_param = None; 66 68 } ··· 77 79 let add_unboxed_id id unboxed_id bn env = 78 80 { env with 79 81 unboxed_ids = V.add id (unboxed_id, bn) env.unboxed_ids; 82 + } 83 + 84 + let is_mutable_id id env = 85 + V.Set.mem id env.mutable_ids 86 + 87 + let add_mutable_id id env = 88 + { env with 89 + mutable_ids = V.Set.add id env.mutable_ids; 80 90 } 81 91 82 92 let add_notify_catch n f env = ··· 354 364 match e with 355 365 Uvar id -> 356 366 begin match is_unboxed_id id env with 357 - | None -> Cvar id 358 - | Some (unboxed_id, bn) -> box_number bn (Cvar unboxed_id) 367 + | None -> 368 + if is_mutable_id id env 369 + then Cvar_mut id 370 + else Cvar id 371 + | Some (unboxed_id, bn) -> 372 + let var = 373 + if is_mutable_id unboxed_id env 374 + then Cvar_mut unboxed_id 375 + else Cvar unboxed_id 376 + in 377 + box_number bn var 359 378 end 360 379 | Uconst sc -> 361 380 transl_constant Debuginfo.none sc ··· 654 673 let inc = match dir with Upto -> Caddi | Downto -> Csubi in 655 674 let raise_num = next_raise_count () in 656 675 let id_prev = VP.create (V.create_local "*id_prev*") in 676 + let env = add_mutable_id (VP.var id) env in 657 677 return_unit dbg 658 678 (Clet_mut 659 679 (id, typ_int, transl env low, ··· 661 681 ccatch 662 682 (raise_num, [], 663 683 Cifthenelse 664 - (Cop(Ccmpi tst, [Cvar (VP.var id); high], dbg), 684 + (Cop(Ccmpi tst, [Cvar_mut (VP.var id); high], dbg), 665 685 dbg, 666 686 Cexit (raise_num, []), 667 687 dbg, 668 688 create_loop 669 689 (Csequence 670 690 (remove_unit(transl env body), 671 - Clet(id_prev, Cvar (VP.var id), 691 + Clet(id_prev, Cvar_mut (VP.var id), 672 692 Csequence 673 693 (Cassign(VP.var id, 674 - Cop(inc, [Cvar (VP.var id); Cconst_int (2, dbg)], 694 + Cop(inc, [Cvar_mut (VP.var id); 695 + Cconst_int (2, dbg)], 675 696 dbg)), 676 697 Cifthenelse 677 698 (Cop(Ccmpi Ceq, [Cvar (VP.var id_prev); high], ··· 1238 1259 (* N.B. [body] must still be traversed even if [exp] will never return: 1239 1260 there may be constant closures inside that need lifting out. *) 1240 1261 begin match str, kind with 1241 - | Immutable, _ -> Clet(id, cexp, transl_body env) 1242 - | Mutable, Pintval -> Clet_mut(id, typ_int, cexp, transl_body env) 1243 - | Mutable, _ -> Clet_mut(id, typ_val, cexp, transl_body env) 1262 + | Immutable, _ -> 1263 + Clet(id, cexp, transl_body env) 1264 + | Mutable, Pintval -> 1265 + Clet_mut(id, typ_int, cexp, 1266 + transl_body (add_mutable_id (VP.var id) env)) 1267 + | Mutable, _ -> 1268 + Clet_mut(id, typ_val, cexp, 1269 + transl_body (add_mutable_id (VP.var id) env)) 1244 1270 end 1245 1271 | Boxed (boxed_number, false) -> 1246 1272 let unboxed_id = V.create_local (VP.name id) in 1247 1273 let v = VP.create unboxed_id in 1248 1274 let cexp = unbox_number dbg boxed_number cexp in 1249 - let body = 1275 + let body env = 1250 1276 transl_body (add_unboxed_id (VP.var id) unboxed_id boxed_number env) in 1251 1277 begin match str, boxed_number with 1252 - | Immutable, _ -> Clet (v, cexp, body) 1253 - | Mutable, bn -> Clet_mut (v, typ_of_boxed_number bn, cexp, body) 1278 + | Immutable, _ -> 1279 + Clet (v, cexp, body env) 1280 + | Mutable, bn -> 1281 + Clet_mut (v, typ_of_boxed_number bn, cexp, 1282 + body (add_mutable_id unboxed_id env)) 1254 1283 end 1255 1284 1256 1285 and make_catch ncatch body handler dbg = match body with

+1

asmcomp/printcmm.ml

··· 168 168 | Cconst_float (n, _dbg) -> fprintf ppf "%F" n 169 169 | Cconst_symbol (s, _dbg) -> fprintf ppf "\"%s\"" s 170 170 | Cvar id -> V.print ppf id 171 + | Cvar_mut id -> fprintf ppf "!%a" V.print id 171 172 | Creturn_addr -> fprintf ppf "return_addr" 172 173 | Clet(id, def, (Clet(_, _, _) as body)) -> 173 174 let print_binding id ppf def =

+5 -4

asmcomp/selectgen.ml

··· 110 110 | Cconst_symbol _ -> 111 111 Arch.size_addr 112 112 | Cconst_float _ -> Arch.size_float 113 - | Cvar id -> 113 + | Cvar id | Cvar_mut id -> 114 114 begin try 115 115 V.Map.find id localenv 116 116 with Not_found -> ··· 336 336 List.for_all self#is_simple_expr args 337 337 end 338 338 | Cassign _ | Cifthenelse _ | Cswitch _ | Ccatch _ | Cexit _ 339 - | Ctrywith _ -> false 339 + | Ctrywith _ | Cvar_mut _ -> false 340 340 341 341 (* Analyses the effects and coeffects of an expression. This is used across 342 342 a whole list of expressions with a view to determining which expressions ··· 355 355 match exp with 356 356 | Cconst_int _ | Cconst_natint _ | Cconst_float _ | Cconst_symbol _ 357 357 | Cvar _ | Creturn_addr -> EC.none 358 + | Cvar_mut _ -> EC.coeffect_only Coeffect.Read_mutable 358 359 | Ctuple el -> EC.join_list_map el self#effects_of 359 360 | Clet (_id, arg, body) | Clet_mut (_id, _, arg, body) -> 360 361 EC.join (self#effects_of arg) (self#effects_of body) ··· 605 606 | Creturn_addr -> 606 607 let r = self#regs_for typ_int in 607 608 Some(self#insert_op env Ireturn_addr [||] r) 608 - | Cvar v -> 609 + | Cvar v | Cvar_mut v -> 609 610 begin try 610 611 Some(env_find v env) 611 612 with Not_found -> ··· 1122 1123 end 1123 1124 | Cop _ 1124 1125 | Cconst_int _ | Cconst_natint _ | Cconst_float _ | Cconst_symbol _ 1125 - | Cvar _ 1126 + | Cvar _ | Cvar_mut _ 1126 1127 | Creturn_addr 1127 1128 | Cassign _ 1128 1129 | Ctuple _

+2 -2

asmcomp/thread_sanitizer.ml