From 7c5a72a8164bf01d21afe0abd0d9fc06588f344a Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Wed, 18 Oct 2023 10:52:55 +0100 Subject: [PATCH 01/10] misc --- asmcomp/CSEgen.ml | 4 ---- asmcomp/amd64/emit.mlp | 8 -------- asmcomp/arm64/emit.mlp | 8 -------- asmcomp/mach.ml | 4 ---- asmcomp/polling.ml | 7 +------ asmcomp/power/emit.mlp | 8 -------- asmcomp/riscv/emit.mlp | 4 ---- asmcomp/s390x/emit.mlp | 4 ---- asmcomp/selectgen.ml | 22 +--------------------- 9 files changed, 2 insertions(+), 67 deletions(-) diff --git a/asmcomp/CSEgen.ml b/asmcomp/CSEgen.ml index e9b37cb9ac..b539086365 100644 --- a/asmcomp/CSEgen.ml +++ b/asmcomp/CSEgen.ml @@ -236,13 +236,9 @@ method class_of_operation op = | Icompf _ | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf | Ifloatofint | Iintoffloat -> Op_pure | Ispecific _ -> Op_other -<<<<<<< HEAD | Iprobe_is_enabled _ -> Op_other | Ibeginregion | Iendregion -> Op_other -||||||| merged common ancestors -======= | Idls_get -> Op_load Mutable ->>>>>>> ocaml/5.1 (* Operations that are so cheap that it isn't worth factoring them. *) method is_cheap_operation op = diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp index a230ead137..e7e24aeec9 100644 --- a/asmcomp/amd64/emit.mlp +++ b/asmcomp/amd64/emit.mlp @@ -899,7 +899,6 @@ let emit_instr env fallthrough i = I.movsxd (arg32 i 0) (res i 0) | Lop(Ispecific(Izextend32)) -> I.mov (arg32 i 0) (res32 i 0) -<<<<<<< HEAD | Lop(Ibeginregion) -> I.mov (domain_field Domainstate.Domain_local_sp) (res i 0) | Lop(Iendregion) -> @@ -933,11 +932,8 @@ let emit_instr env fallthrough i = I.cmp (int 0) (res16 i 0); I.set (cond (Iunsigned Cne)) (res8 i 0); I.movzx (res8 i 0) (res i 0) -||||||| merged common ancestors -======= | Lop (Idls_get) -> I.mov (domain_field Domainstate.Domain_dls_root) (res i 0) ->>>>>>> ocaml/5.1 | Lreloadretaddr -> () | Lreturn -> @@ -1075,7 +1071,6 @@ let rec emit_all env fallthrough i = let all_functions = ref [] -<<<<<<< HEAD let emit_function_type_and_size fun_name = match system with | S_gnu | S_linux -> @@ -1085,9 +1080,6 @@ let emit_function_type_and_size fun_name = ConstThis, ConstLabel (emit_symbol fun_name))) | _ -> () -||||||| merged common ancestors -======= ->>>>>>> ocaml/5.1 (* Emission of a function declaration *) diff --git a/asmcomp/arm64/emit.mlp b/asmcomp/arm64/emit.mlp index b6b3191df8..3d29224154 100644 --- a/asmcomp/arm64/emit.mlp +++ b/asmcomp/arm64/emit.mlp @@ -514,13 +514,9 @@ module BR = Branch_relaxation.Make (struct | Lop (Ispecific (Ibswap _)) -> 1 | Lop (Ispecific Imove32) -> 1 | Lop (Ispecific (Isignext _)) -> 1 -<<<<<<< HEAD | Lop (Iprobe _ |Iprobe_is_enabled _) -> Misc.fatal_error ("Probes not supported.") -||||||| merged common ancestors -======= | Lop (Idls_get) -> 1 ->>>>>>> ocaml/5.1 | Lreloadretaddr -> 0 | Lreturn -> epilogue_size f | Llabel _ -> 0 @@ -965,15 +961,11 @@ let emit_instr env i = end | Lop(Ispecific(Isignext size)) -> ` sbfm {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, #0, #{emit_int (size - 1)}\n` -<<<<<<< HEAD | Lop (Iprobe _ |Iprobe_is_enabled _) -> Misc.fatal_error ("Probes not supported.") -||||||| merged common ancestors -======= | Lop(Idls_get) -> let offset = Domainstate.(idx_of_field Domain_dls_root) * 8 in ` ldr {emit_reg i.res.(0)}, [{emit_reg reg_domain_state_ptr}, {emit_int offset}]\n` ->>>>>>> ocaml/5.1 | Lreloadretaddr -> () | Lreturn -> diff --git a/asmcomp/mach.ml b/asmcomp/mach.ml index 148a9a9d94..232bb67131 100644 --- a/asmcomp/mach.ml +++ b/asmcomp/mach.ml @@ -67,14 +67,10 @@ type operation = | Iopaque | Ispecific of Arch.specific_operation | Ipoll of { return_label: Cmm.label option } -<<<<<<< HEAD | Iprobe of { name: string; handler_code_sym: string; } | Iprobe_is_enabled of { name: string } | Ibeginregion | Iendregion -||||||| merged common ancestors -======= | Idls_get ->>>>>>> ocaml/5.1 type instruction = { desc: instruction_desc; diff --git a/asmcomp/polling.ml b/asmcomp/polling.ml index 42792a53cc..b21b797bbf 100644 --- a/asmcomp/polling.ml +++ b/asmcomp/polling.ml @@ -259,13 +259,8 @@ let find_poll_alloc_or_calls instr = Iconst_symbol _ | Iextcall { alloc = false } | Istackoffset _ | Iload _ | Istore _ | Iintop _ | Iintop_imm _ | Ifloatofint | Iintoffloat | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf | -<<<<<<< HEAD - Iopaque | Ispecific _ | + Iopaque | Ispecific _ | Idls_get | Icompf _ Ibeginregion | Iendregion | Iprobe _ | Iprobe_is_enabled _) -> None -||||||| merged common ancestors -======= - Iopaque | Ispecific _ | Idls_get | Icompf _) -> None ->>>>>>> ocaml/5.1 | Iend | Ireturn | Iifthenelse _ | Iswitch _ | Icatch _ | Iexit _ | Itrywith _ | Iraise _ -> None in diff --git a/asmcomp/power/emit.mlp b/asmcomp/power/emit.mlp index a209e9ad4e..e0e1d2778a 100644 --- a/asmcomp/power/emit.mlp +++ b/asmcomp/power/emit.mlp @@ -512,15 +512,11 @@ module BR = Branch_relaxation.Make (struct | Lop(Iintoffloat) -> 4 | Lop(Iopaque) -> 0 | Lop(Ispecific _) -> 1 -<<<<<<< HEAD | Lop (Iprobe _ |Iprobe_is_enabled _) -> Misc.fatal_error ("Probes not supported.") -||||||| merged common ancestors -======= | Lop (Idls_get) -> (* Here to maintain build *) assert false ->>>>>>> ocaml/5.1 | Lreloadretaddr -> 2 | Lreturn -> 2 | Llabel _ -> 0 @@ -937,15 +933,11 @@ let emit_instr env i = | Lop(Ispecific sop) -> let instr = name_for_specific sop in ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n` -<<<<<<< HEAD | Lop (Iprobe _ |Iprobe_is_enabled _) -> Misc.fatal_error ("Probes not supported.") -||||||| merged common ancestors -======= | Lop (Idls_get) -> (* Here to maintain build *) assert false ->>>>>>> ocaml/5.1 | Lreloadretaddr -> ` {emit_string lg} 11, {emit_int(retaddr_offset env)}(1)\n`; ` mtlr 11\n` diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp index 6d45a9708e..8a2afd6e3f 100644 --- a/asmcomp/riscv/emit.mlp +++ b/asmcomp/riscv/emit.mlp @@ -541,15 +541,11 @@ let emit_instr env i = | Lop(Ispecific sop) -> let instr = name_for_specific sop in ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}, {emit_reg i.arg.(2)}\n` -<<<<<<< HEAD | Lop (Iprobe _ |Iprobe_is_enabled _) -> Misc.fatal_error ("Probes not supported.") -||||||| merged common ancestors -======= | Lop (Idls_get) -> let ofs = Domainstate.(idx_of_field Domain_dls_root) * 8 in ` ld {emit_reg i.res.(0)}, {emit_int ofs}({emit_reg reg_domain_state_ptr})\n` ->>>>>>> ocaml/5.1 | Lreloadretaddr -> let n = frame_size env in reload_ra n diff --git a/asmcomp/s390x/emit.mlp b/asmcomp/s390x/emit.mlp index 9ec4721ec0..b1a4bcdaec 100644 --- a/asmcomp/s390x/emit.mlp +++ b/asmcomp/s390x/emit.mlp @@ -631,15 +631,11 @@ let emit_instr env i = assert (i.arg.(2).loc = i.res.(0).loc); let instr = name_for_specific sop in ` {emit_string instr} {emit_reg i.res.(0)}, {emit_reg i.arg.(0)}, {emit_reg i.arg.(1)}\n` -<<<<<<< HEAD | Lop (Iprobe _ |Iprobe_is_enabled _) -> Misc.fatal_error ("Probes not supported.") -||||||| merged common ancestors -======= | Lop (Idls_get) -> let ofs = Domainstate.(idx_of_field Domain_dls_root) * 8 in ` lg {emit_reg i.res.(0)}, {emit_int ofs}(%r10)\n` ->>>>>>> ocaml/5.1 | Lreloadretaddr -> let n = frame_size env in ` lg %r14, {emit_int(n - size_addr)}(%r15)\n` diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml index e0ab2875be..bc36a54c26 100644 --- a/asmcomp/selectgen.ml +++ b/asmcomp/selectgen.ml @@ -386,14 +386,8 @@ method is_simple_expr = function | Cload _ | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi | Cand | Cor | Cxor | Clsl | Clsr | Casr | Ccmpi _ | Caddv | Cadda | Ccmpa _ | Cnegf | Cabsf | Caddf | Csubf | Cmulf | Cdivf | Cfloatofint | Cintoffloat -<<<<<<< HEAD - | Ccmpf _ -> List.for_all self#is_simple_expr args -||||||| merged common ancestors - | Ccmpf _ | Ccheckbound -> List.for_all self#is_simple_expr args -======= | Ccmpf _ | Ccheckbound | Cdls_get -> List.for_all self#is_simple_expr args ->>>>>>> ocaml/5.1 end | Cassign _ | Cifthenelse _ | Cswitch _ | Ccatch _ | Cexit _ | Ctrywith _ | Cregion _ | Cexclave _ -> false @@ -433,18 +427,10 @@ method effects_of exp = | Cstore _ -> EC.effect_only Effect.Arbitrary | Cbeginregion | Cendregion -> EC.arbitrary | Craise _ | Ccheckbound -> EC.effect_only Effect.Raise -<<<<<<< HEAD - | Cload (_, Asttypes.Immutable) -> EC.none - | Cload (_, Asttypes.Mutable) -> EC.coeffect_only Coeffect.Read_mutable - | Cprobe_is_enabled _ -> EC.coeffect_only Coeffect.Arbitrary -||||||| merged common ancestors - | Cload (_, Asttypes.Immutable) -> EC.none - | Cload (_, Asttypes.Mutable) -> EC.coeffect_only Coeffect.Read_mutable -======= | Cload {mutability = Asttypes.Immutable} -> EC.none | Cload {mutability = Asttypes.Mutable} | Cdls_get -> EC.coeffect_only Coeffect.Read_mutable ->>>>>>> ocaml/5.1 + | Cprobe_is_enabled _ -> EC.coeffect_only Coeffect.Arbitrary | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi | Cand | Cor | Cxor | Clsl | Clsr | Casr | Ccmpi _ | Caddv | Cadda | Ccmpa _ | Cnegf | Cabsf | Caddf | Csubf | Cmulf | Cdivf | Cfloatofint | Cintoffloat | Ccmpf _ -> @@ -539,14 +525,8 @@ method select_operation op args _dbg = (Istore(chunk, addr, is_assign), [arg2; eloc]) (* Inversion addr/datum in Istore *) end -<<<<<<< HEAD | (Calloc mode, _) -> (Ialloc {bytes = 0; dbginfo = []; mode}), args -||||||| merged common ancestors - | (Calloc, _) -> (Ialloc {bytes = 0; dbginfo = []}), args -======= | (Cdls_get, _) -> Idls_get, args - | (Calloc, _) -> (Ialloc {bytes = 0; dbginfo = []}), args ->>>>>>> ocaml/5.1 | (Caddi, _) -> self#select_arith_comm Iadd args | (Csubi, _) -> self#select_arith Isub args | (Cmuli, _) -> self#select_arith_comm Imul args From 5144e9bb7a77153e27b3de650817bb5867b9ca0e Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Wed, 18 Oct 2023 11:07:00 +0100 Subject: [PATCH 02/10] misc --- asmcomp/asmpackager.ml | 12 ------------ asmcomp/selectgen.ml | 18 ------------------ 2 files changed, 30 deletions(-) diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml index 39d43dd9a8..5eb266d289 100644 --- a/asmcomp/asmpackager.ml +++ b/asmcomp/asmpackager.ml @@ -50,21 +50,9 @@ let read_member_info pack_path file = ( PM_intf else begin let (info, crc) = Compilenv.read_unit_info file in -<<<<<<< HEAD if not (CU.Name.equal (CU.name info.ui_unit) name) then raise(Error(Illegal_renaming(name, file, (CU.name info.ui_unit)))); if not (CU.is_parent pack_path ~child:info.ui_unit) -||||||| merged common ancestors - if info.ui_name <> name - then raise(Error(Illegal_renaming(name, file, info.ui_name))); - if info.ui_symbol <> - (Compilenv.current_unit_infos()).ui_symbol ^ "__" ^ info.ui_name -======= - if info.ui_name <> name - then raise(Error(Illegal_renaming(name, file, info.ui_name))); - if info.ui_symbol <> - (Compilenv.current_unit_infos()).ui_symbol ^ "." ^ info.ui_name ->>>>>>> ocaml/5.1 then raise(Error(Wrong_for_pack(file, pack_path))); Asmlink.check_consistency file info crc; Compilenv.cache_unit_info info; diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml index bc36a54c26..8b62695379 100644 --- a/asmcomp/selectgen.ml +++ b/asmcomp/selectgen.ml @@ -773,22 +773,12 @@ method emit_expr_aux (env:environment) exp : self#insert_debug env (Iraise k) dbg rd [||]; None end -<<<<<<< HEAD | Cop(Ccmpf _, _, dbg) -> self#emit_expr_aux env (Cifthenelse (exp, dbg, Cconst_int (1, dbg), dbg, Cconst_int (0, dbg), dbg, Any)) -||||||| merged common ancestors - | Cop(Ccmpf _, _, dbg) -> - self#emit_expr env - (Cifthenelse (exp, - dbg, Cconst_int (1, dbg), - dbg, Cconst_int (0, dbg), - dbg)) -======= ->>>>>>> ocaml/5.1 | Cop(Copaque, args, dbg) -> begin match self#emit_parts_list env args with None -> None @@ -831,16 +821,8 @@ method emit_expr_aux (env:environment) exp : self#insert_move_args env r1 loc_arg stack_ofs; self#insert_debug env (Iop new_op) dbg loc_arg loc_res; self#insert_move_results env loc_res rd stack_ofs; -<<<<<<< HEAD Some (rd, unclosed_regions) | Iextcall { ty_args; _} -> -||||||| merged common ancestors - Some rd - | Iextcall { ty_args; _} -> -======= - Some rd - | Iextcall r -> ->>>>>>> ocaml/5.1 let (loc_arg, stack_ofs) = self#emit_extcall_args env r.ty_args new_args in let rd = self#regs_for ty in From c7590a3115aa19a14aa1f6529ba372a3ac1b73be Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Wed, 18 Oct 2023 13:03:52 +0100 Subject: [PATCH 03/10] misc --- asmcomp/amd64/emit.mlp | 30 +------------------------- asmcomp/asmlink.ml | 47 ---------------------------------------- asmcomp/riscv/emit.mlp | 49 ------------------------------------------ asmcomp/s390x/emit.mlp | 43 ++---------------------------------- 4 files changed, 3 insertions(+), 166 deletions(-) diff --git a/asmcomp/amd64/emit.mlp b/asmcomp/amd64/emit.mlp index e7e24aeec9..7ea8410f05 100644 --- a/asmcomp/amd64/emit.mlp +++ b/asmcomp/amd64/emit.mlp @@ -691,28 +691,8 @@ let emit_instr env fallthrough i = cfi_restore_state (); end | Lop(Istackoffset n) -> -<<<<<<< HEAD emit_stack_offset env n - | Lop(Iload(chunk, addr, _mut)) -> -||||||| merged common ancestors - if n < 0 - then I.add (int (-n)) rsp - else if n > 0 - then I.sub (int n) rsp; - if n <> 0 - then cfi_adjust_cfa_offset n; - env.stack_offset <- env.stack_offset + n - | Lop(Iload(chunk, addr, _mut)) -> -======= - if n < 0 - then I.add (int (-n)) rsp - else if n > 0 - then I.sub (int n) rsp; - if n <> 0 - then cfi_adjust_cfa_offset n; - env.stack_offset <- env.stack_offset + n | Lop(Iload { memory_chunk; addressing_mode; _ }) -> ->>>>>>> ocaml/5.1 let dest = res i 0 in begin match memory_chunk with | Word_int | Word_val -> @@ -1535,16 +1515,8 @@ let end_assembly() = efa_string = (fun s -> D.bytes (s ^ "\000")) }; -<<<<<<< HEAD - if system = S_linux then begin - let frametable = emit_symbol (Cmm_helpers.make_symbol "frametable") in -||||||| merged common ancestors - if system = S_linux then begin - let frametable = emit_symbol (Compilenv.make_symbol (Some "frametable")) in -======= if system = S_linux || system = S_freebsd || system = S_netbsd || system = S_openbsd then begin - let frametable = emit_symbol (Compilenv.make_symbol (Some "frametable")) in ->>>>>>> ocaml/5.1 + let frametable = emit_symbol (Cmm_helpers.make_symbol "frametable") in D.size frametable (ConstSub (ConstThis, ConstLabel frametable)) end; diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml index be91b4b2be..a0d0d34cfc 100644 --- a/asmcomp/asmlink.ml +++ b/asmcomp/asmlink.ml @@ -49,40 +49,18 @@ let cmx_required = ref ([] : CU.t list) let check_consistency file_name unit crc = begin try -<<<<<<< HEAD Array.iter (fun import -> let name = Import_info.name import in let crco = Import_info.crc_with_unit import in -||||||| merged common ancestors - List.iter - (fun (name, crco) -> -======= - let source = List.assoc unit.ui_name !implementations_defined in - raise (Error(Multiple_definition(unit.ui_name, file_name, source))) - with Not_found -> () - end; - begin try - List.iter - (fun (name, crco) -> ->>>>>>> ocaml/5.1 interfaces := name :: !interfaces; match crco with None -> () -<<<<<<< HEAD | Some (full_name, crc) -> if CU.Name.equal name (CU.name unit.ui_unit) then Cmi_consistbl.set crc_interfaces name full_name crc file_name else Cmi_consistbl.check crc_interfaces name full_name crc file_name) -||||||| merged common ancestors - | Some crc -> - if name = unit.ui_name - then Cmi_consistbl.set crc_interfaces name crc file_name - else Cmi_consistbl.check crc_interfaces name crc file_name) -======= - | Some crc -> Cmi_consistbl.check crc_interfaces name crc file_name) ->>>>>>> ocaml/5.1 unit.ui_imports_cmi with Cmi_consistbl.Inconsistency { unit_name = name; @@ -111,7 +89,6 @@ let check_consistency file_name unit crc = } -> raise(Error(Inconsistent_implementation(name, user, auth))) end; -<<<<<<< HEAD let ui_name = CU.name unit.ui_unit in begin try let source = List.assoc unit.ui_unit !implementations_defined in @@ -120,18 +97,6 @@ let check_consistency file_name unit crc = end; implementations := unit.ui_unit :: !implementations; Cmx_consistbl.set crc_implementations unit.ui_unit () crc file_name; -||||||| merged common ancestors - begin try - let source = List.assoc unit.ui_name !implementations_defined in - raise (Error(Multiple_definition(unit.ui_name, file_name, source))) - with Not_found -> () - end; - implementations := unit.ui_name :: !implementations; - Cmx_consistbl.set crc_implementations unit.ui_name crc file_name; -======= - implementations := unit.ui_name :: !implementations; - Cmx_consistbl.check crc_implementations unit.ui_name crc file_name; ->>>>>>> ocaml/5.1 implementations_defined := (unit.ui_unit, file_name) :: !implementations_defined; if CU.is_packed unit.ui_unit then @@ -309,13 +274,7 @@ let make_startup_file ~ppf_dump units_list ~crc_interfaces = compile_phrase (Cmm_helpers.entry_point name_list); let units = List.map (fun (info,_,_) -> info) units_list in List.iter compile_phrase -<<<<<<< HEAD - (Cmm_helpers.emit_preallocated_blocks [] -||||||| merged common ancestors - List.iter compile_phrase (Cmm_helpers.generic_functions false units); -======= (Cmm_helpers.emit_preallocated_blocks [] (* add gc_roots (for dynlink) *) ->>>>>>> ocaml/5.1 (Cmm_helpers.generic_functions false units)); Array.iteri (fun i name -> compile_phrase (Cmm_helpers.predef_exception i name)) @@ -352,13 +311,7 @@ let make_shared_startup_file ~ppf_dump units = Compilenv.reset shared_startup_comp_unit; Emit.begin_assembly (); List.iter compile_phrase -<<<<<<< HEAD - (Cmm_helpers.emit_preallocated_blocks [] -||||||| merged common ancestors - (Cmm_helpers.generic_functions true (List.map fst units)); -======= (Cmm_helpers.emit_preallocated_blocks [] (* add gc_roots (for dynlink) *) ->>>>>>> ocaml/5.1 (Cmm_helpers.generic_functions true (List.map fst units))); compile_phrase (Cmm_helpers.plugin_header units); compile_phrase diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp index 8a2afd6e3f..ea8bef06fa 100644 --- a/asmcomp/riscv/emit.mlp +++ b/asmcomp/riscv/emit.mlp @@ -397,47 +397,6 @@ let emit_instr env i = ` {emit_string instr} {emit_reg i.arg.(0)}, {emit_int ofs}({emit_reg i.arg.(1)})\n` | Lop(Ialloc {bytes; dbginfo; mode = Alloc_heap}) -> let lbl_frame_lbl = record_frame_label env i.live (Dbg_alloc dbginfo) in -<<<<<<< HEAD - let lbl_after_alloc = new_label () in - let lbl_call_gc = new_label () in - let n = -bytes in - let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in - if is_immediate n then - ` addi {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, {emit_int n}\n` - else begin - ` li {emit_reg reg_tmp}, {emit_int n}\n`; - ` add {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}\n` - end; - ` ld {emit_reg reg_tmp}, {emit_int offset}({emit_reg reg_domain_state_ptr})\n`; - ` bltu {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}, {emit_label lbl_call_gc}\n`; - `{emit_label lbl_after_alloc}:\n`; - ` addi {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, {emit_int size_addr}\n`; - env.call_gc_sites <- - { gc_lbl = lbl_call_gc; - gc_return_lbl = lbl_after_alloc; - gc_frame_lbl = lbl_frame_lbl } :: env.call_gc_sites - | Lop(Ialloc { mode = Alloc_local } | Ibeginregion | Iendregion) -> - Misc.fatal_error "Local allocations not supported on this architecture" -||||||| merged common ancestors - let lbl_after_alloc = new_label () in - let lbl_call_gc = new_label () in - let n = -bytes in - let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in - if is_immediate n then - ` addi {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, {emit_int n}\n` - else begin - ` li {emit_reg reg_tmp}, {emit_int n}\n`; - ` add {emit_reg reg_alloc_ptr}, {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}\n` - end; - ` ld {emit_reg reg_tmp}, {emit_int offset}({emit_reg reg_domain_state_ptr})\n`; - ` bltu {emit_reg reg_alloc_ptr}, {emit_reg reg_tmp}, {emit_label lbl_call_gc}\n`; - `{emit_label lbl_after_alloc}:\n`; - ` addi {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, {emit_int size_addr}\n`; - env.call_gc_sites <- - { gc_lbl = lbl_call_gc; - gc_return_lbl = lbl_after_alloc; - gc_frame_lbl = lbl_frame_lbl } :: env.call_gc_sites -======= if env.f.fun_fast then begin let lbl_after_alloc = new_label () in let lbl_call_gc = new_label () in @@ -464,7 +423,6 @@ let emit_instr env i = `{emit_label lbl_frame_lbl}:\n`; ` addi {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, 8\n` end ->>>>>>> ocaml/5.1 | Lop(Ipoll { return_label }) -> let lbl_frame_lbl = record_frame_label env i.live (Dbg_alloc []) in let lbl_after_poll = match return_label with @@ -787,14 +745,7 @@ let end_assembly() = ` .quad 0\n`; (* Emit the frame descriptors *) ` {emit_string data_space}\n`; (* not rodata because relocations inside *) -<<<<<<< HEAD - let lbl = Cmm_helpers.make_symbol "frametable" in -||||||| merged common ancestors - ` {emit_string rodata_space}\n`; - let lbl = Compilenv.make_symbol (Some "frametable") in -======= let lbl = Compilenv.make_symbol (Some "frametable") in ->>>>>>> ocaml/5.1 declare_global_data lbl; `{emit_symbol lbl}:\n`; emit_frames diff --git a/asmcomp/s390x/emit.mlp b/asmcomp/s390x/emit.mlp index b1a4bcdaec..351528efd1 100644 --- a/asmcomp/s390x/emit.mlp +++ b/asmcomp/s390x/emit.mlp @@ -425,46 +425,7 @@ let emit_instr env i = | Single -> assert false | Double -> "stdy" in emit_load_store storeinstr addr i.arg 1 i.arg.(0) - -<<<<<<< HEAD | Lop(Ialloc { bytes = n; dbginfo; mode = Alloc_heap }) -> - let lbl_after_alloc = new_label() in - let lbl_call_gc = new_label() in - let lbl_frame = - record_frame_label env i.live (Dbg_alloc dbginfo) - in - env.call_gc_sites <- - { gc_lbl = lbl_call_gc; - gc_return_lbl = lbl_after_alloc; - gc_frame_lbl = lbl_frame; } :: env.call_gc_sites; - ` lay %r11, {emit_int(-n)}(%r11)\n`; - let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in - ` clg %r11, {emit_int offset}(%r10)\n`; - ` brcl 4, {emit_label lbl_call_gc}\n`; (* less than *) - `{emit_label lbl_after_alloc}:`; - ` la {emit_reg i.res.(0)}, 8(%r11)\n` - - | Lop(Ialloc { mode = Alloc_local } | Ibeginregion | Iendregion) -> - Misc.fatal_error "Local allocations not supported on this architecture" -||||||| merged common ancestors - | Lop(Ialloc { bytes = n; dbginfo }) -> - let lbl_after_alloc = new_label() in - let lbl_call_gc = new_label() in - let lbl_frame = - record_frame_label env i.live (Dbg_alloc dbginfo) - in - env.call_gc_sites <- - { gc_lbl = lbl_call_gc; - gc_return_lbl = lbl_after_alloc; - gc_frame_lbl = lbl_frame; } :: env.call_gc_sites; - ` lay %r11, {emit_int(-n)}(%r11)\n`; - let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in - ` clg %r11, {emit_int offset}(%r10)\n`; - ` brcl 4, {emit_label lbl_call_gc}\n`; (* less than *) - `{emit_label lbl_after_alloc}:`; - ` la {emit_reg i.res.(0)}, 8(%r11)\n` -======= - | Lop(Ialloc { bytes = n; dbginfo }) -> let lbl_frame_lbl = record_frame_label env i.live (Dbg_alloc dbginfo) in if env.f.fun_fast then begin let lbl_after_alloc = new_label () in @@ -491,8 +452,8 @@ let emit_instr env i = `{emit_label lbl_frame_lbl}:\n`; ` la {emit_reg i.res.(0)}, 8(%r11)\n` end ->>>>>>> ocaml/5.1 - + | Lop(Ialloc { mode = Alloc_local } | Ibeginregion | Iendregion) -> + Misc.fatal_error "Local allocations not supported on this architecture" | Lop(Ipoll { return_label }) -> let offset = Domainstate.(idx_of_field Domain_young_limit) * 8 in ` clg %r11, {emit_int offset}(%r10)\n`; From 778e99dee7ae614e86032a9157bff7fe63199079 Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Thu, 19 Oct 2023 15:52:59 +0100 Subject: [PATCH 04/10] fixes --- asmcomp/polling.ml | 2 +- asmcomp/selectgen.ml | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/asmcomp/polling.ml b/asmcomp/polling.ml index b21b797bbf..d2fb79b7af 100644 --- a/asmcomp/polling.ml +++ b/asmcomp/polling.ml @@ -259,7 +259,7 @@ let find_poll_alloc_or_calls instr = Iconst_symbol _ | Iextcall { alloc = false } | Istackoffset _ | Iload _ | Istore _ | Iintop _ | Iintop_imm _ | Ifloatofint | Iintoffloat | Inegf | Iabsf | Iaddf | Isubf | Imulf | Idivf | - Iopaque | Ispecific _ | Idls_get | Icompf _ + Iopaque | Ispecific _ | Idls_get | Icompf _ | Ibeginregion | Iendregion | Iprobe _ | Iprobe_is_enabled _) -> None | Iend | Ireturn | Iifthenelse _ | Iswitch _ | Icatch _ | Iexit _ | Itrywith _ | Iraise _ -> None diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml index 8b62695379..77c3fd7ec2 100644 --- a/asmcomp/selectgen.ml +++ b/asmcomp/selectgen.ml @@ -386,7 +386,7 @@ method is_simple_expr = function | Cload _ | Caddi | Csubi | Cmuli | Cmulhi | Cdivi | Cmodi | Cand | Cor | Cxor | Clsl | Clsr | Casr | Ccmpi _ | Caddv | Cadda | Ccmpa _ | Cnegf | Cabsf | Caddf | Csubf | Cmulf | Cdivf | Cfloatofint | Cintoffloat - | Ccmpf _ | Ccheckbound | Cdls_get -> + | Ccmpf _ | Cdls_get -> List.for_all self#is_simple_expr args end | Cassign _ | Cifthenelse _ | Cswitch _ | Ccatch _ | Cexit _ @@ -822,7 +822,7 @@ method emit_expr_aux (env:environment) exp : self#insert_debug env (Iop new_op) dbg loc_arg loc_res; self#insert_move_results env loc_res rd stack_ofs; Some (rd, unclosed_regions) - | Iextcall { ty_args; _} -> + | Iextcall r -> let (loc_arg, stack_ofs) = self#emit_extcall_args env r.ty_args new_args in let rd = self#regs_for ty in From a7b6b07f2b40117c2b7e5551d7c96e5fc902f1b8 Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Thu, 19 Oct 2023 16:04:57 +0100 Subject: [PATCH 05/10] set -> check --- asmcomp/asmlink.ml | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml index a0d0d34cfc..49d083cffa 100644 --- a/asmcomp/asmlink.ml +++ b/asmcomp/asmlink.ml @@ -57,10 +57,7 @@ let check_consistency file_name unit crc = match crco with None -> () | Some (full_name, crc) -> - if CU.Name.equal name (CU.name unit.ui_unit) - then Cmi_consistbl.set crc_interfaces name full_name crc file_name - else - Cmi_consistbl.check crc_interfaces name full_name crc file_name) + Cmi_consistbl.check crc_interfaces name full_name crc file_name) unit.ui_imports_cmi with Cmi_consistbl.Inconsistency { unit_name = name; @@ -96,7 +93,7 @@ let check_consistency file_name unit crc = with Not_found -> () end; implementations := unit.ui_unit :: !implementations; - Cmx_consistbl.set crc_implementations unit.ui_unit () crc file_name; + Cmx_consistbl.check crc_implementations unit.ui_unit () crc file_name; implementations_defined := (unit.ui_unit, file_name) :: !implementations_defined; if CU.is_packed unit.ui_unit then From 64837fbe60fce80ea22a810b84516aa223446530 Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Fri, 20 Oct 2023 13:55:22 +0100 Subject: [PATCH 06/10] update script --- jane/build-resolved-files-for-ci | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/jane/build-resolved-files-for-ci b/jane/build-resolved-files-for-ci index c88aabb8af..9fdeed0bbe 100755 --- a/jane/build-resolved-files-for-ci +++ b/jane/build-resolved-files-for-ci @@ -130,9 +130,10 @@ dune_targets=$( # ocamloptcomp mls mls=$( { echo middle_end/{,closure,flambda}/*.ml - echo asmcomp/*cmm*.ml + echo asmcomp/*.ml } | - tr ' ' '\n' + tr ' ' '\n' | + grep -v "asmcomp/CSEgen.ml" ) echo "$mls" dune_targets=$( From 7aa5dd35aedb18393ba7928d6b0b5f4f48606b18 Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Fri, 20 Oct 2023 17:52:00 +0100 Subject: [PATCH 07/10] Update asmcomp/riscv/emit.mlp Co-authored-by: Greta Yorsh <45005955+gretay-js@users.noreply.github.com> --- asmcomp/riscv/emit.mlp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp index ea8bef06fa..6a8707b518 100644 --- a/asmcomp/riscv/emit.mlp +++ b/asmcomp/riscv/emit.mlp @@ -745,7 +745,7 @@ let end_assembly() = ` .quad 0\n`; (* Emit the frame descriptors *) ` {emit_string data_space}\n`; (* not rodata because relocations inside *) - let lbl = Compilenv.make_symbol (Some "frametable") in + let lbl = Cmm_helpers.make_symbol "frametable" in declare_global_data lbl; `{emit_symbol lbl}:\n`; emit_frames From 667c49fb8e63ed43a6c688866f75dec3a9dae43a Mon Sep 17 00:00:00 2001 From: Xavier Clerc Date: Fri, 20 Oct 2023 17:52:17 +0100 Subject: [PATCH 08/10] Update asmcomp/riscv/emit.mlp Co-authored-by: Greta Yorsh <45005955+gretay-js@users.noreply.github.com> --- asmcomp/riscv/emit.mlp | 2 ++ 1 file changed, 2 insertions(+) diff --git a/asmcomp/riscv/emit.mlp b/asmcomp/riscv/emit.mlp index 6a8707b518..c40096dd8f 100644 --- a/asmcomp/riscv/emit.mlp +++ b/asmcomp/riscv/emit.mlp @@ -423,6 +423,8 @@ let emit_instr env i = `{emit_label lbl_frame_lbl}:\n`; ` addi {emit_reg i.res.(0)}, {emit_reg reg_alloc_ptr}, 8\n` end + | Lop(Ialloc { mode = Alloc_local } | Ibeginregion | Iendregion) -> + Misc.fatal_error "Local allocations not supported on this architecture" | Lop(Ipoll { return_label }) -> let lbl_frame_lbl = record_frame_label env i.live (Dbg_alloc []) in let lbl_after_poll = match return_label with From 6087e5c1574983af6d3817bdecadbb7efd1d0cee Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Mon, 23 Oct 2023 15:38:31 +0100 Subject: [PATCH 09/10] Move check up --- asmcomp/asmlink.ml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml index 49d083cffa..18472c5dfc 100644 --- a/asmcomp/asmlink.ml +++ b/asmcomp/asmlink.ml @@ -48,6 +48,12 @@ let implementations_defined = ref ([] : (CU.t * string) list) let cmx_required = ref ([] : CU.t list) let check_consistency file_name unit crc = + let ui_name = CU.name unit.ui_unit in + begin try + let source = List.assoc unit.ui_unit !implementations_defined in + raise (Error(Multiple_definition(ui_name, file_name, source))) + with Not_found -> () + end; begin try Array.iter (fun import -> @@ -86,12 +92,6 @@ let check_consistency file_name unit crc = } -> raise(Error(Inconsistent_implementation(name, user, auth))) end; - let ui_name = CU.name unit.ui_unit in - begin try - let source = List.assoc unit.ui_unit !implementations_defined in - raise (Error(Multiple_definition(ui_name, file_name, source))) - with Not_found -> () - end; implementations := unit.ui_unit :: !implementations; Cmx_consistbl.check crc_implementations unit.ui_unit () crc file_name; implementations_defined := From b99c84479bae4b9b85fa11dfa383bd3460fff931 Mon Sep 17 00:00:00 2001 From: Mark Shinwell Date: Mon, 23 Oct 2023 15:43:58 +0100 Subject: [PATCH 10/10] build script fix --- jane/build-resolved-files-for-ci | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/jane/build-resolved-files-for-ci b/jane/build-resolved-files-for-ci index 9fdeed0bbe..c839ab3bed 100755 --- a/jane/build-resolved-files-for-ci +++ b/jane/build-resolved-files-for-ci @@ -133,7 +133,7 @@ mls=$( echo asmcomp/*.ml } | tr ' ' '\n' | - grep -v "asmcomp/CSEgen.ml" + sed "s/CSEgen/cSEgen/" ) echo "$mls" dune_targets=$(