asmlibrarian: ne pas recopier les approximations dans le .cmxa

asmlink, compilenv: garder trace des .cmx non trouves
closure, cmmgen: ajout flag mutable sur Pmakeblock, qui desactive
  l'approximation pour e.g. les references vers des fonctions.


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@426 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

asmcomp/asmlibrarian.ml

@@ -29,8 +29,13 @@ let read_info name =
       find_in_path !load_path name
     with Not_found ->
       raise(Error(File_not_found name)) in
-  (Filename.chop_suffix filename ".cmx" ^ ".o",
-   Compilenv.read_unit_info filename)
+  let (info, crc) = Compilenv.read_unit_info filename in
+  (* There is no need to keep the approximation in the .cmxa file,
+     since the compiler will go looking directly for .cmx files.
+     The linker, which is the only one that reads .cmxa files, does not
+     need the approximation. *)
+  info.ui_approx <- Clambda.Value_unknown;
+  (Filename.chop_suffix filename ".cmx" ^ ".o", (info, crc))
 
 let create_archive file_list lib_name =
   let archive_name = Filename.chop_suffix lib_name ".cmxa" ^ ".a" in

asmcomp/asmlink.ml

@@ -51,12 +51,14 @@ let check_consistency file_name unit crc =
   Hashtbl.add crc_interfaces unit.ui_name (file_name, unit.ui_interface);
   List.iter
     (fun (name, crc) ->
+      if crc <> cmx_not_found_crc then begin
       try
         let (auth_name, auth_crc) = Hashtbl.find crc_implementations name in
         if crc <> auth_crc then
           raise(Error(Inconsistent_implementation(name, file_name, auth_name)))
       with Not_found ->
-        Hashtbl.add crc_implementations name (file_name, crc))
+        Hashtbl.add crc_implementations name (file_name, crc)
+      end)
     unit.ui_imports_cmx;
   Hashtbl.add crc_implementations unit.ui_name (file_name, crc)
 
@@ -197,6 +199,7 @@ let object_file_name name =
 let link objfiles =
   let objfiles = "stdlib.cmxa" :: (objfiles @ ["std_exit.cmx"]) in
   let units_tolink = List.fold_right scan_file objfiles [] in
+  Array.iter remove_required Runtimedef.builtin_exceptions;
   if not (StringSet.is_empty !missing_globals) then
     raise(Error(Missing_implementations(StringSet.elements !missing_globals)));
   let startup = temp_file "camlstartup" ".s" in

asmcomp/closure.ml

@@ -14,6 +14,7 @@
 (* Introduction of closures, uncurrying, recognition of direct calls *)
 
 open Misc
+open Asttypes
 open Lambda
 open Clambda
 
@@ -167,9 +168,13 @@ let rec close fenv cenv = function
       let (ulam, approx) = close fenv cenv lam in
       Compilenv.set_global_approx approx;
       (Uprim(Psetglobal id, [ulam]), Value_unknown)
-  | Lprim(Pmakeblock tag, lams) ->
+  | Lprim(Pmakeblock(tag, mut) as prim, lams) ->
       let (ulams, approxs) = List.split (List.map (close fenv cenv) lams) in
-      (Uprim(Pmakeblock tag, ulams), Value_tuple(Array.of_list approxs))
+      (Uprim(prim, ulams),
+       begin match mut with
+           Immutable -> Value_tuple(Array.of_list approxs)
+         | Mutable -> Value_unknown
+       end)
   | Lprim(Pfield n, [lam]) ->
       let (ulam, approx) = close fenv cenv lam in
       (Uprim(Pfield n, [ulam]),

asmcomp/cmmgen.ml

@@ -279,7 +279,7 @@ let fundecls_size fundecls =
 let rec expr_size = function
     Uclosure(fundecls, clos_vars) ->
       fundecls_size fundecls + List.length clos_vars
-  | Uprim(Pmakeblock tag, args) ->
+  | Uprim(Pmakeblock(tag, mut), args) ->
       List.length args
   | Ulet(id, exp, body) ->
       expr_size body
@@ -408,9 +408,9 @@ let rec transl = function
       Cconst_symbol(Ident.name id)
 
   (* Heap blocks *)
-  | Uprim(Pmakeblock tag, []) ->
+  | Uprim(Pmakeblock(tag, mut), []) ->
       transl_constant(Const_block(tag, []))
-  | Uprim(Pmakeblock tag, args) ->
+  | Uprim(Pmakeblock(tag, mut), args) ->
       Cop(Calloc, alloc_block_header tag (List.length args) ::
                   List.map transl args)
   | Uprim(Pfield n, [arg]) ->
@@ -799,7 +799,7 @@ let rec transl_all_functions already_translated cont =
 (* Translate a toplevel structure definition *)
 
 let rec transl_structure glob = function
-    Uprim(Pmakeblock tag, args) ->
+    Uprim(Pmakeblock(tag, mut), args) ->
       (* Scan the args, storing those that are not identifiers and
          returning a map id -> position in block for those that are idents. *)
       let rec make_stores pos map = function

asmcomp/compilenv.ml

@@ -86,23 +86,26 @@ let read_unit_info filename =
 
 (* Return the approximation of a global identifier *)
 
+let cmx_not_found_crc =
+  "\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000"
+
 let global_approx global_ident =
   let modname = Ident.name global_ident in
   try
     Hashtbl.find global_approx_table modname
   with Not_found ->
-    let approx =
+    let (approx, crc) =
       try
         let filename =
           find_in_path !load_path (lowercase modname ^ ".cmx") in
         let (ui, crc) = read_unit_info filename in
         if ui.ui_name <> modname then
           raise(Error(Illegal_renaming(modname, filename)));
-        current_unit.ui_imports_cmx <-
-          (modname, crc) :: current_unit.ui_imports_cmx;
-        ui.ui_approx
+        (ui.ui_approx, crc)
       with Not_found ->
-        Value_unknown in
+        (Value_unknown, cmx_not_found_crc) in
+    current_unit.ui_imports_cmx <-
+      (modname, crc) :: current_unit.ui_imports_cmx;
     Hashtbl.add global_approx_table modname approx;
     approx
 

asmcomp/compilenv.mli

@@ -47,6 +47,10 @@ val read_unit_info: string -> unit_infos * Digest.t
 val save_unit_info: string -> unit
         (* Save the infos for the current unit in the given file *)
 
+val cmx_not_found_crc: Digest.t
+        (* Special digest used in the [ui_imports_cmx] list to signal
+           that no [.cmx] file was found and used for the imported unit *)
+
 type error =
     Not_a_unit_info of string
   | Corrupted_unit_info of string