diff --git a/Changes b/Changes index 7efa6e3e5943..b099100f4f4c 100644 --- a/Changes +++ b/Changes @@ -410,6 +410,9 @@ Working version use [Backend_var.With_provenance] for variables in binding position. (Mark Shinwell, review by Pierre Chambart) +- GPR#2074: Correct naming of record field inside [Ialloc] terms. + (Mark Shinwell, review by Jérémie Dimino) + - GPR#2076: Add [Targetint.print]. (Mark Shinwell) diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp index 35df30049c49..52f7d3fdeaa5 100644 --- a/asmcomp/amd64/emit.mlp +++ b/asmcomp/amd64/emit.mlp @@ -642,7 +642,7 @@ let emit_instr fallthrough i = | Double | Double_u -> I.movsd (arg i 0) (addressing addr REAL8 i 1) end - | Lop(Ialloc { words = n; label_after_call_gc; spacetime_index; }) -> + | Lop(Ialloc { bytes = n; label_after_call_gc; spacetime_index; }) -> if !fastcode_flag then begin let lbl_redo = new_label() in def_label lbl_redo; diff --git a/asmcomp/arm/emit.mlp b/asmcomp/arm/emit.mlp index 510e95c4dd44..a523fbb9f6b6 100644 --- a/asmcomp/arm/emit.mlp +++ b/asmcomp/arm/emit.mlp @@ -600,7 +600,7 @@ let emit_instr i = | Double_u -> "fstd" | _ (* 32-bit quantities *) -> "str" in ` {emit_string instr} {emit_reg r}, {emit_addressing addr i.arg 1}\n`; 1 - | Lop(Ialloc { words = n; label_after_call_gc; }) -> + | Lop(Ialloc { bytes = n; label_after_call_gc; }) -> let lbl_frame = record_frame_label i.live false i.dbg ?label:label_after_call_gc in diff --git a/asmcomp/arm64/arch.ml b/asmcomp/arm64/arch.ml index 01362a5e63e3..ce5902aa2967 100644 --- a/asmcomp/arm64/arch.ml +++ b/asmcomp/arm64/arch.ml @@ -38,7 +38,7 @@ type cmm_label = int (* Do not introduce a dependency to Cmm *) type specific_operation = - | Ifar_alloc of { words : int; label_after_call_gc : cmm_label option; } + | Ifar_alloc of { bytes : int; label_after_call_gc : cmm_label option; } | Ifar_intop_checkbound of { label_after_error : cmm_label option; } | Ifar_intop_imm_checkbound of { bound : int; label_after_error : cmm_label option; } @@ -107,8 +107,8 @@ let print_addressing printreg addr ppf arg = let print_specific_operation printreg op ppf arg = match op with - | Ifar_alloc { words; label_after_call_gc = _; } -> - fprintf ppf "(far) alloc %i" words + | Ifar_alloc { bytes; label_after_call_gc = _; } -> + fprintf ppf "(far) alloc %i" bytes | Ifar_intop_checkbound _ -> fprintf ppf "%a (far) check > %a" printreg arg.(0) printreg arg.(1) | Ifar_intop_imm_checkbound { bound; _ } -> diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp index 271ca38d7207..8c855b8de81e 100644 --- a/asmcomp/arm64/emit.mlp +++ b/asmcomp/arm64/emit.mlp @@ -445,15 +445,15 @@ module BR = Branch_relaxation.Make (struct | Lop (Iload (size, addr)) | Lop (Istore (size, addr, _)) -> let based = match addr with Iindexed _ -> 0 | Ibased _ -> 1 in based + begin match size with Single -> 2 | _ -> 1 end - | Lop (Ialloc {words = num_words}) when !fastcode_flag -> - if num_words <= 0xFFF then 4 else 5 - | Lop (Ispecific (Ifar_alloc {words = num_words})) when !fastcode_flag -> - if num_words <= 0xFFF then 5 else 6 - | Lop (Ialloc { words = num_words; _ }) - | Lop (Ispecific (Ifar_alloc { words = num_words; _ })) -> - begin match num_words with + | Lop (Ialloc {bytes = num_bytes}) when !fastcode_flag -> + if num_bytes <= 0xFFF then 4 else 5 + | Lop (Ispecific (Ifar_alloc {bytes = num_bytes})) when !fastcode_flag -> + if num_bytes <= 0xFFF then 5 else 6 + | Lop (Ialloc { bytes = num_bytes; _ }) + | Lop (Ispecific (Ifar_alloc { bytes = num_bytes; _ })) -> + begin match num_bytes with | 16 | 24 | 32 -> 1 - | _ -> 1 + num_instructions_for_intconst (Nativeint.of_int num_words) + | _ -> 1 + num_instructions_for_intconst (Nativeint.of_int num_bytes) end | Lop (Iintop (Icomp _)) -> 2 | Lop (Iintop_imm (Icomp _, _)) -> 2 @@ -503,8 +503,8 @@ module BR = Branch_relaxation.Make (struct | Cmm.Raise_notrace -> 4 end - let relax_allocation ~num_words ~label_after_call_gc = - Lop (Ispecific (Ifar_alloc { words = num_words; label_after_call_gc; })) + let relax_allocation ~num_bytes ~label_after_call_gc = + Lop (Ispecific (Ifar_alloc { bytes = num_bytes; label_after_call_gc; })) let relax_intop_checkbound ~label_after_error = Lop (Ispecific (Ifar_intop_checkbound { label_after_error; })) @@ -688,9 +688,9 @@ let emit_instr i = | Word_int | Word_val | Double | Double_u -> ` str {emit_reg src}, {emit_addressing addr base}\n` end - | Lop(Ialloc { words = n; label_after_call_gc; }) -> + | Lop(Ialloc { bytes = n; label_after_call_gc; }) -> assembly_code_for_allocation i ~n ~far:false ?label_after_call_gc - | Lop(Ispecific (Ifar_alloc { words = n; label_after_call_gc; })) -> + | Lop(Ispecific (Ifar_alloc { bytes = n; label_after_call_gc; })) -> assembly_code_for_allocation i ~n ~far:true ?label_after_call_gc | Lop(Iintop(Icomp cmp)) -> ` cmp {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n`; diff --git a/asmcomp/branch_relaxation.ml b/asmcomp/branch_relaxation.ml index 6486d19cbcba..f8f907197094 100644 --- a/asmcomp/branch_relaxation.ml +++ b/asmcomp/branch_relaxation.ml @@ -86,8 +86,8 @@ module Make (T : Branch_relaxation_intf.S) = struct fixup did_fix (pc + T.instr_size instr.desc) instr.next else match instr.desc with - | Lop (Ialloc { words = num_words; label_after_call_gc; }) -> - instr.desc <- T.relax_allocation ~num_words ~label_after_call_gc; + | Lop (Ialloc { bytes = num_bytes; label_after_call_gc; }) -> + instr.desc <- T.relax_allocation ~num_bytes ~label_after_call_gc; fixup true (pc + T.instr_size instr.desc) instr.next | Lop (Iintop (Icheckbound { label_after_error; })) -> instr.desc <- T.relax_intop_checkbound ~label_after_error; diff --git a/asmcomp/branch_relaxation_intf.ml b/asmcomp/branch_relaxation_intf.ml index 3b1fbac5db08..f95ab67dc85e 100644 --- a/asmcomp/branch_relaxation_intf.ml +++ b/asmcomp/branch_relaxation_intf.ml @@ -61,7 +61,7 @@ module type S = sig relaxed generically. It is assumed that these rewrites do not change the size of out-of-line code (cf. branch_relaxation.mli). *) val relax_allocation - : num_words:int + : num_bytes:int -> label_after_call_gc:Cmm.label option -> Linearize.instruction_desc val relax_intop_checkbound diff --git a/asmcomp/comballoc.ml b/asmcomp/comballoc.ml index b4e1b1efda14..ff8db1a30516 100644 --- a/asmcomp/comballoc.ml +++ b/asmcomp/comballoc.ml @@ -32,12 +32,12 @@ let rec combine i allocstate = match i.desc with Iend | Ireturn | Iexit _ | Iraise _ -> (i, allocated_size allocstate) - | Iop(Ialloc { words = sz; _ }) -> + | Iop(Ialloc { bytes = sz; _ }) -> begin match allocstate with No_alloc -> let (newnext, newsz) = combine i.next (Pending_alloc(i.res.(0), sz)) in - (instr_cons_debug (Iop(Ialloc {words = newsz; spacetime_index = 0; + (instr_cons_debug (Iop(Ialloc {bytes = newsz; spacetime_index = 0; label_after_call_gc = None; })) i.arg i.res i.dbg newnext, 0) | Pending_alloc(reg, ofs) -> @@ -49,7 +49,7 @@ let rec combine i allocstate = end else begin let (newnext, newsz) = combine i.next (Pending_alloc(i.res.(0), sz)) in - (instr_cons_debug (Iop(Ialloc { words = newsz; spacetime_index = 0; + (instr_cons_debug (Iop(Ialloc { bytes = newsz; spacetime_index = 0; label_after_call_gc = None; })) i.arg i.res i.dbg newnext, ofs) end diff --git a/asmcomp/i386/emit.mlp b/asmcomp/i386/emit.mlp index 73c98811e241..654b5629a0b8 100644 --- a/asmcomp/i386/emit.mlp +++ b/asmcomp/i386/emit.mlp @@ -630,7 +630,7 @@ let emit_instr fallthrough i = I.fstp (addressing addr REAL8 i 1) end end - | Lop(Ialloc { words = n; label_after_call_gc; }) -> + | Lop(Ialloc { bytes = n; label_after_call_gc; }) -> if !fastcode_flag then begin let lbl_redo = new_label() in def_label lbl_redo; diff --git a/asmcomp/mach.ml b/asmcomp/mach.ml index a03481fcda10..17a5ba7e832d 100644 --- a/asmcomp/mach.ml +++ b/asmcomp/mach.ml @@ -54,7 +54,7 @@ type operation = | Istackoffset of int | Iload of Cmm.memory_chunk * Arch.addressing_mode | Istore of Cmm.memory_chunk * Arch.addressing_mode * bool - | Ialloc of { words : int; label_after_call_gc : label option; + | Ialloc of { bytes : int; label_after_call_gc : label option; spacetime_index : int; } | Iintop of integer_operation | Iintop_imm of integer_operation * int diff --git a/asmcomp/mach.mli b/asmcomp/mach.mli index 8ec960a91127..f32d8604a208 100644 --- a/asmcomp/mach.mli +++ b/asmcomp/mach.mli @@ -62,7 +62,7 @@ type operation = | Iload of Cmm.memory_chunk * Arch.addressing_mode | Istore of Cmm.memory_chunk * Arch.addressing_mode * bool (* false = initialization, true = assignment *) - | Ialloc of { words : int; label_after_call_gc : label option; + | Ialloc of { bytes : int; label_after_call_gc : label option; spacetime_index : int; } (** For Spacetime only, Ialloc instructions take one argument, being the pointer to the trie node for the current function. *) diff --git a/asmcomp/power/arch.ml b/asmcomp/power/arch.ml index 289f33ca3680..70cd75ddb9a0 100644 --- a/asmcomp/power/arch.ml +++ b/asmcomp/power/arch.ml @@ -47,7 +47,7 @@ type specific_operation = Imultaddf (* multiply and add *) | Imultsubf (* multiply and subtract *) | Ialloc_far of (* allocation in large functions *) - { words : int; label_after_call_gc : int (*Cmm.label*) option; } + { bytes : int; label_after_call_gc : int (*Cmm.label*) option; } (* note: we avoid introducing a dependency to Cmm since this dep is not detected when "make depend" is run under amd64 *) @@ -118,5 +118,5 @@ let print_specific_operation printreg op ppf arg = | Imultsubf -> fprintf ppf "%a *f %a -f %a" printreg arg.(0) printreg arg.(1) printreg arg.(2) - | Ialloc_far { words; _ } -> - fprintf ppf "alloc_far %d" words + | Ialloc_far { bytes; _ } -> + fprintf ppf "alloc_far %d" bytes diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index d61fcf574160..f4147c492d0b 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -507,8 +507,8 @@ module BR = Branch_relaxation.Make (struct | Lpoptrap -> 2 | Lraise _ -> 6 - let relax_allocation ~num_words:words ~label_after_call_gc = - Lop (Ispecific (Ialloc_far { words; label_after_call_gc; })) + let relax_allocation ~num_bytes:bytes ~label_after_call_gc = + Lop (Ispecific (Ialloc_far { bytes; label_after_call_gc; })) (* [classify_addr], above, never identifies these instructions as needing relaxing. As such, these functions should never be called. *) @@ -770,7 +770,7 @@ let emit_instr i = | Single -> "stfs" | Double | Double_u -> "stfd" in emit_load_store storeinstr addr i.arg 1 i.arg.(0) - | Lop(Ialloc { words = n; label_after_call_gc; }) -> + | Lop(Ialloc { bytes = n; label_after_call_gc; }) -> if !call_gc_label = 0 then begin match label_after_call_gc with | None -> call_gc_label := new_label () @@ -782,7 +782,7 @@ let emit_instr i = ` bltl {emit_label !call_gc_label}\n`; (* Exactly 4 instructions after the beginning of the alloc sequence *) record_frame i.live false Debuginfo.none - | Lop(Ispecific(Ialloc_far { words = n; label_after_call_gc; })) -> + | Lop(Ispecific(Ialloc_far { bytes = n; label_after_call_gc; })) -> if !call_gc_label = 0 then begin match label_after_call_gc with | None -> call_gc_label := new_label () diff --git a/asmcomp/printmach.ml b/asmcomp/printmach.ml index f5be11c64342..0a0b06a5e103 100644 --- a/asmcomp/printmach.ml +++ b/asmcomp/printmach.ml @@ -143,7 +143,7 @@ let operation op arg ppf res = (Array.sub arg 1 (Array.length arg - 1)) reg arg.(0) (if is_assign then "(assign)" else "(init)") - | Ialloc { words = n; _ } -> + | Ialloc { bytes = n; _ } -> fprintf ppf "alloc %i" n; if Config.spacetime then begin fprintf ppf "(spacetime node = %a)" reg arg.(0) diff --git a/asmcomp/s390x/emit.mlp b/asmcomp/s390x/emit.mlp index 22ae830725f8..f422ad29a905 100644 --- a/asmcomp/s390x/emit.mlp +++ b/asmcomp/s390x/emit.mlp @@ -418,7 +418,7 @@ let emit_instr i = | Double | Double_u -> "stdy" in emit_load_store storeinstr addr i.arg 1 i.arg.(0) - | Lop(Ialloc { words = n; label_after_call_gc; }) -> + | Lop(Ialloc { bytes = n; label_after_call_gc; }) -> let lbl_redo = new_label() in let lbl_call_gc = new_label() in let lbl_frame = diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml index 586a5b869c6c..302cdafd0b77 100644 --- a/asmcomp/selectgen.ml +++ b/asmcomp/selectgen.ml @@ -403,8 +403,8 @@ method mark_instr = function (* Default instruction selection for operators *) -method select_allocation words = - Ialloc { words; spacetime_index = 0; label_after_call_gc = None; } +method select_allocation bytes = + Ialloc { bytes; spacetime_index = 0; label_after_call_gc = None; } method select_allocation_args _env = [| |] method select_checkbound () = @@ -746,12 +746,11 @@ method emit_expr (env:environment) exp = loc_arg (Proc.loc_external_results rd) in self#insert_move_results loc_res rd stack_ofs; Some rd - | Ialloc { words; spacetime_index; label_after_call_gc; } -> - assert (words <= Config.max_young_wosize); + | Ialloc { bytes = _; spacetime_index; label_after_call_gc; } -> let rd = self#regs_for typ_val in - let size = size_expr env (Ctuple new_args) in + let bytes = size_expr env (Ctuple new_args) in let op = - Ialloc { words = size; spacetime_index; label_after_call_gc; } + Ialloc { bytes; spacetime_index; label_after_call_gc; } in let args = self#select_allocation_args env in self#insert_debug (Iop op) dbg args rd; diff --git a/asmcomp/spacetime_profiling.ml b/asmcomp/spacetime_profiling.ml index 51d418a5c809..acabf7c04c50 100644 --- a/asmcomp/spacetime_profiling.ml +++ b/asmcomp/spacetime_profiling.ml @@ -361,7 +361,7 @@ class virtual instruction_selection = object (self) super#emit_blockheader env n dbg end - method! select_allocation words = + method! select_allocation bytes = if self#can_instrument () then begin (* Leave space for a direct call point. We cannot easily insert any instrumentation code, so the fields are filled in instead by @@ -373,12 +373,12 @@ class virtual instruction_selection = object (self) ~label in Mach.Ialloc { - words; + bytes; label_after_call_gc = Some label; spacetime_index = index; } end else begin - super#select_allocation words + super#select_allocation bytes end method! select_allocation_args env =