Merge flambda-backend changes

Author: mshinwell

.depend

@@ -178,6 +178,9 @@ install_for_test: _install
 	 # replace backend-specific testsuite/tools with their new versions
 	rm _runtest/testsuite/tools/*
 	cp -a testsuite/tools/* _runtest/testsuite/tools/
+	 # replace backend-specific testsuite/tests/asmcomp with their new versions
+	rm _runtest/testsuite/tests/asmcomp/*
+	cp -a testsuite/tests/asmcomp/* _runtest/testsuite/tests/asmcomp/
 	 # replace backend-specific testsuite/tests/asmgen with their new versions
 	rm _runtest/testsuite/tests/asmgen/*
 	cp -a testsuite/tests/asmgen/* _runtest/testsuite/tests/asmgen/

Makefile.common-jst

@@ -252,6 +252,7 @@ STDLIB_MANPAGES=@stdlib_manpages@
 NAKED_POINTERS=@naked_pointers@
 INTEL_JCC_BUG_CFLAGS=@intel_jcc_bug_cflags@
 STACK_ALLOCATION=@stack_allocation@
+POLL_INSERTION=@poll_insertion@
 DUNE=@dune@
 
 ### Native command to build ocamlrun.exe

Makefile.config.in

@@ -65,7 +65,7 @@ let linear_unit_info =
 let reset () =
   start_from_emit := false;
   if should_save_before_emit () then begin
-    linear_unit_info.unit <- Compilation_unit.get_current_exn ();
+    linear_unit_info.unit <- Compilation_unit.get_current_or_dummy ();
     linear_unit_info.items <- [];
   end
 
@@ -272,7 +272,8 @@ let compile_implementation ?toplevel ~backend ~prefixname ~middle_end
     ~asm_filename:(asm_filename prefixname) ~keep_asm:!keep_asm_file
     ~obj_filename:(prefixname ^ ext_obj)
     (fun () ->
-      Ident.Set.iter Compilenv.require_global program.required_globals;
+      Compilation_unit.Set.iter Compilenv.require_global
+        program.required_globals;
       let clambda_with_constants =
         middle_end ~backend ~prefixname ~ppf_dump program
       in

asmcomp/asmgen.ml

@@ -25,40 +25,40 @@ module CU = Compilation_unit
 type error =
   | File_not_found of filepath
   | Not_an_object_file of filepath
-  | Missing_implementations of (Linkage_name.t * string list) list
+  | Missing_implementations of (CU.t * string list) list
   | Inconsistent_interface of CU.Name.t * filepath * filepath
-  | Inconsistent_implementation of CU.Name.t * filepath * filepath
+  | Inconsistent_implementation of CU.t * filepath * filepath
   | Assembler_error of filepath
   | Linking_error of int
   | Multiple_definition of CU.Name.t * filepath * filepath
-  | Missing_cmx of filepath * CU.Name.t
+  | Missing_cmx of filepath * CU.t
 
 exception Error of error
 
 (* Consistency check between interfaces and implementations *)
 
-module Cmi_consistbl = Consistbl.Make (CU.Name)
+module Cmi_consistbl = Consistbl.Make (CU.Name) (CU)
 let crc_interfaces = Cmi_consistbl.create ()
 let interfaces = ref ([] : CU.Name.t list)
 
-module Cmx_consistbl = Consistbl.Make (CU.Name)
+module Cmx_consistbl = Consistbl.Make (CU) (Unit)
 let crc_implementations = Cmx_consistbl.create ()
-let implementations = ref ([] : CU.Name.t list)
-let implementations_defined = ref ([] : (CU.Name.t * string) list)
-let cmx_required = ref ([] : CU.Name.t list)
+let implementations = ref ([] : CU.t list)
+let implementations_defined = ref ([] : (CU.t * string) list)
+let cmx_required = ref ([] : CU.t list)
 
 let check_consistency file_name unit crc =
   begin try
     List.iter
       (fun (name, crco) ->
-        let name = CU.Name.of_string name in
         interfaces := name :: !interfaces;
         match crco with
           None -> ()
-        | Some crc ->
+        | Some (full_name, crc) ->
             if CU.Name.equal name (CU.name unit.ui_unit)
-            then Cmi_consistbl.set crc_interfaces name crc file_name
-            else Cmi_consistbl.check crc_interfaces name crc file_name)
+            then Cmi_consistbl.set crc_interfaces name full_name crc file_name
+            else
+              Cmi_consistbl.check crc_interfaces name full_name crc file_name)
       unit.ui_imports_cmi
   with Cmi_consistbl.Inconsistency {
       unit_name = name;
@@ -70,14 +70,13 @@ let check_consistency file_name unit crc =
   begin try
     List.iter
       (fun (name, crco) ->
-        let name = name |> CU.Name.of_string in
         implementations := name :: !implementations;
         match crco with
             None ->
               if List.mem name !cmx_required then
                 raise(Error(Missing_cmx(file_name, name)))
           | Some crc ->
-              Cmx_consistbl.check crc_implementations name crc file_name)
+              Cmx_consistbl.check crc_implementations name () crc file_name)
       unit.ui_imports_cmx
   with Cmx_consistbl.Inconsistency {
       unit_name = name;
@@ -88,25 +87,22 @@ let check_consistency file_name unit crc =
   end;
   let ui_name = CU.name unit.ui_unit in
   begin try
-    let source = List.assoc ui_name !implementations_defined in
-    raise (Error(Multiple_definition(CU.name unit.ui_unit, file_name, source)))
+    let source = List.assoc unit.ui_unit !implementations_defined in
+    raise (Error(Multiple_definition(ui_name, file_name, source)))
   with Not_found -> ()
   end;
-  implementations := ui_name :: !implementations;
-  Cmx_consistbl.set crc_implementations ui_name crc file_name;
+  implementations := unit.ui_unit :: !implementations;
+  Cmx_consistbl.set crc_implementations unit.ui_unit () crc file_name;
   implementations_defined :=
-    (ui_name, file_name) :: !implementations_defined;
+    (unit.ui_unit, file_name) :: !implementations_defined;
   if CU.is_packed unit.ui_unit then
-    cmx_required := ui_name :: !cmx_required
+    cmx_required := unit.ui_unit :: !cmx_required
 
-let extract_crc_interfaces0 () =
-  Cmi_consistbl.extract !interfaces crc_interfaces
 let extract_crc_interfaces () =
-  extract_crc_interfaces0 ()
-  |> List.map (fun (name, crc) -> (name |> CU.Name.to_string, crc))
+  Cmi_consistbl.extract !interfaces crc_interfaces
 let extract_crc_implementations () =
   Cmx_consistbl.extract !implementations crc_implementations
-  |> List.map (fun (name, crc) -> (name |> CU.Name.to_string, crc))
+  |> List.map (fun (name, crco) -> name, Option.map snd crco)
 
 (* Add C objects and options and "custom" info from a library descriptor.
    See bytecomp/bytelink.ml for comments on the order of C objects. *)
@@ -135,7 +131,7 @@ let runtime_lib () =
 
 let missing_globals =
   (Hashtbl.create 17 :
-     (Linkage_name.t, string list ref) Hashtbl.t)
+     (CU.t, string list ref) Hashtbl.t)
 
 let is_required name =
   try ignore (Hashtbl.find missing_globals name); true
@@ -193,26 +189,17 @@ let read_file obj_name =
   end
   else raise(Error(Not_an_object_file file_name))
 
-let linkage_name_of_modname modname =
+let assume_no_prefix modname =
   (* We're the linker, so we assume that everything's already been packed, so
      no module needs its prefix considered. *)
-  modname |> Linkage_name.of_string
+  CU.create CU.Prefix.empty modname
 
 let scan_file file tolink =
   match file with
   | Unit (file_name,info,crc) ->
       (* This is a .cmx file. It must be linked in any case. *)
-      let linkage_name =
-        info.ui_unit
-        |> Compilation_unit.name
-        |> Compilation_unit.Name.to_string
-        |> linkage_name_of_modname
-      in
-      remove_required linkage_name;
-      List.iter (fun (name, crc) ->
-          let name = name |> linkage_name_of_modname in
-          add_required file_name (name, crc))
-        info.ui_imports_cmx;
+      remove_required info.ui_unit;
+      List.iter (add_required file_name) info.ui_imports_cmx;
       (info, file_name, crc) :: tolink
   | Library (file_name,infos) ->
       (* This is an archive file. Each unit contained in it will be linked
@@ -221,20 +208,15 @@ let scan_file file tolink =
       List.fold_right
         (fun (info, crc) reqd ->
            let ui_name = CU.name info.ui_unit in
-           let linkage_name =
-             ui_name |> CU.Name.to_string |> linkage_name_of_modname
-           in
            if info.ui_force_link
            || !Clflags.link_everything
-           || is_required linkage_name
+           || is_required info.ui_unit
            then begin
-             remove_required linkage_name;
+             remove_required info.ui_unit;
              let req_by =
                Printf.sprintf "%s(%s)" file_name (ui_name |> CU.Name.to_string)
              in
-             info.ui_imports_cmx |> List.iter (fun (modname, digest) ->
-               let linkage_name = modname |> Linkage_name.of_string in
-               add_required req_by (linkage_name, digest));
+             List.iter (add_required req_by) info.ui_imports_cmx;
              (info, file_name, crc) :: reqd
            end else
            reqd)
@@ -254,22 +236,24 @@ let make_globals_map units_list ~crc_interfaces =
   let defined =
     List.map (fun (unit, _, impl_crc) ->
         let name = CU.name unit.ui_unit in
-        let intf_crc = CU.Name.Tbl.find crc_interfaces name in
+        let intf_crc =
+          CU.Name.Tbl.find crc_interfaces name
+          |> Option.map (fun (_unit, crc) -> crc)
+        in
         CU.Name.Tbl.remove crc_interfaces name;
         let syms = List.map Symbol.for_compilation_unit unit.ui_defines in
-        (name, intf_crc, Some impl_crc, syms))
+        (unit.ui_unit, intf_crc, Some impl_crc, syms))
       units_list
   in
   CU.Name.Tbl.fold (fun name intf acc ->
-      (name, intf, None, []) :: acc)
+      let intf = Option.map (fun (_unit, crc) -> crc) intf in
+      (assume_no_prefix name, intf, None, []) :: acc)
     crc_interfaces defined
 
 let make_startup_file ~ppf_dump units_list ~crc_interfaces =
   let compile_phrase p = Asmgen.compile_phrase ~ppf_dump p in
   Location.input_name := "caml_startup"; (* set name of "current" input *)
-  let startup_comp_unit =
-    CU.create CU.Prefix.empty (CU.Name.of_string "_startup")
-  in
+  let startup_comp_unit = CU.of_string "_startup" in
   Compilenv.reset startup_comp_unit;
   Emit.begin_assembly ();
   let name_list =
@@ -390,16 +374,14 @@ let link ~ppf_dump objfiles output_name =
       else stdlib :: (objfiles @ [stdexit]) in
     let obj_infos = List.map read_file objfiles in
     let units_tolink = List.fold_right scan_file obj_infos [] in
-    Array.iter (fun name -> remove_required (name |> Linkage_name.of_string))
-      Runtimedef.builtin_exceptions;
     begin match extract_missing_globals() with
       [] -> ()
     | mg -> raise(Error(Missing_implementations mg))
     end;
     List.iter
       (fun (info, file_name, crc) -> check_consistency file_name info crc)
       units_tolink;
-    let crc_interfaces = extract_crc_interfaces0 () in
+    let crc_interfaces = extract_crc_interfaces () in
     Clflags.ccobjs := !Clflags.ccobjs @ !lib_ccobjs;
     Clflags.all_ccopts := !lib_ccopts @ !Clflags.all_ccopts;
                                                  (* put user's opts first *)
@@ -439,7 +421,7 @@ let report_error ppf = function
         List.iter
          (fun (md, rq) ->
             fprintf ppf "@ @[<hov 2>%a referenced from %a@]"
-            Linkage_name.print md
+            Compilation_unit.print md
             print_references rq) in
       fprintf ppf
        "@[<v 2>No implementations provided for the following modules:%a@]"
@@ -457,7 +439,7 @@ let report_error ppf = function
               over implementation %a@]"
        Location.print_filename file1
        Location.print_filename file2
-       CU.Name.print intf
+       CU.print intf
   | Assembler_error file ->
       fprintf ppf "Error while assembling %a" Location.print_filename file
   | Linking_error exitcode ->
@@ -476,9 +458,9 @@ let report_error ppf = function
          Please recompile %a@ with the correct `-I' option@ \
          so that %a.cmx@ is found.@]"
         Location.print_filename filename
-        CU.Name.print name
+        CU.print name
         Location.print_filename  filename
-        CU.Name.print name
+        CU.Name.print (CU.name name)
 
 let () =
   Location.register_error_of_exn

asmcomp/asmlink.ml

@@ -26,19 +26,19 @@ val call_linker_shared: string list -> string -> unit
 
 val reset : unit -> unit
 val check_consistency: filepath -> Cmx_format.unit_infos -> Digest.t -> unit
-val extract_crc_interfaces: unit -> crcs
-val extract_crc_implementations: unit -> crcs
+val extract_crc_interfaces: unit -> Cmx_format.import_info_cmi list
+val extract_crc_implementations: unit -> Cmx_format.import_info_cmx list
 
 type error =
   | File_not_found of filepath
   | Not_an_object_file of filepath
-  | Missing_implementations of (Linkage_name.t * string list) list
+  | Missing_implementations of (Compilation_unit.t * string list) list
   | Inconsistent_interface of Compilation_unit.Name.t * filepath * filepath
-  | Inconsistent_implementation of Compilation_unit.Name.t * filepath * filepath
+  | Inconsistent_implementation of Compilation_unit.t * filepath * filepath
   | Assembler_error of filepath
   | Linking_error of int
   | Multiple_definition of Compilation_unit.Name.t * filepath * filepath
-  | Missing_cmx of filepath * Compilation_unit.Name.t
+  | Missing_cmx of filepath * Compilation_unit.t
 
 exception Error of error