From a97dc16a1663212cbfa9af15c41131c5586b6086 Mon Sep 17 00:00:00 2001 From: Yuxiao Mao Date: Mon, 22 Jul 2024 08:46:36 +0200 Subject: [PATCH] [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 --- src/generators/genhl.ml | 22 ++++++++++------------ src/generators/hl2c.ml | 2 +- src/generators/hlcode.ml | 10 +++++----- src/generators/hlinterp.ml | 25 ++++++++++--------------- src/generators/hlopt.ml | 2 +- 5 files changed, 27 insertions(+), 34 deletions(-) diff --git a/src/generators/genhl.ml b/src/generators/genhl.ml index 114ba0bf68c..02e3ab214f8 100644 --- a/src/generators/genhl.ml +++ b/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 diff --git a/src/generators/hl2c.ml b/src/generators/hl2c.ml index e465b7f5116..ced5dd506e6 100644 --- a/src/generators/hl2c.ml +++ b/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) diff --git a/src/generators/hlcode.ml b/src/generators/hlcode.ml index 889015c6795..a0189373f64 100644 --- a/src/generators/hlcode.ml +++ b/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; diff --git a/src/generators/hlinterp.ml b/src/generators/hlinterp.ml index 6ef4201842b..47f9a4c9516 100644 --- a/src/generators/hlinterp.ml +++ b/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); diff --git a/src/generators/hlopt.ml b/src/generators/hlopt.ml index c56b7e5010d..e79e7c7495a 100644 --- a/src/generators/hlopt.ml +++ b/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