|
@@ -2015,7 +2015,7 @@ let add_code ctx code =
|
|
|
|
|
|
(* ------------------------------- CHECK ---------------------------------------------- *)
|
|
(* ------------------------------- CHECK ---------------------------------------------- *)
|
|
|
|
|
|
-let check code =
|
|
|
|
|
|
+let check code macros =
|
|
let ftypes = Array.create (Array.length code.natives + Array.length code.functions) HVoid in
|
|
let ftypes = Array.create (Array.length code.natives + Array.length code.functions) HVoid in
|
|
let is_native_fun = Hashtbl.create 0 in
|
|
let is_native_fun = Hashtbl.create 0 in
|
|
|
|
|
|
@@ -2023,7 +2023,18 @@ let check code =
|
|
let pos = ref 0 in
|
|
let pos = ref 0 in
|
|
let error msg =
|
|
let error msg =
|
|
let dfile, dline = f.debug.(!pos) in
|
|
let dfile, dline = f.debug.(!pos) in
|
|
- failwith (Printf.sprintf "\n%s:%d: Check failure at %d@x%x - %s" code.debugfiles.(dfile) dline f.findex (!pos) msg)
|
|
|
|
|
|
+ let file = code.debugfiles.(dfile) 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
|
|
|
|
+ Common.abort msg pos
|
|
|
|
+ end else
|
|
|
|
+ failwith (Printf.sprintf "\n%s:%d: %s" file dline msg)
|
|
in
|
|
in
|
|
let targs, tret = (match f.ftype with HFun (args,ret) -> args, ret | _ -> assert false) in
|
|
let targs, tret = (match f.ftype with HFun (args,ret) -> args, ret | _ -> assert false) in
|
|
let rtype i = try f.regs.(i) with _ -> HObj { null_proto with pname = "OUT_OF_BOUNDS:" ^ string_of_int i } in
|
|
let rtype i = try f.regs.(i) with _ -> HObj { null_proto with pname = "OUT_OF_BOUNDS:" ^ string_of_int i } in
|