Browse Source

[hl] Fix -D hl-check error pos and cleanup is_macro (#11727)

* [hl] add pos to debug info and fix hl-check error display

* [hl] cleanup ctx.is_macro as it's always false

* [hl] cleanup Hlinterp.check macro as it's always false
Yuxiao Mao 1 year ago
parent
commit
a97dc16a16
5 changed files with 27 additions and 34 deletions
  1. 10 12
      src/generators/genhl.ml
  2. 1 1
      src/generators/hl2c.ml
  3. 5 5
      src/generators/hlcode.ml
  4. 10 15
      src/generators/hlinterp.ml
  5. 1 1
      src/generators/hlopt.ml

+ 10 - 12
src/generators/genhl.ml

@@ -98,7 +98,6 @@ type context = {
 	w_null_compare : bool;
 	overrides : (string * path, bool) Hashtbl.t;
 	defined_funs : (int,unit) Hashtbl.t;
-	is_macro : bool;
 	mutable dump_out : (unit IO.output) option;
 	mutable cached_types : (string list, ttype) PMap.t;
 	mutable m : method_context;
@@ -264,7 +263,7 @@ let global_type ctx g =
 	DynArray.get ctx.cglobals.arr g
 
 let is_overridden ctx c f =
-	ctx.is_macro || Hashtbl.mem ctx.overrides (f.cf_name,c.cl_path)
+	Hashtbl.mem ctx.overrides (f.cf_name,c.cl_path)
 
 let alloc_float ctx f =
 	lookup ctx.cfloats f (fun() -> f)
@@ -340,7 +339,7 @@ let make_debug ctx arr =
 		with Not_found ->
 			p.pfile
 	in
-	let pos = ref (0,0) in
+	let pos = ref (0,0,Globals.null_pos) in
 	let cur_file = ref 0 in
 	let cur_line = ref 0 in
 	let cur = ref Globals.null_pos in
@@ -348,12 +347,12 @@ let make_debug ctx arr =
 	for i = 0 to DynArray.length arr - 1 do
 		let p = DynArray.unsafe_get arr i in
 		if p != !cur then begin
-			let file = if p.pfile == (!cur).pfile then !cur_file else lookup ctx.cdebug_files p.pfile (fun() -> if ctx.is_macro then p.pfile else get_relative_path p) in
-			let line = if ctx.is_macro then p.pmin lor ((p.pmax - p.pmin) lsl 20) else Lexer.get_error_line p in
+			let file = if p.pfile == (!cur).pfile then !cur_file else lookup ctx.cdebug_files p.pfile (fun() -> get_relative_path p) in
+			let line = Lexer.get_error_line p in
 			if line <> !cur_line || file <> !cur_file then begin
 				cur_file := file;
 				cur_line := line;
-				pos := (file,line);
+				pos := (file,line,p);
 			end;
 			cur := p;
 		end;
@@ -4046,7 +4045,7 @@ let write_code ch code debug =
 				end
 			end
 		in
-		Array.iter (fun (f,p) ->
+		Array.iter (fun (f,p,_) ->
 			if f <> !curfile then begin
 				flush_repeat(p);
 				curfile := f;
@@ -4101,7 +4100,7 @@ let write_code ch code debug =
 
 (* --------------------------------------------------------------------------------------------------------------------- *)
 
-let create_context com is_macro dump =
+let create_context com dump =
 	let get_type name =
 		try
 			List.find (fun t -> (t_infos t).mt_path = (["hl"],name)) com.types
@@ -4122,7 +4121,6 @@ let create_context com is_macro dump =
 	in
 	let ctx = {
 		com = com;
-		is_macro = is_macro;
 		optimize = not (Common.raw_defined com "hl_no_opt");
 		w_null_compare = Common.raw_defined com "hl_w_null_compare";
 		dump_out = if dump then Some (IO.output_channel (open_out_bin "dump/hlopt.txt")) else None;
@@ -4184,7 +4182,7 @@ let add_types ctx types =
 				| _ ->
 					false
 			in
-			if not ctx.is_macro then List.iter (fun f -> if has_class_field_flag f CfOverride then ignore(loop c.cl_super f)) c.cl_ordered_fields;
+			List.iter (fun f -> if has_class_field_flag f CfOverride then ignore(loop c.cl_super f)) c.cl_ordered_fields;
 			List.iter (fun (m,args,p) ->
 				if m = Meta.HlNative then
 					let lib, prefix = (match args with
@@ -4254,7 +4252,7 @@ let generate com =
 		close_out ch;
 	end else
 
-	let ctx = create_context com false dump in
+	let ctx = create_context com dump in
 	add_types ctx com.types;
 	let code = build_code ctx com.types com.main.main_expr in
 	Array.sort (fun (lib1,_,_,_) (lib2,_,_,_) -> lib1 - lib2) code.natives;
@@ -4277,7 +4275,7 @@ let generate com =
 	end;*)
 	if hl_check then begin
 		check ctx;
-		Hlinterp.check code false;
+		Hlinterp.check com.error code;
 	end;
 	let t = Timer.timer ["generate";"hl";"write"] in
 

+ 1 - 1
src/generators/hl2c.ml

@@ -1796,7 +1796,7 @@ let write_c com file (code:code) gnames =
 			let file_pos f =
 				match f.fe_decl with
 				| Some f when Array.length f.debug > 0 ->
-					let fid, p = f.debug.(Array.length f.debug - 1) in
+					let fid, p, _ = f.debug.(Array.length f.debug - 1) in
 					(code.strings.(fid), p)
 				| _ ->
 					("",0)

+ 5 - 5
src/generators/hlcode.ml

@@ -210,7 +210,7 @@ type fundecl = {
 	ftype : ttype;
 	regs : ttype array;
 	code : opcode array;
-	debug : (int * int) array;
+	debug : (int * int * Globals.pos) array;
 	assigns : (string index * int) array;
 }
 
@@ -617,7 +617,7 @@ let dump pr code =
 		with _ ->
 			Printf.sprintf "f@%X" fid
 	in
-	let debug_infos (fid,line) =
+	let debug_infos (fid,line,_) =
 		(try code.debugfiles.(fid) with _ -> "???") ^ ":" ^ string_of_int line
 	in
 	pr ("hl v" ^ string_of_int code.version);
@@ -651,17 +651,17 @@ let dump pr code =
 	pr (string_of_int (Array.length code.functions) ^ " functions");
 	Array.iter (fun f ->
 		pr (Printf.sprintf "	fun@%d(%Xh) %s" f.findex f.findex (tstr f.ftype));
-		let fid, _ = f.debug.(0) in
+		let fid, _, _ = f.debug.(0) in
 		let cur_fid = ref fid in
 		pr (Printf.sprintf "	; %s (%s)" (debug_infos f.debug.(0)) (fundecl_name f));
 		Array.iteri (fun i r ->
 			pr ("		r" ^ string_of_int i ^ " " ^ tstr r);
 		) f.regs;
 		Array.iteri (fun i o ->
-			let fid, line = f.debug.(i) in
+			let fid, line, _ = f.debug.(i) in
 			if fid <> !cur_fid then begin
 				cur_fid := fid;
-				pr (Printf.sprintf "	; %s" (debug_infos (fid,line)));
+				pr (Printf.sprintf "	; %s" (debug_infos f.debug.(i)));
 			end;
 			pr (Printf.sprintf "		.%-5d @%X %s" line i (ostr fstr o))
 		) f.code;

+ 10 - 15
src/generators/hlinterp.ml

@@ -666,7 +666,7 @@ let rec dyn_set_field ctx obj field v vt =
 
 let make_stack ctx (f,pos) =
 	let pos = !pos - 1 in
-	try let fid, line = f.debug.(pos) in ctx.code.debugfiles.(fid), line with _ -> "???", 0
+	try let fid, line, _ = f.debug.(pos) in ctx.code.debugfiles.(fid), line with _ -> "???", 0
 
 let stack_frame ctx (f,pos) =
 	let file, line = make_stack ctx (f,pos) in
@@ -2183,26 +2183,21 @@ let add_code ctx code =
 
 (* ------------------------------- CHECK ---------------------------------------------- *)
 
-let check code macros =
+let check comerror code =
 	let ftypes = Array.make (Array.length code.natives + Array.length code.functions) HVoid in
 	let is_native_fun = Hashtbl.create 0 in
 
 	let check_fun f =
 		let pos = ref 0 in
 		let error msg =
-			let dfile, dline = f.debug.(!pos) in
-			let file = code.debugfiles.(dfile) in
+			let _, _, dpos = f.debug.(!pos) in
 			let msg = Printf.sprintf "Check failure at fun@%d @%X - %s" f.findex (!pos) msg in
-			if macros then begin
-				let low = dline land 0xFFFFF in
-				let pos = {
-					Globals.pfile = file;
-					Globals.pmin = low;
-					Globals.pmax = low + (dline lsr 20);
-				} in
-				Error.abort msg pos
-			end else
-				failwith (Printf.sprintf "\n%s:%d: %s" file dline msg)
+			comerror msg dpos;
+			()
+		in
+		let error_fail msg =
+			error msg;
+			failwith msg
 		in
 		let targs, tret = (match f.ftype with HFun (args,ret) -> args, ret | _ -> Globals.die "" __LOC__) in
 		let rtype i = try f.regs.(i) with _ -> HObj { null_proto with pname = "OUT_OF_BOUNDS:" ^ string_of_int i } in
@@ -2256,7 +2251,7 @@ let check code macros =
 			if not (is_dynamic (rtype r)) then error (reg_inf r ^ " should be castable to dynamic")
 		in
 		let get_field r p fid =
-			try snd (resolve_field p fid) with Not_found -> error (reg_inf r ^ " does not have field " ^ string_of_int fid)
+			try snd (resolve_field p fid) with Not_found -> error_fail (reg_inf r ^ " does not have field " ^ string_of_int fid)
 		in
 		let tfield o fid proto =
 			if fid < 0 then error (reg_inf o ^ " does not have " ^ (if proto then "proto " else "") ^ "field " ^ string_of_int fid);

+ 1 - 1
src/generators/hlopt.ml

@@ -684,7 +684,7 @@ let remap_fun ctx f dump get_str old_code =
 		let jumps = ref [] in
 		let out_pos = ref 0 in
 		let out_code = Array.make (Array.length f.code - ctx.r_nop_count) (ONop "") in
-		let new_debug = Array.make (Array.length f.code - ctx.r_nop_count) (0,0) in
+		let new_debug = Array.make (Array.length f.code - ctx.r_nop_count) (0,0,Globals.null_pos) in
 		Array.iteri (fun i op ->
 			Array.unsafe_set new_pos i !out_pos;
 			match op with