[eval] Manually manage call stack for stack overflow (#8316)

* Manage stack overflow

* rename `-D eval-stack-size` to `-D eval-call-stack-depth`

* minor

* actually renamed it

src/core/define.ml

@@ -32,6 +32,7 @@ type strict_defined =
 	| EraseGenerics
 	| EvalDebugger
 	| EvalStack
+	| EvalCallStackDepth
 	| EvalTimes
 	| FastCast
 	| Fdb
@@ -142,9 +143,10 @@ let infos = function
 	| DumpIgnoreVarIds -> "dump_ignore_var_ids",("Remove variable IDs from non-pretty dumps (helps with diff)",[])
 	| DynamicInterfaceClosures -> "dynamic_interface_closures",("Use slow path for interface closures to save space",[Platform Cpp])
 	| EraseGenerics -> "erase_generics",("Erase generic classes on C#",[Platform Cs])
-	| EvalDebugger -> "eval_debugger",("Support debugger in macro/interp mode. Allows host:port value to open a socket. Implies eval_stack.",[])
-	| EvalStack -> "eval_stack",("Record stack information in macro/interp mode",[])
-	| EvalTimes -> "eval_times",("Record per-method execution times in macro/interp mode. Implies eval_stack.",[])
+	| EvalDebugger -> "eval_debugger",("Support debugger in macro/interp mode. Allows host:port value to open a socket. Implies eval_stack.",[Platform Eval])
+	| EvalStack -> "eval_stack",("Record stack information in macro/interp mode",[Platform Eval])
+	| EvalCallStackDepth -> "eval_call_stack_depth",("Set maximum call stack depth for eval. Default: 1000.",[Platform Eval])
+	| EvalTimes -> "eval_times",("Record per-method execution times in macro/interp mode. Implies eval_stack.",[Platform Eval])
 	| FastCast -> "fast_cast",("Enables an experimental casts cleanup on C# and Java",[Platforms [Cs;Java]])
 	| Fdb -> "fdb",("Enable full flash debug infos for FDB interactive debugging",[Platform Flash])
 	| FileExtension -> "file_extension",("Output filename extension for cpp source code",[Platform Cpp])

src/macro/eval/evalContext.ml

@@ -95,6 +95,8 @@ type env = {
 	mutable env_extra_locals : value IntMap.t;
 	(* The parent of the current environment, if exists. *)
 	env_parent : env option;
+	(** Exeucution stack depth *)
+	env_stack_depth : int;
 	env_eval : eval;
 }
 
@@ -258,6 +260,7 @@ and context = {
 	eval : eval;
 	mutable evals : eval IntMap.t;
 	mutable exception_stack : (pos * env_kind) list;
+	max_stack_depth : int;
 }
 
 let get_ctx_ref : (unit -> context) ref = ref (fun() -> assert false)
@@ -396,6 +399,10 @@ let push_environment ctx info num_locals num_captures =
 	else
 		Array.make num_captures vnull
 	in
+	let stack_depth = match eval.env with
+		| None -> 1;
+		| Some env -> env.env_stack_depth + 1
+	in
 	let env = {
 		env_info = info;
 		env_leave_pmin = 0;
@@ -406,6 +413,7 @@ let push_environment ctx info num_locals num_captures =
 		env_extra_locals = IntMap.empty;
 		env_parent = eval.env;
 		env_eval = eval;
+		env_stack_depth = stack_depth;
 	} in
 	eval.env <- Some env;
 	begin match ctx.debug.debug_socket,env.env_info.kind with

src/macro/eval/evalEmitter.ml

@@ -66,6 +66,10 @@ let decode_int_p v p = match v with
 	| VFloat f -> int_of_float f
 	| _ -> unexpected_value_p v "int" p
 
+let check_stack_depth env =
+	if env.env_stack_depth > (get_ctx()).max_stack_depth then
+		exc_string "Stack overflow"
+
 (* Emitter *)
 
 let apply env exec =
@@ -282,6 +286,7 @@ let emit_safe_cast exec t p env =
 (* super.call() - immediate *)
 
 let emit_super_field_call slot proto i execs p env =
+	check_stack_depth env;
 	let vthis = env.env_locals.(slot) in
 	let vf = proto.pfields.(i) in
 	let vl = List.map (apply env) execs in
@@ -290,6 +295,7 @@ let emit_super_field_call slot proto i execs p env =
 (* Type.call() - immediate *)
 
 let emit_proto_field_call v execs p env =
+	check_stack_depth env;
 	let f = Lazy.force v in
 	let vl = List.map (apply env) execs in
 	env.env_leave_pmin <- p.pmin;
@@ -306,6 +312,7 @@ let get_prototype v p = match vresolve v with
 	| _ -> unexpected_value_p v "instance" p
 
 let emit_method_call exec name execs p env =
+	check_stack_depth env;
 	let vthis = exec env in
 	let proto = get_prototype vthis p in
 	let vf = try proto_field_raise proto name with Not_found -> throw_string (Printf.sprintf "Field %s not found on prototype %s" (rev_hash name) (rev_hash proto.ppath)) p in
@@ -317,6 +324,7 @@ let emit_method_call exec name execs p env =
 (* instance.call() where call is not a method - lookup + this-binding *)
 
 let emit_field_call exec name execs p env =
+	check_stack_depth env;
 	let vthis = exec env in
 	let vf = field vthis name in
 	env.env_leave_pmin <- p.pmin;
@@ -326,6 +334,7 @@ let emit_field_call exec name execs p env =
 (* new() - immediate + this-binding *)
 
 let emit_constructor_call proto v execs p env =
+	check_stack_depth env;
 	let f = Lazy.force v in
 	let vthis = create_instance_direct proto INormal in
 	let vl = List.map (apply env) execs in
@@ -337,6 +346,7 @@ let emit_constructor_call proto v execs p env =
 (* super() - immediate + this-binding *)
 
 let emit_special_super_call fnew execs env =
+	check_stack_depth env;
 	let vl = List.map (apply env) execs in
 	let vi' = fnew vl in
 	let vthis = env.env_locals.(0) in
@@ -348,6 +358,7 @@ let emit_special_super_call fnew execs env =
 	vnull
 
 let emit_super_call v execs p env =
+	check_stack_depth env;
 	let f = Lazy.force v in
 	let vthis = env.env_locals.(0) in
 	let vl = List.map (apply env) execs in
@@ -359,6 +370,7 @@ let emit_super_call v execs p env =
 (* unknown call - full lookup *)
 
 let emit_call exec execs p env =
+	check_stack_depth env;
 	let v1 = exec env in
 	env.env_leave_pmin <- p.pmin;
 	env.env_leave_pmax <- p.pmax;
@@ -730,14 +742,6 @@ let process_arguments fl vl env =
 	loop fl vl
 [@@inline]
 
-let emit_function_ret ctx eci refs exec fl vl =
-	let env = push_environment ctx eci.ec_info eci.ec_num_locals eci.ec_num_captures in
-	Array.iter (fun (i,vr) -> env.env_captures.(i) <- vr) refs;
-	process_arguments fl vl env;
-	let v = try exec env with Return v -> v in
-	pop_environment ctx env;
-	v
-
 let create_function_noret ctx eci exec fl vl =
 	let env = push_environment ctx eci.ec_info eci.ec_num_locals eci.ec_num_captures in
 	process_arguments fl vl env;

src/macro/eval/evalMain.ml

@@ -133,6 +133,7 @@ let create com api is_macro =
 		eval = eval;
 		evals = evals;
 		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
 		(* Let's wait till the debugger says we're good to continue. This allows it to finish configuration.

tests/misc/projects/Issue8303/Main.hx

@@ -0,0 +1,13 @@
+class Main {
+	public static function main():Void {
+		test();
+	}
+
+	static function test() {
+		function log() {
+			log();
+		}
+		log();
+		return macro {};
+	}
+}

tests/misc/projects/Issue8303/MainCatch.hx

@@ -0,0 +1,19 @@
+class MainCatch {
+	public static function main():Void {
+		test();
+	}
+
+	static function test() {
+		function log() {
+			log();
+		}
+		try {
+			log();
+		} catch(s:String) {
+			if(s != 'Stack overflow') {
+				Sys.exit(1);
+			}
+		}
+		return macro {};
+	}
+}

tests/misc/projects/Issue8303/compile-fail.hxml

@@ -0,0 +1,3 @@
+-main Main
+-D eval-call-stack-depth=5
+--interp

tests/misc/projects/Issue8303/compile-fail.hxml.stderr

@@ -0,0 +1,6 @@
+Uncaught exception Stack overflow
+Main.hx:1: character 1 : Called from here
+Main.hx:8: characters 4-9 : Called from here
+Main.hx:8: characters 4-9 : Called from here
+Main.hx:10: characters 3-8 : Called from here
+Main.hx:3: characters 3-9 : Called from here

tests/misc/projects/Issue8303/compile.hxml

@@ -0,0 +1,3 @@
+-main MainCatch
+-D eval-call-stack-depth=5
+--interp