Pārlūkot izejas kodu

[eval] group global state in a module and clean up curapi

Simon Krajewski 6 gadi atpakaļ
vecāks
revīzija
329d29f4f9

+ 7 - 0
src/compiler/server.ml

@@ -558,6 +558,12 @@ let init_new_compilation sctx =
 	sctx.compilation_mark <- sctx.mark_loop;
 	start_time := get_time()
 
+let cleanup () =
+	begin match !MacroContext.macro_interp_cache with
+	| Some interp -> EvalContext.GlobalState.cleanup interp
+	| None -> ()
+	end
+
 (* The server main loop. Waits for the [accept] call to then process the sent compilation
    parameters through [process_params]. *)
 let wait_loop process_params verbose accept =
@@ -618,6 +624,7 @@ let wait_loop process_params verbose accept =
 		(* Close connection and perform some cleanup *)
 		close();
 		current_stdin := None;
+		cleanup();
 		(* prevent too much fragmentation by doing some compactions every X run *)
 		if sctx.was_compilation then incr run_count;
 		if !run_count mod 10 = 0 then begin

+ 2 - 0
src/context/memory.ml

@@ -112,6 +112,8 @@ let get_memory_json (cs : CompilationServer.t) mreq =
 				"nativeLibCache",jint (mem_size cache_mem.(3));
 				"additionalSizes",jarray [
 					jobject ["name",jstring "macro interpreter";"size",jint (mem_size (MacroContext.macro_interp_cache))];
+					jobject ["name",jstring "macro stdlib";"size",jint (mem_size (EvalContext.GlobalState.stdlib))];
+					jobject ["name",jstring "macro macro_lib";"size",jint (mem_size (EvalContext.GlobalState.macro_lib))];
 					jobject ["name",jstring "last completion result";"size",jint (mem_size (DisplayException.last_completion_result))];
 					jobject ["name",jstring "Lexer file cache";"size",jint (mem_size (Lexer.all_files))];
 					jobject ["name",jstring "GC heap words";"size",jint (int_of_float size)];

+ 19 - 3
src/macro/eval/evalContext.ml

@@ -284,9 +284,25 @@ and context = {
 	max_stack_depth : int;
 }
 
-let get_ctx_ref : (unit -> context) ref = ref (fun() -> assert false)
-let get_ctx () = (!get_ctx_ref)()
-let select ctx = get_ctx_ref := (fun() -> ctx)
+module GlobalState = struct
+	let get_ctx_ref : (unit -> context) ref = ref (fun() -> assert false)
+
+	let sid : int ref = ref (-1)
+
+	let debug : debug option ref = ref None
+	let debugger_initialized : bool ref = ref false
+
+	let stdlib : builtins option ref = ref None
+	let macro_lib : (string,value) Hashtbl.t = Hashtbl.create 0
+
+	let cleanup ctx =
+		(* curapi holds a reference to the typing context which we don't want to persist. Let's unset it so the
+		   context can be collected. *)
+		ctx.curapi <- Obj.magic ""
+end
+
+let get_ctx () = (!GlobalState.get_ctx_ref)()
+let select ctx = GlobalState.get_ctx_ref := (fun() -> ctx)
 
 let s_debug_state = function
 	| DbgRunning -> "DbgRunning"

+ 5 - 5
src/macro/eval/evalExceptions.ml

@@ -127,13 +127,13 @@ let handle_stack_overflow eval f =
 	with Stack_overflow -> exc_string "Stack overflow"
 
 let catch_exceptions ctx ?(final=(fun() -> ())) f p =
-	let prev = !get_ctx_ref in
+	let prev = !GlobalState.get_ctx_ref in
 	select ctx;
 	let eval = get_eval ctx in
 	let env = eval.env in
 	let r = try
 		let v = handle_stack_overflow eval f in
-		get_ctx_ref := prev;
+		GlobalState.get_ctx_ref := prev;
 		final();
 		Some v
 	with
@@ -144,7 +144,7 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p =
 		if is v key_haxe_macro_Error then begin
 			let v1 = field v key_message in
 			let v2 = field v key_pos in
-			get_ctx_ref := prev;
+			GlobalState.get_ctx_ref := prev;
 			final();
 			match v1,v2 with
 				| VString s,VInstance {ikind = IPos p} ->
@@ -159,7 +159,7 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p =
 				| _ :: l -> l (* Otherwise, ignore topmost frame position. *)
 			in
 			let msg = get_exc_error_message ctx v stack (if p' = null_pos then p else p') in
-			get_ctx_ref := prev;
+			GlobalState.get_ctx_ref := prev;
 			final();
 			Error.error msg null_pos
 		end
@@ -167,7 +167,7 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p =
 		final();
 		None
 	| exc ->
-		get_ctx_ref := prev;
+		GlobalState.get_ctx_ref := prev;
 		final();
 		raise exc
 	in

+ 9 - 16
src/macro/eval/evalMain.ml

@@ -36,17 +36,10 @@ open MacroApi
 
 (* Create *)
 
-let sid = ref (-1)
-
-let stdlib = ref None
-let debug = ref None
-
-let debugger_initialized = ref false
-
 let create com api is_macro =
 	let t = Timer.timer [(if is_macro then "macro" else "interp");"create"] in
-	incr sid;
-	let builtins = match !stdlib with
+	incr GlobalState.sid;
+	let builtins = match !GlobalState.stdlib with
 		| None ->
 			let builtins = {
 				static_builtins = IntMap.empty;
@@ -55,12 +48,12 @@ let create com api is_macro =
 				empty_constructor_builtins = Hashtbl.create 0;
 			} in
 			EvalStdLib.init_standard_library builtins;
-			stdlib := Some builtins;
+			GlobalState.stdlib := Some builtins;
 			builtins
 		| Some (builtins) ->
 			builtins
 	in
-	let debug = match !debug with
+	let debug = match !GlobalState.debug with
 		| None ->
 			let support_debugger = Common.defined com Define.EvalDebugger in
 			let socket =
@@ -93,7 +86,7 @@ let create com api is_macro =
 				exception_mode = CatchUncaught;
 				debug_context = new eval_debug_context;
 			} in
-			debug := Some debug';
+			GlobalState.debug := Some debug';
 			debug'
 		| Some debug ->
 			debug
@@ -107,7 +100,7 @@ let create com api is_macro =
 	let eval = EvalThread.create_eval thread in
 	let evals = IntMap.singleton 0 eval in
 	let rec ctx = {
-		ctx_id = !sid;
+		ctx_id = !GlobalState.sid;
 		is_macro = is_macro;
 		debug = debug;
 		detail_times = detail_times;
@@ -134,11 +127,11 @@ let create com api is_macro =
 		exception_stack = [];
 		max_stack_depth = int_of_string (Common.defined_value_safe ~default:"1000" com Define.EvalCallStackDepth);
 	} in
-	if debug.support_debugger && not !debugger_initialized then begin
+	if debug.support_debugger && not !GlobalState.debugger_initialized then begin
 		(* Let's wait till the debugger says we're good to continue. This allows it to finish configuration.
 		   Note that configuration is shared between macro and interpreter contexts, which is why the check
 		   is governed by a global variable. *)
-		debugger_initialized := true;
+		GlobalState.debugger_initialized := true;
 		 (* There's select_ctx in the json-rpc handling, so let's select this one. It's fine because it's the
 		    first context anyway. *)
 		select ctx;
@@ -367,7 +360,7 @@ let setup get_api =
 				exc_string "Invalid expression"
 			in
 			let v = VFunction (f,b) in
-			Hashtbl.replace EvalStdLib.macro_lib n v
+			Hashtbl.replace GlobalState.macro_lib n v
 		| _ -> assert false
 	) api;
 	Globals.macro_platform := Globals.Eval

+ 1 - 3
src/macro/eval/evalStdLib.ml

@@ -30,8 +30,6 @@ open EvalHash
 open EvalString
 open EvalThread
 
-let macro_lib = Hashtbl.create 0
-
 let catch_unix_error f arg =
 	try
 		f arg
@@ -646,7 +644,7 @@ module StdContext = struct
 
 	let callMacroApi = vfun1 (fun f ->
 		let f = decode_string f in
-		Hashtbl.find macro_lib f
+		Hashtbl.find GlobalState.macro_lib f
 	)
 
 	let plugin_data = ref None