Permalink
Browse files

Add reset functions to make modules reentrant when used through compi…

…ler-libs

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@14770 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02
  • Loading branch information...
1 parent b6500cc commit 457958a9e6ed855935beeea8720e854049864503 @lefessan lefessan committed May 9, 2014
View
@@ -404,3 +404,14 @@ let () =
| Error err -> Some (Location.error_of_printer_file report_error err)
| _ -> None
)
+
+let reset () =
+ Consistbl.clear crc_interfaces;
+ Consistbl.clear crc_implementations;
+ implementations_defined := [];
+ cmx_required := [];
+ interfaces := [];
+ implementations := []
+
+
+
View
@@ -20,6 +20,7 @@ val link_shared: formatter -> string list -> string -> unit
val call_linker_shared: string list -> string -> unit
+val reset : unit -> unit
val check_consistency: string -> Cmx_format.unit_infos -> Digest.t -> unit
val extract_crc_interfaces: unit -> (string * Digest.t option) list
val extract_crc_implementations: unit -> (string * Digest.t option) list
View
@@ -471,7 +471,7 @@ let simplif_prim_pure fpc p (args, approxs) dbg =
| Pfield n, _, [ Value_const(Uconst_ref(_, Uconst_block(_, l))) ]
when n < List.length l ->
make_const (List.nth l n)
- | Pfield n, [ Uprim(Pmakeblock _, ul, _) ], [approx]
+ | Pfield n, [ Uprim(Pmakeblock _, ul, _) ], [approx]
when n < List.length ul ->
(List.nth ul n, field_approx n approx)
(* Strings *)
@@ -678,7 +678,7 @@ let direct_apply fundesc funct ufunct uargs =
if fundesc.fun_closed then uargs else uargs @ [ufunct] in
let app =
match fundesc.fun_inline with
- | None ->
+ | None ->
Udirect_apply(fundesc.fun_label, app_args, Debuginfo.none)
| Some(params, body) ->
bind_params fundesc.fun_float_const_prop params app_args body in
@@ -1281,8 +1281,12 @@ let collect_exported_structured_constants a =
(* The entry point *)
+let reset () =
+ global_approx := [||];
+ function_nesting_depth := 0
+
let intro size lam =
- function_nesting_depth := 0;
+ reset ();
let id = Compilenv.make_symbol None in
global_approx := Array.init size (fun i -> Value_global_field (id, i));
Compilenv.set_global_approx(Value_tuple !global_approx);
View
@@ -12,4 +12,5 @@
(* Introduction of closures, uncurrying, recognition of direct calls *)
+val reset : unit -> unit
val intro: int -> Lambda.lambda -> Clambda.ulambda
View
@@ -232,3 +232,7 @@ let emit_debug_info dbg =
emit_int file_num; emit_char '\t';
emit_int line; emit_char '\n'
end
+
+let reset () =
+ reset_debug_info ();
+ frame_descriptors := []
View
@@ -27,6 +27,7 @@ val emit_float64_directive: string -> int64 -> unit
val emit_float64_split_directive: string -> int64 -> unit
val emit_float32_directive: string -> int32 -> unit
+val reset : unit -> unit
val reset_debug_info: unit -> unit
val emit_debug_info: Debuginfo.t -> unit
View
@@ -286,6 +286,10 @@ let rec linear i n =
| Iraise k ->
copy_instr (Lraise k) i (discard_dead_code n)
+let reset () =
+ label_counter := 99;
+ exit_label := []
+
let fundecl f =
{ fun_name = f.Mach.fun_name;
fun_body = linear f.Mach.fun_body end_instr;
View
@@ -50,4 +50,5 @@ type fundecl =
fun_fast: bool;
fun_dbg : Debuginfo.t }
+val reset : unit -> unit
val fundecl: Mach.fundecl -> fundecl
View
@@ -115,6 +115,10 @@ let rec live i finally =
i.live <- !live_at_raise;
Reg.add_set_array !live_at_raise i.arg
+let reset () =
+ live_at_raise := Reg.Set.empty;
+ live_at_exit := []
+
let fundecl ppf f =
let initially_live = live f.fun_body Reg.Set.empty in
(* Sanity check: only function parameters can be live at entrypoint *)
View
@@ -15,4 +15,5 @@
open Format
+val reset : unit -> unit
val fundecl: formatter -> Mach.fundecl -> unit
View
@@ -380,3 +380,5 @@ method schedule_fundecl f =
f
end
+
+let reset () = clear_code_dag ()
View
@@ -42,3 +42,5 @@ class virtual scheduler_generic : object
(* Entry point *)
method schedule_fundecl : Linearize.fundecl -> Linearize.fundecl
end
+
+val reset : unit -> unit
View
@@ -857,3 +857,7 @@ let is_tail_call nargs =
let _ =
Simplif.is_tail_native_heuristic := is_tail_call
+
+let reset () =
+ catch_regs := [];
+ current_function_name := ""
View
@@ -101,3 +101,5 @@ class virtual selector_generic : object
(Ident.t, Reg.t array) Tbl.t -> Cmm.expression -> Reg.t array option
method emit_tail : (Ident.t, Reg.t array) Tbl.t -> Cmm.expression -> unit
end
+
+val reset : unit -> unit
View
@@ -235,7 +235,7 @@ let rec reload i before =
let (new_body, after_body) = reload body before in
(* All registers live at the beginning of the handler are destroyed,
except the exception bucket *)
- let before_handler =
+ let before_handler =
Reg.Set.remove Proc.loc_exn_bucket
(Reg.add_set_array handler.live handler.arg) in
let (new_handler, after_handler) = reload handler before_handler in
@@ -389,10 +389,14 @@ let rec spill i finally =
(* Entry point *)
-let fundecl f =
+let reset () =
spill_env := Reg.Map.empty;
use_date := Reg.Map.empty;
- current_date := 0;
+ current_date := 0
+
+let fundecl f =
+ reset ();
+
let (body1, _) = reload f.fun_body Reg.Set.empty in
let (body2, tospill_at_entry) = spill body1 Reg.Set.empty in
let new_body =
View
@@ -13,4 +13,5 @@
(* Insertion of moves to suggest possible spilling / reloading points
before register allocation. *)
+val reset : unit -> unit
val fundecl: Mach.fundecl -> Mach.fundecl
View
@@ -195,8 +195,13 @@ let set_repres i =
(* Entry point *)
-let fundecl f =
+let reset () =
equiv_classes := Reg.Map.empty;
+ exit_subst := []
+
+let fundecl f =
+ reset ();
+
let new_args = Array.copy f.fun_args in
let (new_body, sub_body) = rename f.fun_body (Some Reg.Map.empty) in
repres_regs new_args;
View
@@ -13,3 +13,5 @@
(* Renaming of registers at reload points to split live ranges. *)
val fundecl: Mach.fundecl -> Mach.fundecl
+
+val reset : unit -> unit
View
@@ -930,3 +930,10 @@ let compile_phrase expr =
let init_code = comp_block empty_env expr 1 [Kreturn 1] in
let fun_code = comp_remainder [] in
(init_code, fun_code)
+
+let reset () =
+ label_counter := 0;
+ sz_static_raises := [];
+ compunit_name := "";
+ Stack.clear functions_to_compile;
+ max_stack_used := 0
View
@@ -17,3 +17,4 @@ open Instruct
val compile_implementation: string -> lambda -> instruction list
val compile_phrase: lambda -> instruction list * instruction list
+val reset: unit -> unit
@@ -124,3 +124,8 @@ let () =
| Error err -> Some (Location.error_of_printer_file report_error err)
| _ -> None
)
+
+let reset () =
+ lib_ccobjs := [];
+ lib_ccopts := [];
+ lib_dllibs := []
@@ -30,3 +30,5 @@ exception Error of error
open Format
val report_error: formatter -> error -> unit
+
+val reset: unit -> unit
View
@@ -638,3 +638,13 @@ let () =
| Error err -> Some (Location.error_of_printer_file report_error err)
| _ -> None
)
+
+let reset () =
+ lib_ccobjs := [];
+ lib_ccopts := [];
+ lib_dllibs := [];
+ missing_globals := IdentSet.empty;
+ Consistbl.clear crc_interfaces;
+ implementations_defined := [];
+ debug_info := [];
+ output_code_string_counter := 0
View
@@ -13,6 +13,7 @@
(* Link .cmo files and produce a bytecode executable. *)
val link : Format.formatter -> string list -> string -> unit
+val reset : unit -> unit
val check_consistency:
Format.formatter -> string -> Cmo_format.compilation_unit -> unit
View
@@ -297,3 +297,9 @@ let () =
| Error err -> Some (Location.error_of_printer_file report_error err)
| _ -> None
)
+
+let reset () =
+ relocs := [];
+ events := [];
+ primitives := [];
+ force_link := false
@@ -25,3 +25,4 @@ type error =
exception Error of error
val report_error: Format.formatter -> error -> unit
+val reset: unit -> unit
View
@@ -92,3 +92,7 @@ let read_section_struct ic name =
let pos_first_section ic =
in_channel_length ic - 16 - 8 * List.length !section_table -
List.fold_left (fun total (name, len) -> total + len) 0 !section_table
+
+let reset () =
+ section_table := [];
+ section_beginning := 0
@@ -50,3 +50,5 @@ val read_section_struct: in_channel -> string -> 'a
val pos_first_section: in_channel -> int
(* Return the position of the beginning of the first section *)
+
+val reset: unit -> unit
View
@@ -173,3 +173,9 @@ let init_toplevel dllpath =
opened_dlls := Array.to_list (get_current_dlls());
names_of_opened_dlls := [];
linking_in_core := true
+
+let reset () =
+ search_path := [];
+ opened_dlls :=[];
+ names_of_opened_dlls := [];
+ linking_in_core := false
View
@@ -59,3 +59,5 @@ val init_compile: bool -> unit
contents of ld.conf file). Take note of the DLLs that were opened
when starting the running program. *)
val init_toplevel: string -> unit
+
+val reset: unit -> unit
View
@@ -417,3 +417,9 @@ let to_packed_file outchan code =
let reloc = !reloc_info in
init();
reloc
+
+let reset () =
+ out_buffer := LongString.create 1024;
+ out_position := 0;
+ label_table := [| |];
+ reloc_info := []
View
@@ -36,3 +36,5 @@ val to_packed_file:
list of instructions to emit
Result:
relocation information (reversed) *)
+
+val reset: unit -> unit
View
@@ -537,3 +537,7 @@ let lam_of_loc kind loc =
file lnum cnum enum in
Lconst (Const_immstring loc)
| Loc_LINE -> Lconst (Const_base (Const_int lnum))
+
+let reset () =
+ raise_count := 0
+
View
@@ -259,3 +259,5 @@ val patch_guarded : lambda -> lambda -> lambda
val raise_kind: raise_kind -> string
val lam_of_loc : loc_kind -> Location.t -> lambda
+
+val reset: unit -> unit
View
@@ -383,3 +383,8 @@ let () =
| Error err -> Some (Location.error_of_printer_file report_error err)
| _ -> None
)
+
+let reset () =
+ global_table := empty_numtable;
+ literal_table := [];
+ c_prim_table := empty_numtable
View
@@ -57,3 +57,5 @@ exception Error of error
open Format
val report_error: formatter -> error -> unit
+
+val reset: unit -> unit
View
@@ -934,3 +934,9 @@ let () =
| _ ->
None
)
+
+let reset () =
+ primitive_declarations := [];
+ transl_store_subst := Ident.empty;
+ toploop_ident.Ident.flags <- 0;
+ aliased_idents := Ident.empty
View
@@ -37,3 +37,5 @@ type error =
exception Error of Location.t * error
val report_error: Format.formatter -> error -> unit
+
+val reset: unit -> unit
View
@@ -162,3 +162,14 @@ let oo_wrap env req f x =
wrapping := false;
top_env := Env.empty;
raise exn
+
+let reset () =
+ Hashtbl.clear consts;
+ cache_required := false;
+ method_cache := lambda_unit;
+ method_count := 0;
+ method_table := [];
+ wrapping := false;
+ top_env := Env.empty;
+ classes := [];
+ method_ids := IdentSet.empty
View
@@ -26,3 +26,5 @@ val method_ids: IdentSet.t ref (* reset when starting a new wrapper *)
val oo_wrap: Env.t -> bool -> ('a -> lambda) -> 'a -> lambda
val oo_add_class: Ident.t -> Env.t * bool
+
+val reset: unit -> unit

0 comments on commit 457958a

Please sign in to comment.