cache friendly debug line calculus (fixed)

src/generators/genhl.ml

@@ -51,7 +51,7 @@ type method_context = {
 	mregs : (int, ttype) lookup;
 	mops : opcode DynArray.t;
 	mret : ttype;
-	mdebug : (int * int) DynArray.t;
+	mdebug : Globals.pos DynArray.t;
 	mvars : (int, tvar) Hashtbl.t;
 	mutable mallocs : (ttype, allocator) PMap.t;
 	mutable mcaptured : method_capture;
@@ -59,7 +59,7 @@ type method_context = {
 	mutable mbreaks : (int -> unit) list;
 	mutable mtrys : int;
 	mutable mcaptreg : int;
-	mutable mcurpos : (int * int);
+	mutable mcurpos : Globals.pos;
 }
 
 type array_impl = {
@@ -206,7 +206,7 @@ let method_context id t captured =
 		mtrys = 0;
 		mcaptreg = 0;
 		mdebug = DynArray.create();
-		mcurpos = (0,0);
+		mcurpos = Globals.null_pos;
 	}
 
 let field_name c f =
@@ -265,7 +265,10 @@ let unsigned_op e1 e2 =
 	is_unsigned e1 && is_unsigned e2
 
 let set_curpos ctx p =
-	let get_relative_path() =
+	ctx.m.mcurpos <- p
+
+let make_debug ctx arr =
+	let get_relative_path p =
 		match Common.defined ctx.com Common.Define.AbsolutePath with
 		| true -> if (Filename.is_relative p.pfile)
 			then Filename.concat (Sys.getcwd()) p.pfile
@@ -282,7 +285,26 @@ let set_curpos ctx p =
 		with Not_found ->
 			p.pfile
 	in
-	ctx.m.mcurpos <- (lookup ctx.cdebug_files p.pfile get_relative_path,Lexer.get_error_line p)
+	let pos = ref (0,0) 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() -> 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);
+			end;
+			cur := p;
+		end;
+		Array.unsafe_set out i !pos
+	done;
+	out
 
 let rec to_type ?tref ctx t =
 	match t with
@@ -2558,7 +2580,7 @@ and gen_method_wrapper ctx rt t p =
 			ftype = HFun (rt :: targs, tret);
 			regs = DynArray.to_array ctx.m.mregs.arr;
 			code = DynArray.to_array ctx.m.mops;
-			debug = DynArray.to_array ctx.m.mdebug;
+			debug = make_debug ctx ctx.m.mdebug;
 		} in
 		ctx.m <- old;
 		DynArray.add ctx.cfunctions f;
@@ -2697,7 +2719,7 @@ and make_fun ?gen_content ctx name fidx f cthis cparent =
 		ftype = HFun (fargs, tret);
 		regs = DynArray.to_array ctx.m.mregs.arr;
 		code = DynArray.to_array ctx.m.mops;
-		debug = DynArray.to_array ctx.m.mdebug;
+		debug = make_debug ctx ctx.m.mdebug;
 	} in
 	ctx.m <- old;
 	Hashtbl.add ctx.defined_funs fidx ();

src/syntax/lexer.mll

@@ -50,6 +50,8 @@ type lexer_file = {
 	mutable llines : (int * int) list;
 	mutable lalines : (int * int) array;
 	mutable lstrings : int list;
+	mutable llast : int;
+	mutable llastindex : int;
 }
 
 let make_file file =
@@ -60,6 +62,8 @@ let make_file file =
 		llines = [0,1];
 		lalines = [|0,1|];
 		lstrings = [];
+		llast = max_int;
+		llastindex = 0;
 	}
 
 
@@ -135,18 +139,27 @@ let find_line p f =
 	if f.lmaxline <> f.lline then begin
 		f.lmaxline <- f.lline;
 		f.lalines <- Array.of_list (List.rev f.llines);
+		f.llast <- max_int;
+		f.llastindex <- 0;
 	end;
 	let rec loop min max =
 		let med = (min + max) lsr 1 in
 		let lp, line = Array.unsafe_get f.lalines med in
-		if med = min then
+		if med = min then begin
+			f.llast <- p;
+			f.llastindex <- med;
 			line, p - lp
-		else if lp > p then
+		end else if lp > p then
 			loop min med
 		else
 			loop med max
 	in
-	loop 0 (Array.length f.lalines)
+	if p >= f.llast then begin
+		let lp, line = Array.unsafe_get f.lalines f.llastindex in
+		let lp2, _ = Array.unsafe_get f.lalines (f.llastindex + 1) in
+		if p >= lp && p < lp2 then line, p - lp else loop 0 (Array.length f.lalines)
+	end else
+		loop 0 (Array.length f.lalines)
 
 (* resolve a position within a non-haxe file by counting newlines *)
 let resolve_pos file =