Also remove linking hack for bytecode

chambart · chambart · commit 88c2c8ce796c · 2016-06-08T15:34:08.000+02:00
Adds the required_globals information to bytecode compilation units.

This patch also bootstrap ocamlc. The cmo format is changed by this
commit, there is no way around bootstraping here. Note that ocamldep and
ocamllex does not rely on the cmo format, so they are not present in
this commit.

Changes in tests:

* Update test/transprim/comparison_table.ml.reference:
    The (opaque (global List!)) expression is not present anymore

* Update tests/no-alias-deps/aliases.cmo.reference
    The output of objinfo changed
diff --git a/boot/ocamlc b/boot/ocamlc
diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml
@@ -95,11 +95,18 @@ let is_required (rel, _pos) =
       IdentSet.mem id !missing_globals
   | _ -> false
 
-let add_required (rel, _pos) =
-  match rel with
-    Reloc_getglobal id ->
-      missing_globals := IdentSet.add id !missing_globals
-  | _ -> ()
+let add_required compunit =
+  let add_required_by_reloc (rel, _pos) =
+    match rel with
+      Reloc_getglobal id ->
+        missing_globals := IdentSet.add id !missing_globals
+    | _ -> ()
+  in
+  let add_required_for_effects id =
+    missing_globals := IdentSet.add id !missing_globals
+  in
+  List.iter add_required_by_reloc compunit.cu_reloc;
+  List.iter add_required_for_effects compunit.cu_required_globals
 
 let remove_required (rel, _pos) =
   match rel with
@@ -124,7 +131,7 @@ let scan_file obj_name tolink =
       seek_in ic compunit_pos;
       let compunit = (input_value ic : compilation_unit) in
       close_in ic;
-      List.iter add_required compunit.cu_reloc;
+      add_required compunit;
       Link_object(file_name, compunit) :: tolink
     end
     else if buffer = cma_magic_number then begin
@@ -143,7 +150,7 @@ let scan_file obj_name tolink =
             || List.exists is_required compunit.cu_reloc
             then begin
               List.iter remove_required compunit.cu_reloc;
-              List.iter add_required compunit.cu_reloc;
+              add_required compunit;
               compunit :: reqd
             end else
               reqd)
diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml
@@ -207,6 +207,14 @@ let build_global_target oc target_name members mapping pos coercion =
 let package_object_files ppf files targetfile targetname coercion =
   let members =
     map_left_right read_member_info files in
+  let required_globals =
+    List.fold_left (fun required_globals -> function
+        | { pm_kind = PM_intf } ->
+            required_globals
+        | { pm_kind = PM_impl { cu_required_globals } } ->
+            List.fold_right Ident.Set.add cu_required_globals required_globals)
+      Ident.Set.empty members
+  in
   let unit_names =
     List.map (fun m -> m.pm_name) members in
   let mapping =
@@ -242,6 +250,7 @@ let package_object_files ppf files targetfile targetname coercion =
         cu_imports =
           (targetname, Some (Env.crc_of_unit targetname)) :: imports;
         cu_primitives = !primitives;
+        cu_required_globals = Ident.Set.elements required_globals;
         cu_force_link = !force_link;
         cu_debug = if pos_final > pos_debug then pos_debug else 0;
         cu_debugsize = pos_final - pos_debug } in
diff --git a/bytecomp/cmo_format.mli b/bytecomp/cmo_format.mli
@@ -32,6 +32,8 @@ type compilation_unit =
     cu_reloc: (reloc_info * int) list;  (* Relocation information *)
     cu_imports:
       (string * Digest.t option) list; (* Names and CRC of intfs imported *)
+    cu_required_globals: Ident.t list; (* Compilation units whose initialization
+                                          side effects must occur before this one. *)
     cu_primitives: string list;         (* Primitives declared inside *)
     mutable cu_force_link: bool;        (* Must be linked even if unref'ed *)
     mutable cu_debug: int;              (* Position of debugging info, or 0 *)
diff --git a/bytecomp/emitcode.ml b/bytecomp/emitcode.ml
@@ -365,7 +365,7 @@ let rec emit = function
 
 (* Emission to a file *)
 
-let to_file outchan unit_name objfile code =
+let to_file outchan unit_name objfile ~required_globals code =
   init();
   output_string outchan cmo_magic_number;
   let pos_depl = pos_out outchan in
@@ -392,6 +392,7 @@ let to_file outchan unit_name objfile code =
       cu_imports = Env.imports();
       cu_primitives = List.map Primitive.byte_name
                                !Translmod.primitive_declarations;
+      cu_required_globals = Ident.Set.elements required_globals;
       cu_force_link = false;
       cu_debug = pos_debug;
       cu_debugsize = size_debug } in
diff --git a/bytecomp/emitcode.mli b/bytecomp/emitcode.mli
@@ -18,11 +18,14 @@
 open Cmo_format
 open Instruct
 
-val to_file: out_channel -> string -> string -> instruction list -> unit
+val to_file: out_channel -> string -> string ->
+  required_globals:Ident.Set.t -> instruction list -> unit
         (* Arguments:
              channel on output file
              name of compilation unit implemented
              path of cmo file being written
+             required_globals: list of compilation units that must be
+               evaluated before this one
              list of instructions to emit *)
 val to_memory: instruction list -> instruction list ->
                     bytes * int * (reloc_info * int) list * debug_event list
diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml
@@ -577,11 +577,6 @@ let required_globals ~flambda body =
   Hashtbl.clear used_primitives;
   required
 
-let wrap_required_globals required body =
-  Ident.Set.fold
-    (fun id expr -> Lsequence(Lprim(Popaque, [Lprim(Pgetglobal id, [])]), expr))
-    required body
-
 (* Compile an implementation *)
 
 let transl_implementation_flambda module_name (str, cc) =
@@ -602,9 +597,10 @@ let transl_implementation module_name (str, cc) =
   let implementation =
     transl_implementation_flambda module_name (str, cc)
   in
-  Lprim (Psetglobal implementation.module_ident,
-         [wrap_required_globals implementation.required_globals
-            implementation.code])
+  let code =
+    Lprim (Psetglobal implementation.module_ident, [implementation.code])
+  in
+  { implementation with code }
 
 (* Build the list of value identifiers defined by a toplevel structure
    (excluding primitive declarations). *)
diff --git a/bytecomp/translmod.mli b/bytecomp/translmod.mli
@@ -19,7 +19,7 @@
 open Typedtree
 open Lambda
 
-val transl_implementation: string -> structure * module_coercion -> lambda
+val transl_implementation: string -> structure * module_coercion -> Lambda.program
 val transl_store_phrases: string -> structure -> int * lambda
 val transl_store_implementation:
       string -> structure * module_coercion -> Lambda.program
diff --git a/driver/compile.ml b/driver/compile.ml
@@ -80,24 +80,25 @@ let implementation ppf sourcefile outputprefix =
       Warnings.check_fatal ();
       Stypes.dump (Some (outputprefix ^ ".annot"))
     end else begin
-      let bytecode =
+      let bytecode, required_globals =
         (typedtree, coercion)
         ++ Timings.(time (Transl sourcefile))
             (Translmod.transl_implementation modulename)
-        ++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda
         ++ Timings.(accumulate_time (Generate sourcefile))
-            (fun lambda ->
-              Simplif.simplify_lambda lambda
+            (fun { Lambda.code = lambda; required_globals } ->
+              print_if ppf Clflags.dump_rawlambda Printlambda.lambda lambda
+              ++ Simplif.simplify_lambda
               ++ print_if ppf Clflags.dump_lambda Printlambda.lambda
               ++ Bytegen.compile_implementation modulename
-              ++ print_if ppf Clflags.dump_instr Printinstr.instrlist)
+              ++ print_if ppf Clflags.dump_instr Printinstr.instrlist
+              ++ fun bytecode -> bytecode, required_globals)
       in
       let objfile = outputprefix ^ ".cmo" in
       let oc = open_out_bin objfile in
       try
         bytecode
         ++ Timings.(accumulate_time (Generate sourcefile))
-            (Emitcode.to_file oc modulename objfile);
+            (Emitcode.to_file oc modulename objfile ~required_globals);
         Warnings.check_fatal ();
         close_out oc;
         Stypes.dump (Some (outputprefix ^ ".annot"))
diff --git a/testsuite/tests/no-alias-deps/aliases.cmo.reference b/testsuite/tests/no-alias-deps/aliases.cmo.reference
@@ -8,5 +8,8 @@ Interfaces imported:
 	--------------------------------	B
 	aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa	Aliases
 	--------------------------------	A
+Required globals:
+	D
+	Pervasives
 Uses unsafe features: no
 Force link: no
diff --git a/testsuite/tests/translprim/comparison_table.ml.reference b/testsuite/tests/translprim/comparison_table.ml.reference
diff --git a/tools/objinfo.ml b/tools/objinfo.ml
