diff options
40 files changed, 150 insertions, 7 deletions
diff --git a/asmcomp/asmlink.ml b/asmcomp/asmlink.ml index 4c589904bc..f0ca7ba296 100644 --- a/asmcomp/asmlink.ml +++ b/asmcomp/asmlink.ml @@ -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 := [] + + + diff --git a/asmcomp/asmlink.mli b/asmcomp/asmlink.mli index 3b1428cdf5..60a2111e1c 100644 --- a/asmcomp/asmlink.mli +++ b/asmcomp/asmlink.mli @@ -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 diff --git a/asmcomp/closure.ml b/asmcomp/closure.ml index 2f37e0fcc7..14429c0e2e 100644 --- a/asmcomp/closure.ml +++ b/asmcomp/closure.ml @@ -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); diff --git a/asmcomp/closure.mli b/asmcomp/closure.mli index e7bccbca60..4e9ffb5c6e 100644 --- a/asmcomp/closure.mli +++ b/asmcomp/closure.mli @@ -12,4 +12,5 @@ (* Introduction of closures, uncurrying, recognition of direct calls *) +val reset : unit -> unit val intro: int -> Lambda.lambda -> Clambda.ulambda diff --git a/asmcomp/emitaux.ml b/asmcomp/emitaux.ml index 11212140a2..24a621b339 100644 --- a/asmcomp/emitaux.ml +++ b/asmcomp/emitaux.ml @@ -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 := [] diff --git a/asmcomp/emitaux.mli b/asmcomp/emitaux.mli index 9b19e294c7..486a5839ce 100644 --- a/asmcomp/emitaux.mli +++ b/asmcomp/emitaux.mli @@ -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 diff --git a/asmcomp/linearize.ml b/asmcomp/linearize.ml index e917f76b6a..48dde690c4 100644 --- a/asmcomp/linearize.ml +++ b/asmcomp/linearize.ml @@ -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; diff --git a/asmcomp/linearize.mli b/asmcomp/linearize.mli index 22987e5ba1..2996a29bf2 100644 --- a/asmcomp/linearize.mli +++ b/asmcomp/linearize.mli @@ -50,4 +50,5 @@ type fundecl = fun_fast: bool; fun_dbg : Debuginfo.t } +val reset : unit -> unit val fundecl: Mach.fundecl -> fundecl diff --git a/asmcomp/liveness.ml b/asmcomp/liveness.ml index 7e3f1fe080..c5b0c0a3a1 100644 --- a/asmcomp/liveness.ml +++ b/asmcomp/liveness.ml @@ -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 *) diff --git a/asmcomp/liveness.mli b/asmcomp/liveness.mli index b52ec5a2b8..ed2f1a8aeb 100644 --- a/asmcomp/liveness.mli +++ b/asmcomp/liveness.mli @@ -15,4 +15,5 @@ open Format +val reset : unit -> unit val fundecl: formatter -> Mach.fundecl -> unit diff --git a/asmcomp/schedgen.ml b/asmcomp/schedgen.ml index eb91854a50..89fee29b61 100644 --- a/asmcomp/schedgen.ml +++ b/asmcomp/schedgen.ml @@ -380,3 +380,5 @@ method schedule_fundecl f = f end + +let reset () = clear_code_dag () diff --git a/asmcomp/schedgen.mli b/asmcomp/schedgen.mli index 6019d96f42..911330f8ac 100644 --- a/asmcomp/schedgen.mli +++ b/asmcomp/schedgen.mli @@ -42,3 +42,5 @@ class virtual scheduler_generic : object (* Entry point *) method schedule_fundecl : Linearize.fundecl -> Linearize.fundecl end + +val reset : unit -> unit diff --git a/asmcomp/selectgen.ml b/asmcomp/selectgen.ml index e30d6fec39..50a38a244e 100644 --- a/asmcomp/selectgen.ml +++ b/asmcomp/selectgen.ml @@ -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 := "" diff --git a/asmcomp/selectgen.mli b/asmcomp/selectgen.mli index abc6db5ebf..0de9038215 100644 --- a/asmcomp/selectgen.mli +++ b/asmcomp/selectgen.mli @@ -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 diff --git a/asmcomp/spill.ml b/asmcomp/spill.ml index 95c49de393..36d1e6812d 100644 --- a/asmcomp/spill.ml +++ b/asmcomp/spill.ml @@ -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 = diff --git a/asmcomp/spill.mli b/asmcomp/spill.mli index 66954aef5b..acba343c9c 100644 --- a/asmcomp/spill.mli +++ b/asmcomp/spill.mli @@ -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 diff --git a/asmcomp/split.ml b/asmcomp/split.ml index 9e076e6481..919c980dce 100644 --- a/asmcomp/split.ml +++ b/asmcomp/split.ml @@ -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; diff --git a/asmcomp/split.mli b/asmcomp/split.mli index f794fec16f..1924a5ad6c 100644 --- a/asmcomp/split.mli +++ b/asmcomp/split.mli @@ -13,3 +13,5 @@ (* Renaming of registers at reload points to split live ranges. *) val fundecl: Mach.fundecl -> Mach.fundecl + +val reset : unit -> unit diff --git a/bytecomp/bytegen.ml b/bytecomp/bytegen.ml index 757bcd7c1d..11a571b68f 100644 --- a/bytecomp/bytegen.ml +++ b/bytecomp/bytegen.ml @@ -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 diff --git a/bytecomp/bytegen.mli b/bytecomp/bytegen.mli index 3c24cc8e86..24f1d64f32 100644 --- a/bytecomp/bytegen.mli +++ b/bytecomp/bytegen.mli @@ -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 diff --git a/bytecomp/bytelibrarian.ml b/bytecomp/bytelibrarian.ml index 3b88981e1c..7c96dfd0e7 100644 --- a/bytecomp/bytelibrarian.ml +++ b/bytecomp/bytelibrarian.ml @@ -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 := [] diff --git a/bytecomp/bytelibrarian.mli b/bytecomp/bytelibrarian.mli index 757874cb49..b9a4ced849 100644 --- a/bytecomp/bytelibrarian.mli +++ b/bytecomp/bytelibrarian.mli @@ -30,3 +30,5 @@ exception Error of error open Format val report_error: formatter -> error -> unit + +val reset: unit -> unit diff --git a/bytecomp/bytelink.ml b/bytecomp/bytelink.ml index 76a7453f17..c0f8f6a935 100644 --- a/bytecomp/bytelink.ml +++ b/bytecomp/bytelink.ml @@ -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 diff --git a/bytecomp/bytelink.mli b/bytecomp/bytelink.mli index 324d02e1f1..37dad2b526 100644 --- a/bytecomp/bytelink.mli +++ b/bytecomp/bytelink.mli @@ -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 diff --git a/bytecomp/bytepackager.ml b/bytecomp/bytepackager.ml index fcef71c8d3..3348f46dcd 100644 --- a/bytecomp/bytepackager.ml +++ b/bytecomp/bytepackager.ml @@ -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 diff --git a/bytecomp/bytepackager.mli b/bytecomp/bytepackager.mli index 64e100f585..69e3c77acb 100644 --- a/bytecomp/bytepackager.mli +++ b/bytecomp/bytepackager.mli @@ -25,3 +25,4 @@ type error = exception Error of error val report_error: Format.formatter -> error -> unit +val reset: unit -> unit diff --git a/bytecomp/bytesections.ml b/bytecomp/bytesections.ml index 15afdc0efd..759bde3b29 100644 --- a/bytecomp/bytesections.ml +++ b/bytecomp/bytesections.ml @@ -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 diff --git a/bytecomp/bytesections.mli b/bytecomp/bytesections.mli index b9639c1fac..12e679d73f 100644 --- a/bytecomp/bytesections.mli +++ b/bytecomp/bytesections.mli @@ -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 diff --git a/bytecomp/dll.ml b/bytecomp/dll.ml index 5c62b9edc3..21688e08ee 100644 --- a/bytecomp/dll.ml +++ b/bytecomp/dll.ml @@ -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 diff --git a/bytecomp/dll.mli b/bytecomp/dll.mli index 975315e268..878ffb919e 100644 --- a/bytecomp/dll.mli +++ b/bytecomp/dll.mli @@ -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 diff --git a/bytecomp/emitcode.ml b/bytecomp/emitcode.ml index 8adcf15929..95b9a20f59 100644 --- a/bytecomp/emitcode.ml +++ b/bytecomp/emitcode.ml @@ -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 := [] diff --git a/bytecomp/emitcode.mli b/bytecomp/emitcode.mli index 729a53764b..ee0bccbf0d 100644 --- a/bytecomp/emitcode.mli +++ b/bytecomp/emitcode.mli @@ -36,3 +36,5 @@ val to_packed_file: list of instructions to emit Result: relocation information (reversed) *) + +val reset: unit -> unit diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml index a1dcd5c599..68b03d2801 100644 --- a/bytecomp/lambda.ml +++ b/bytecomp/lambda.ml @@ -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 + diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli index cbcbc7bb67..2448087da7 100644 --- a/bytecomp/lambda.mli +++ b/bytecomp/lambda.mli @@ -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 diff --git a/bytecomp/symtable.ml b/bytecomp/symtable.ml index 31c958bdbe..37609d7751 100644 --- a/bytecomp/symtable.ml +++ b/bytecomp/symtable.ml @@ -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 diff --git a/bytecomp/symtable.mli b/bytecomp/symtable.mli index 71aecf914a..ffc878bf10 100644 --- a/bytecomp/symtable.mli +++ b/bytecomp/symtable.mli @@ -57,3 +57,5 @@ exception Error of error open Format val report_error: formatter -> error -> unit + +val reset: unit -> unit diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml index 502f546ae9..01ca31caf3 100644 --- a/bytecomp/translmod.ml +++ b/bytecomp/translmod.ml @@ -934,3 +934,9 @@ let () = | _ -> None ) + +let reset () = + primitive_declarations := []; + transl_store_subst := Ident.empty; + toploop_ident.Ident.flags <- 0; + aliased_idents := Ident.empty diff --git a/bytecomp/translmod.mli b/bytecomp/translmod.mli index 8e5005546f..1d84aaabd2 100644 --- a/bytecomp/translmod.mli +++ b/bytecomp/translmod.mli @@ -37,3 +37,5 @@ type error = exception Error of Location.t * error val report_error: Format.formatter -> error -> unit + +val reset: unit -> unit diff --git a/bytecomp/translobj.ml b/bytecomp/translobj.ml index 7f0d8577eb..02731ec684 100644 --- a/bytecomp/translobj.ml +++ b/bytecomp/translobj.ml @@ -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 diff --git a/bytecomp/translobj.mli b/bytecomp/translobj.mli index 55c1634332..a44ac683ff 100644 --- a/bytecomp/translobj.mli +++ b/bytecomp/translobj.mli @@ -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 |