Skip to content

Commit

Permalink
[hl] Fix -D hl-check error pos and cleanup is_macro (#11727)
Browse files Browse the repository at this point in the history
* [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
  • Loading branch information
yuxiaomao authored Jul 22, 2024
1 parent 6ac4f47 commit a97dc16
Show file tree
Hide file tree
Showing 5 changed files with 27 additions and 34 deletions.
22 changes: 10 additions & 12 deletions src/generators/genhl.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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;
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -340,20 +339,20 @@ 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
let out = Array.make (DynArray.length arr) !pos in
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;
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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
Expand All @@ -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;
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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;
Expand All @@ -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

Expand Down
2 changes: 1 addition & 1 deletion src/generators/hl2c.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
10 changes: 5 additions & 5 deletions src/generators/hlcode.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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;
}

Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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;
Expand Down
25 changes: 10 additions & 15 deletions src/generators/hlinterp.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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);
Expand Down
2 changes: 1 addition & 1 deletion src/generators/hlopt.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down

0 comments on commit a97dc16

Please sign in to comment.