diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml index 341d71c7b2fa..93364628c5a5 100644 --- a/asmcomp/asmgen.ml +++ b/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 -> diff --git a/asmcomp/asmgen.mli b/asmcomp/asmgen.mli index 0f6b831cebb1..fe578bd4f548 100644 --- a/asmcomp/asmgen.mli +++ b/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 diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml index 5fcdbd707186..d1398a752ca7 100644 --- a/asmcomp/asmlink.ml +++ b/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 diff --git a/asmcomp/cmmgen.ml b/asmcomp/cmmgen.ml index aef69c83d47a..a51f0a28ad6c 100644 --- a/asmcomp/cmmgen.ml +++ b/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 = diff --git a/asmcomp/cmmgen.mli b/asmcomp/cmmgen.mli index a330925857d9..f73d6fcb3245 100644 --- a/asmcomp/cmmgen.mli +++ b/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 -> diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml index 010fab4620e2..8705c567b6d1 100644 --- a/toplevel/opttoploop.ml +++ b/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);