Browse Source

[server] clean up some memory-related problems

Simon Krajewski 6 years ago
parent
commit
db9956fe72

+ 1 - 0
src/context/display/deprecationCheck.ml

@@ -90,6 +90,7 @@ let run com =
 			(match c.cl_init with None -> () | Some e -> run_on_expr com e);
 			List.iter (run_on_field com) c.cl_ordered_statics;
 			List.iter (run_on_field com) c.cl_ordered_fields;
+			curclass := null_class;
 		| _ ->
 			()
 	) com.types

+ 7 - 5
src/macro/eval/evalContext.ml

@@ -18,7 +18,6 @@
  *)
 
 open Globals
-open Type
 open EvalValue
 open EvalHash
 open EvalString
@@ -71,7 +70,9 @@ type env_debug = {
 	(* The current line being executed. This in conjunction with `env_info.pfile` is used to find breakpoints. *)
 	mutable line : int;
 	(* The current expression being executed *)
-	mutable expr : texpr;
+	mutable debug_expr : string;
+	(* The current expression position being executed *)
+	mutable debug_pos : pos;
 }
 
 (* An environment in which code is executed. Environments are created whenever a function is called and when
@@ -155,7 +156,7 @@ type builtins = {
 }
 
 type debug_scope_info = {
-	ds_expr : texpr;
+	ds_expr : string;
 	ds_return : value option;
 }
 
@@ -385,13 +386,14 @@ let flush_core_context f =
 
 let no_timer = fun () -> ()
 let empty_array = [||]
-let no_expr = mk (TConst TNull) t_dynamic null_pos
+let no_expr = ""
 
 let no_debug = {
 	timer = no_timer;
 	scopes = [];
 	line = 0;
-	expr = no_expr;
+	debug_expr = no_expr;
+	debug_pos = null_pos;
 }
 
 let create_env_info static pfile kind capture_infos =

+ 3 - 2
src/macro/eval/evalDebug.ml

@@ -31,7 +31,7 @@ let rec run_loop run env : value =
 			check_breakpoint();
 			run env
 		| DbgNext(env',p) ->
-			let b = DisplayPosition.encloses_position (env.env_debug.expr.epos) p in
+			let b = DisplayPosition.encloses_position (env.env_debug.debug_pos) p in
 			let rec is_on_stack env =
 				match env.env_parent with
 				| Some env -> env == env' || is_on_stack env
@@ -116,7 +116,8 @@ let debug_loop jit conn e f =
 	let run_set env =
 		env.env_debug.scopes <- scopes;
 		env.env_debug.line <- line;
-		env.env_debug.expr <- e;
+		env.env_debug.debug_pos <- e.epos;
+		env.env_debug.debug_expr <- s_expr_pretty e;
 		run_loop run_check_breakpoint env;
 	in
 	run_set

+ 1 - 1
src/macro/eval/evalDebugMisc.ml

@@ -93,7 +93,7 @@ let get_var_slot_by_name env is_read scopes name =
 				let id = Hashtbl.find scope.local_ids name in
 				let slot = Hashtbl.find scope.locals id in
 				let vi = Hashtbl.find scope.local_infos slot in
-				if is_read && not (declared_before vi env.env_debug.expr.epos) then raise Not_found;
+				if is_read && not (declared_before vi env.env_debug.debug_pos) then raise Not_found;
 				slot + scope.local_offset
 			with Not_found ->
 				loop scopes

+ 7 - 7
src/macro/eval/evalDebugSocket.ml

@@ -199,7 +199,7 @@ let output_scopes ctx env =
 		scopes
 	else begin
 		let dbg = {
-			ds_expr = env.env_debug.expr;
+			ds_expr = env.env_debug.debug_expr;
 			ds_return = env.env_eval.last_return;
 		} in
 		(mk_scope (ctx.debug.debug_context#add_debug_scope dbg env) "Eval" null_pos) :: scopes
@@ -217,13 +217,13 @@ let output_capture_vars infos env =
 
 let output_debug_scope dbg env =
 	let ja = [
-		var_to_json "expr" (VString (EvalString.create_ascii (Type.s_expr_pretty true "" false (s_type (print_context())) env.env_debug.expr))) None env;
+		var_to_json "expr" (VString (EvalString.create_ascii env.env_debug.debug_expr)) None env;
 		var_to_json "last return" (match dbg.ds_return with None -> vnull | Some v -> v) None env;
 	] in
 	JArray ja
 
 let output_scope_vars env scope =
-	let p = env.env_debug.expr.epos in
+	let p = env.env_debug.debug_pos in
 	let vars = Hashtbl.fold (fun local_slot vi acc ->
 		if declared_before vi p then begin
 			let slot = local_slot + scope.local_offset in
@@ -548,7 +548,7 @@ let handler =
 		"next",(fun hctx ->
 			let eval = select_thread hctx in
 			let env = expect_env hctx eval.env in
-			eval.debug_state <- DbgNext(env,env.env_debug.expr.epos);
+			eval.debug_state <- DbgNext(env,env.env_debug.debug_pos);
 			ignore(Event.poll (Event.send eval.debug_channel ()));
 			JNull
 		);
@@ -566,7 +566,7 @@ let handler =
 		"stackTrace",(fun hctx ->
 			let eval = select_thread hctx in
 			let env = expect_env hctx eval.env in
-			output_call_stack hctx.ctx eval env.env_debug.expr.epos
+			output_call_stack hctx.ctx eval env.env_debug.debug_pos
 		);
 		"getScopes",(fun hctx ->
 			let env = select_frame hctx in
@@ -660,7 +660,7 @@ let handler =
 			let name = hctx.jsonrpc#get_string_param "name" in
 			let value = hctx.jsonrpc#get_string_param "value" in
 			let get_value env = try
-				let e = parse_expr hctx.ctx value env.env_debug.expr.epos in
+				let e = parse_expr hctx.ctx value env.env_debug.debug_pos in
 				expr_to_value hctx.ctx env e
 			with Parse_expr_error e ->
 				hctx.send_error e
@@ -711,7 +711,7 @@ let handler =
 			let env = try select_frame hctx with _ -> expect_env hctx ctx.eval.env in
 			let s = hctx.jsonrpc#get_string_param "expr" in
 			begin try
-				let e = parse_expr ctx s env.env_debug.expr.epos in
+				let e = parse_expr ctx s env.env_debug.debug_pos in
 				let v = handle_in_temp_thread ctx env (fun () -> expr_to_value ctx env e) in
 				var_to_json "" v None env
 			with

+ 1 - 0
std/haxe/display/Server.hx

@@ -119,6 +119,7 @@ typedef HaxeMemoryResult = {
 		final nativeLibCache:Int;
 		final macroInterpreter:Int;
 		final completionResult:Int;
+		final ?additionalSizes:Array<{name:String, size:Int}>;
 	}
 }