From c237f425215cb34b480ebbaad825490af231854e Mon Sep 17 00:00:00 2001
From: Mark Shinwell <mshinwell@gmail.com>
Date: Tue, 13 Nov 2018 13:43:38 +0000
Subject: [PATCH] Fix crc_interfaces stuff

---
 asmcomp/asmlink.ml | 31 +++++++++++++------------------
 utils/misc.ml      |  4 ++++
 utils/misc.mli     |  1 +
 3 files changed, 18 insertions(+), 18 deletions(-)

diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml
index 3c86afa66..dd4f8866f 100644
--- a/asmcomp/asmlink.ml
+++ b/asmcomp/asmlink.ml
@@ -20,6 +20,8 @@ open Config
 open Cmx_format
 open Compilenv
 
+module String = Misc.Stdlib.String
+
 type error =
     File_not_found of string
   | Not_an_object_file of string
@@ -207,29 +209,20 @@ let force_linking_of_startup ~ppf_dump =
   Asmgen.compile_phrase ~ppf_dump
     (Cmm.Cdata ([Cmm.Csymbol_address "caml_startup"]))
 
-let make_globals_map units_list =
-  let units = Hashtbl.create 17 in
-  List.iter (fun (unit, _, _) ->
-      List.iter (fun (name, intf_crc) ->
-          match Hashtbl.find units name, intf_crc with
-          | exception Not_found -> Hashtbl.add units name intf_crc
-          | None, (Some _ as intf_crc) -> Hashtbl.replace units name intf_crc
-          | Some _, _ -> ()
-          | _, None -> ())
-        unit.ui_imports_cmi)
-    units_list;
+let make_globals_map units_list ~crc_interfaces =
+  let crc_interfaces = String.Tbl.of_seq (List.to_seq crc_interfaces) in
   let defined =
     List.map (fun (unit, _, impl_crc) ->
-        let intf_crc = Hashtbl.find units unit.ui_name in
-        Hashtbl.remove units unit.ui_name;
+        let intf_crc = String.Tbl.find crc_interfaces unit.ui_name in
+        String.Tbl.remove crc_interfaces unit.ui_name;
         (unit.ui_name, intf_crc, Some impl_crc, unit.ui_defines))
       units_list
   in
-  Hashtbl.fold (fun name intf acc ->
+  String.Tbl.fold (fun name intf acc ->
       (name, intf, None, []) :: acc)
-    units defined
+    crc_interfaces defined
 
-let make_startup_file ~ppf_dump units_list =
+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 *)
   Compilenv.reset "_startup";
@@ -244,7 +237,8 @@ let make_startup_file ~ppf_dump units_list =
     (fun i name -> compile_phrase (Cmmgen.predef_exception i name))
     Runtimedef.builtin_exceptions;
   compile_phrase (Cmmgen.global_table name_list);
-  compile_phrase (Cmmgen.globals_map (make_globals_map units_list));
+  let globals_map = make_globals_map units_list ~crc_interfaces in
+  compile_phrase (Cmmgen.globals_map globals_map);
   compile_phrase(Cmmgen.data_segment_table ("_startup" :: name_list));
   compile_phrase(Cmmgen.code_segment_table ("_startup" :: name_list));
   let all_names = "_startup" :: "_system" :: name_list in
@@ -351,6 +345,7 @@ let link ~ppf_dump objfiles output_name =
     List.iter
       (fun (info, file_name, crc) -> check_consistency file_name info crc)
       units_tolink;
+    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 *)
@@ -361,7 +356,7 @@ let link ~ppf_dump objfiles output_name =
     let startup_obj = Filename.temp_file "camlstartup" ext_obj in
     Asmgen.compile_unit output_name
       startup !Clflags.keep_startup_file startup_obj
-      (fun () -> make_startup_file ~ppf_dump units_tolink);
+      (fun () -> make_startup_file ~ppf_dump units_tolink ~crc_interfaces);
     Misc.try_finally
       (fun () ->
          call_linker (List.map object_file_name objfiles)
diff --git a/utils/misc.ml b/utils/misc.ml
index 86564c532..2b2f14973 100644
--- a/utils/misc.ml
+++ b/utils/misc.ml
@@ -214,6 +214,10 @@ module Stdlib = struct
     include String
     module Set = Set.Make(String)
     module Map = Map.Make(String)
+    module Tbl = Hashtbl.Make(struct
+      include String
+      let hash = Hashtbl.hash
+    end)
   end
 
   external compare : 'a -> 'a -> int = "%compare"
diff --git a/utils/misc.mli b/utils/misc.mli
index 0445f219a..4fc8b0636 100644
--- a/utils/misc.mli
+++ b/utils/misc.mli
@@ -148,6 +148,7 @@ module Stdlib : sig
     include module type of String
     module Set : Set.S with type elt = string
     module Map : Map.S with type key = string
+    module Tbl : Hashtbl.S with type key = string
   end
 
   external compare : 'a -> 'a -> int = "%compare"