소스 검색

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

Simon Krajewski 6 년 전
부모
커밋
329d29f4f9
6개의 변경된 파일43개의 추가작업 그리고 27개의 파일을 삭제
  1. 7 0
      src/compiler/server.ml
  2. 2 0
      src/context/memory.ml
  3. 19 3
      src/macro/eval/evalContext.ml
  4. 5 5
      src/macro/eval/evalExceptions.ml
  5. 9 16
      src/macro/eval/evalMain.ml
  6. 1 3
      src/macro/eval/evalStdLib.ml

+ 7 - 0
src/compiler/server.ml

@@ -558,6 +558,12 @@ let init_new_compilation sctx =
 	sctx.compilation_mark <- sctx.mark_loop;
 	sctx.compilation_mark <- sctx.mark_loop;
 	start_time := get_time()
 	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
 (* The server main loop. Waits for the [accept] call to then process the sent compilation
    parameters through [process_params]. *)
    parameters through [process_params]. *)
 let wait_loop process_params verbose accept =
 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 connection and perform some cleanup *)
 		close();
 		close();
 		current_stdin := None;
 		current_stdin := None;
+		cleanup();
 		(* prevent too much fragmentation by doing some compactions every X run *)
 		(* prevent too much fragmentation by doing some compactions every X run *)
 		if sctx.was_compilation then incr run_count;
 		if sctx.was_compilation then incr run_count;
 		if !run_count mod 10 = 0 then begin
 		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));
 				"nativeLibCache",jint (mem_size cache_mem.(3));
 				"additionalSizes",jarray [
 				"additionalSizes",jarray [
 					jobject ["name",jstring "macro interpreter";"size",jint (mem_size (MacroContext.macro_interp_cache))];
 					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 "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 "Lexer file cache";"size",jint (mem_size (Lexer.all_files))];
 					jobject ["name",jstring "GC heap words";"size",jint (int_of_float size)];
 					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;
 	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
 let s_debug_state = function
 	| DbgRunning -> "DbgRunning"
 	| 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"
 	with Stack_overflow -> exc_string "Stack overflow"
 
 
 let catch_exceptions ctx ?(final=(fun() -> ())) f p =
 let catch_exceptions ctx ?(final=(fun() -> ())) f p =
-	let prev = !get_ctx_ref in
+	let prev = !GlobalState.get_ctx_ref in
 	select ctx;
 	select ctx;
 	let eval = get_eval ctx in
 	let eval = get_eval ctx in
 	let env = eval.env in
 	let env = eval.env in
 	let r = try
 	let r = try
 		let v = handle_stack_overflow eval f in
 		let v = handle_stack_overflow eval f in
-		get_ctx_ref := prev;
+		GlobalState.get_ctx_ref := prev;
 		final();
 		final();
 		Some v
 		Some v
 	with
 	with
@@ -144,7 +144,7 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p =
 		if is v key_haxe_macro_Error then begin
 		if is v key_haxe_macro_Error then begin
 			let v1 = field v key_message in
 			let v1 = field v key_message in
 			let v2 = field v key_pos in
 			let v2 = field v key_pos in
-			get_ctx_ref := prev;
+			GlobalState.get_ctx_ref := prev;
 			final();
 			final();
 			match v1,v2 with
 			match v1,v2 with
 				| VString s,VInstance {ikind = IPos p} ->
 				| 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. *)
 				| _ :: l -> l (* Otherwise, ignore topmost frame position. *)
 			in
 			in
 			let msg = get_exc_error_message ctx v stack (if p' = null_pos then p else p') 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();
 			final();
 			Error.error msg null_pos
 			Error.error msg null_pos
 		end
 		end
@@ -167,7 +167,7 @@ let catch_exceptions ctx ?(final=(fun() -> ())) f p =
 		final();
 		final();
 		None
 		None
 	| exc ->
 	| exc ->
-		get_ctx_ref := prev;
+		GlobalState.get_ctx_ref := prev;
 		final();
 		final();
 		raise exc
 		raise exc
 	in
 	in

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

@@ -36,17 +36,10 @@ open MacroApi
 
 
 (* Create *)
 (* 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 create com api is_macro =
 	let t = Timer.timer [(if is_macro then "macro" else "interp");"create"] in
 	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 ->
 		| None ->
 			let builtins = {
 			let builtins = {
 				static_builtins = IntMap.empty;
 				static_builtins = IntMap.empty;
@@ -55,12 +48,12 @@ let create com api is_macro =
 				empty_constructor_builtins = Hashtbl.create 0;
 				empty_constructor_builtins = Hashtbl.create 0;
 			} in
 			} in
 			EvalStdLib.init_standard_library builtins;
 			EvalStdLib.init_standard_library builtins;
-			stdlib := Some builtins;
+			GlobalState.stdlib := Some builtins;
 			builtins
 			builtins
 		| Some (builtins) ->
 		| Some (builtins) ->
 			builtins
 			builtins
 	in
 	in
-	let debug = match !debug with
+	let debug = match !GlobalState.debug with
 		| None ->
 		| None ->
 			let support_debugger = Common.defined com Define.EvalDebugger in
 			let support_debugger = Common.defined com Define.EvalDebugger in
 			let socket =
 			let socket =
@@ -93,7 +86,7 @@ let create com api is_macro =
 				exception_mode = CatchUncaught;
 				exception_mode = CatchUncaught;
 				debug_context = new eval_debug_context;
 				debug_context = new eval_debug_context;
 			} in
 			} in
-			debug := Some debug';
+			GlobalState.debug := Some debug';
 			debug'
 			debug'
 		| Some debug ->
 		| Some debug ->
 			debug
 			debug
@@ -107,7 +100,7 @@ let create com api is_macro =
 	let eval = EvalThread.create_eval thread in
 	let eval = EvalThread.create_eval thread in
 	let evals = IntMap.singleton 0 eval in
 	let evals = IntMap.singleton 0 eval in
 	let rec ctx = {
 	let rec ctx = {
-		ctx_id = !sid;
+		ctx_id = !GlobalState.sid;
 		is_macro = is_macro;
 		is_macro = is_macro;
 		debug = debug;
 		debug = debug;
 		detail_times = detail_times;
 		detail_times = detail_times;
@@ -134,11 +127,11 @@ let create com api is_macro =
 		exception_stack = [];
 		exception_stack = [];
 		max_stack_depth = int_of_string (Common.defined_value_safe ~default:"1000" com Define.EvalCallStackDepth);
 		max_stack_depth = int_of_string (Common.defined_value_safe ~default:"1000" com Define.EvalCallStackDepth);
 	} in
 	} 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.
 		(* 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
 		   Note that configuration is shared between macro and interpreter contexts, which is why the check
 		   is governed by a global variable. *)
 		   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
 		 (* 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. *)
 		    first context anyway. *)
 		select ctx;
 		select ctx;
@@ -367,7 +360,7 @@ let setup get_api =
 				exc_string "Invalid expression"
 				exc_string "Invalid expression"
 			in
 			in
 			let v = VFunction (f,b) in
 			let v = VFunction (f,b) in
-			Hashtbl.replace EvalStdLib.macro_lib n v
+			Hashtbl.replace GlobalState.macro_lib n v
 		| _ -> assert false
 		| _ -> assert false
 	) api;
 	) api;
 	Globals.macro_platform := Globals.Eval
 	Globals.macro_platform := Globals.Eval

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

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