Output references to the native version of the primitives in ocamlopt

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

7 files changed, 23 insertions, 22 deletions

diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml
index cd02217e7..36edea8cf 100644
--- a/asmcomp/asmgen.ml
+++ b/asmcomp/asmgen.ml
@@ -117,7 +117,7 @@ let compile_implementation ?toplevel prefixname ppf (size, lam) =
     compile_phrase ppf
       (Cmmgen.reference_symbols
          (List.filter (fun s -> s <> "" && s.[0] <> '%')
-            !Translmod.primitive_declarations)
+            (List.map Primitive.native_name !Translmod.primitive_declarations))
       );
 
     Emit.end_assembly();
diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml
index b9276ab17..a50822fed 100644
--- a/asmcomp/cmmgen.ml
+++ b/asmcomp/cmmgen.ml
@@ -868,14 +868,9 @@ let rec transl = function
             box_float
               (Cop(Cextcall(prim.prim_native_name, typ_float, false, dbg),
                    List.map transl_unbox_float args))
-          else begin
-            let name =
-              if prim.prim_native_name <> ""
-              then prim.prim_native_name
-              else prim.prim_name in
-            Cop(Cextcall(name, typ_addr, prim.prim_alloc, dbg),
+          else
+            Cop(Cextcall(Primitive.native_name prim, typ_addr, prim.prim_alloc, dbg),
                 List.map transl args)
-          end
       | (Pmakearray kind, []) ->
           transl_constant(Const_block(0, []))
       | (Pmakearray kind, args) ->
diff --git a/bytecomp/emitcode.ml b/bytecomp/emitcode.ml
index d26fef75c..db10dea64 100644
--- a/bytecomp/emitcode.ml
+++ b/bytecomp/emitcode.ml
@@ -373,7 +373,7 @@ let to_file outchan unit_name code =
       cu_codesize = !out_position;
       cu_reloc = List.rev !reloc_info;
       cu_imports = Env.imported_units();
-      cu_primitives = !Translmod.primitive_declarations;
+      cu_primitives = List.map Primitive.byte_name !Translmod.primitive_declarations;
       cu_force_link = false;
       cu_debug = pos_debug;
       cu_debugsize = size_debug } in
diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml
index fc7da7d1a..17f291ade 100644
--- a/bytecomp/translmod.ml
+++ b/bytecomp/translmod.ml
@@ -80,8 +80,11 @@ let rec compose_coercions c1 c2 =
 
 (* Record the primitive declarations occuring in the module compiled *)
 
-let primitive_declarations = ref ([] : string list)
-
+let primitive_declarations = ref ([] : Primitive.description list)
+let record_primitive = function
+  | {val_kind=Val_prim p} -> primitive_declarations := p :: !primitive_declarations
+  | _ -> ()
+ 
 (* Keep track of the root path (from the root of the namespace to the
    currently compiled module expression).  Useful for naming exceptions. *)
 
@@ -289,11 +292,7 @@ and transl_structure fields cc rootpath = function
       transl_let rec_flag pat_expr_list
                  (transl_structure ext_fields cc rootpath rem)
   | Tstr_primitive(id, descr) :: rem ->
-      begin match descr.val_kind with
-        Val_prim p -> primitive_declarations :=
-                        p.Primitive.prim_name :: !primitive_declarations
-      | _ -> ()
-      end;
+      record_primitive descr;
       transl_structure fields cc rootpath rem
   | Tstr_type(decls) :: rem ->
       transl_structure fields cc rootpath rem
@@ -386,11 +385,7 @@ let transl_store_structure glob map prims str =
       Lsequence(subst_lambda subst lam,
                 transl_store (add_idents false ids subst) rem)
   | Tstr_primitive(id, descr) :: rem ->
-      begin match descr.val_kind with
-        Val_prim p -> primitive_declarations :=
-                        p.Primitive.prim_name :: !primitive_declarations
-      | _ -> ()
-      end;
+      record_primitive descr;
       transl_store subst rem
   | Tstr_type(decls) :: rem ->
       transl_store subst rem
diff --git a/bytecomp/translmod.mli b/bytecomp/translmod.mli
index b7cf6d5dd..bec880b2f 100644
--- a/bytecomp/translmod.mli
+++ b/bytecomp/translmod.mli
@@ -31,7 +31,7 @@ val transl_store_package:
 val toplevel_name: Ident.t -> string
 val nat_toplevel_name: Ident.t -> Ident.t * int
 
-val primitive_declarations: string list ref
+val primitive_declarations: Primitive.description list ref
 
 type error =
   Circular_dependency of Ident.t
diff --git a/typing/primitive.ml b/typing/primitive.ml
index fbbdb05b1..3d7ab5f7c 100644
--- a/typing/primitive.ml
+++ b/typing/primitive.ml
@@ -54,3 +54,11 @@ let description_list p =
   in
   let list = if p.prim_native_float then "float" :: list else list in
   List.rev list
+
+let native_name p =
+  if p.prim_native_name <> ""
+  then p.prim_native_name
+  else p.prim_name
+
+let byte_name p =
+  p.prim_name
diff --git a/typing/primitive.mli b/typing/primitive.mli
index e89678aec..8446037f4 100644
--- a/typing/primitive.mli
+++ b/typing/primitive.mli
@@ -24,3 +24,6 @@ type description =
 val parse_declaration: int -> string list -> description
 
 val description_list: description -> string list
+
+val native_name: description -> string
+val byte_name: description -> string