Generate generic functions (apply,curry,send) in the toplevel, when n…

…eeded

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

asmcomp/asmgen.ml

@@ -83,7 +83,18 @@ let compile_phrase ppf p =
   | Cfunction fd -> compile_fundecl ppf fd
   | Cdata dl -> Emit.data dl
 
-let compile_implementation prefixname ppf (size, lam) =
+
+(* For the native toplevel: generates generic functions unless
+   they are already available in the process *)
+let compile_genfuns ppf f =
+  List.iter
+    (function
+       | (Cfunction {fun_name = name}) as ph when f name ->
+	   compile_phrase ppf ph
+       | _ -> ())
+    (Cmmgen.generic_functions true [Compilenv.current_unit_infos ()])
+
+let compile_implementation ?toplevel prefixname ppf (size, lam) =
   let asmfile =
     if !keep_asm_file
     then prefixname ^ ext_asm
@@ -95,6 +106,7 @@ let compile_implementation prefixname ppf (size, lam) =
     Closure.intro size lam
     ++ Cmmgen.compunit size
     ++ List.iter (compile_phrase ppf) ++ (fun () -> ());
+    (match toplevel with None -> () | Some f -> compile_genfuns ppf f);
     Emit.end_assembly();
     close_out oc
   with x ->

asmcomp/asmgen.mli

@@ -15,6 +15,7 @@
 (* From lambda to assembly code *)
 
 val compile_implementation :
+    ?toplevel:(string -> bool) ->
     string -> Format.formatter -> int * Lambda.lambda -> unit
 val compile_phrase :
     Format.formatter -> Cmm.phrase -> unit

asmcomp/asmlink.ml

@@ -198,43 +198,6 @@ let scan_file obj_name tolink = match read_file obj_name with
 
 (* Second pass: generate the startup file and link it with everything else *)
 
-module IntSet = Set.Make(
-  struct
-    type t = int
-    let compare = compare
-  end)
-
-let default_apply = IntSet.add 2 (IntSet.add 3 IntSet.empty)
-  (* These apply funs are always present in the main program.
-     TODO: add more, and do the same for send and curry funs
-     (maybe up to 10-15?). *)
-
-let generic_functions ppf shared units_list =
-  let compile_phrase p = Asmgen.compile_phrase ppf p in
-  let (apply,send,curry) =
-    List.fold_left
-      (fun (apply,send,curry) ui ->
-	 List.fold_right IntSet.add ui.ui_apply_fun apply,
-	 List.fold_right IntSet.add ui.ui_send_fun send,
-	 List.fold_right IntSet.add ui.ui_curry_fun curry)
-      (IntSet.empty,IntSet.empty,IntSet.empty)
-      units_list
-  in
-  let apply =
-    if shared then IntSet.diff apply default_apply
-    else IntSet.union apply default_apply
-  in
-  IntSet.iter
-    (fun n -> compile_phrase (Cmmgen.apply_function n))
-    apply;
-  IntSet.iter
-    (fun n -> compile_phrase (Cmmgen.send_function n))
-    send;
-  IntSet.iter
-    (fun n -> List.iter (compile_phrase) (Cmmgen.curry_function n))
-    curry
-
-
 module StringSet = Set.Make(String)
 
 let make_startup_file ppf filename units_list =
@@ -248,7 +211,7 @@ let make_startup_file ppf filename units_list =
     List.flatten (List.map (fun (info,_,_) -> info.ui_defines) units_list) in
   compile_phrase (Cmmgen.entry_point name_list);
   let units = List.map (fun (info,_,_) -> info) units_list in
-  generic_functions ppf false units;
+  List.iter compile_phrase (Cmmgen.generic_functions false units);
   Array.iter
     (fun name -> compile_phrase (Cmmgen.predef_exception name))
     Runtimedef.builtin_exceptions;
@@ -271,15 +234,16 @@ let make_startup_file ppf filename units_list =
   close_out oc
 
 let make_shared_startup_file ppf units filename =
+  let compile_phrase p = Asmgen.compile_phrase ppf p in
   let oc = open_out filename in
   Emitaux.output_channel := oc;
   Location.input_name := "caml_startup";
   Compilenv.reset "_shared_startup"; 
   Emit.begin_assembly();
-  generic_functions ppf true (List.map fst units);
-  Asmgen.compile_phrase ppf (Cmmgen.plugin_header units);
-
-  Asmgen.compile_phrase ppf 
+  List.iter compile_phrase 
+    (Cmmgen.generic_functions true (List.map fst units));
+  compile_phrase (Cmmgen.plugin_header units);
+  compile_phrase
     (Cmmgen.global_table 
        (List.map (fun (ui,_) -> ui.Compilenv.ui_symbol) units));
   (* this is to force a reference to all units, otherwise the linker

asmcomp/cmmgen.ml

@@ -1927,6 +1927,36 @@ let curry_function arity =
   then intermediate_curry_functions arity 0
   else [tuplify_function (-arity)]
 
+
+module IntSet = Set.Make(
+  struct
+    type t = int
+    let compare = compare
+  end)
+
+let default_apply = IntSet.add 2 (IntSet.add 3 IntSet.empty)
+  (* These apply funs are always present in the main program.
+     TODO: add more, and do the same for send and curry funs
+     (maybe up to 10-15?). *)
+
+let generic_functions shared units =
+  let (apply,send,curry) =
+    List.fold_left
+      (fun (apply,send,curry) ui ->
+	 List.fold_right IntSet.add ui.Compilenv.ui_apply_fun apply,
+	 List.fold_right IntSet.add ui.Compilenv.ui_send_fun send,
+	 List.fold_right IntSet.add ui.Compilenv.ui_curry_fun curry)
+      (IntSet.empty,IntSet.empty,IntSet.empty)
+      units
+  in
+  let apply =
+    if shared then IntSet.diff apply default_apply
+    else IntSet.union apply default_apply
+  in
+  let accu = IntSet.fold (fun n accu -> apply_function n :: accu) apply [] in
+  let accu = IntSet.fold (fun n accu -> send_function n :: accu) send accu in
+  IntSet.fold (fun n accu -> curry_function n @ accu) curry accu
+
 (* Generate the entry point *)
 
 let entry_point namelist =

asmcomp/cmmgen.mli

@@ -19,6 +19,7 @@ val compunit: int -> Clambda.ulambda -> Cmm.phrase list
 val apply_function: int -> Cmm.phrase
 val send_function: int -> Cmm.phrase
 val curry_function: int -> Cmm.phrase list
+val generic_functions: bool -> Compilenv.unit_infos list -> Cmm.phrase list
 val entry_point: string list -> Cmm.phrase
 val global_table: string list -> Cmm.phrase
 val globals_map: (string * Digest.t * Digest.t * string list) list -> 

toplevel/opttoploop.ml

@@ -36,6 +36,10 @@ let global_symbol id =
   try ndl_loadsym sym
   with _ -> fatal_error ("Opttoploop.global_symbol " ^ (Ident.unique_name id))
 
+let need_symbol sym =
+  try ignore (ndl_loadsym sym); false
+  with _ -> true
+
 let dll_run dll entry =
   match (try Result (Obj.magic (ndl_run_toplevel dll entry)) with exn -> Exception exn) with
     | Exception _ as r -> r
@@ -131,7 +135,7 @@ let load_lambda ppf (size, lam) =
     else Filename.temp_file ("caml" ^ !phrase_name) ext_dll
   in
   let fn = Filename.chop_extension dll in
-  Asmgen.compile_implementation fn ppf (size, lam);
+  Asmgen.compile_implementation ~toplevel:need_symbol fn ppf (size, lam);
   Asmlink.call_linker_shared [fn ^ ext_obj] dll;
   Sys.remove (fn ^ ext_obj);