Explorar el Código

add local vars assign as part of debug information

Nicolas Cannasse hace 7 años
padre
commit
97527dff23
Se han modificado 3 ficheros con 37 adiciones y 51 borrados
  1. 29 50
      src/generators/genhl.ml
  2. 1 0
      src/generators/hlcode.ml
  3. 7 1
      src/generators/hlopt.ml

+ 29 - 50
src/generators/genhl.ml

@@ -46,7 +46,7 @@ type allocator = {
 	mutable a_hold : int list;
 }
 
-type lassign = (string index * int * int)
+type lassign = (string index * int)
 
 type method_context = {
 	mid : int;
@@ -108,8 +108,6 @@ type context = {
 	core_enum : tclass;
 	ref_abstract : tabstract;
 	cdebug_files : (string, string) lookup;
-	cdebug_locals : (string, string ) lookup;
-	cdebug_assigns : (lassign array) DynArray.t;
 }
 
 (* --- *)
@@ -827,10 +825,13 @@ let op ctx o =
 		DynArray.add ctx.m.mdebug ctx.m.mcurpos;
 		DynArray.add ctx.m.mops o
 
+let set_op ctx pos o =
+	DynArray.set ctx.m.mops pos o
+
 let jump ctx f =
 	let pos = current_pos ctx in
 	op ctx (OJAlways (-1)); (* loop *)
-	(fun() -> DynArray.set ctx.m.mops pos (f (current_pos ctx - pos - 1)))
+	(fun() -> set_op ctx pos (f (current_pos ctx - pos - 1)))
 
 let jump_back ctx =
 	let pos = current_pos ctx in
@@ -928,14 +929,14 @@ let real_name v =
 	in
 	loop v.v_meta
 
-let add_assign ctx v r =
+let add_assign ctx v =
 	let name = real_name v in
-	ctx.m.massign <- (lookup ctx.cdebug_locals name (fun() -> name), DynArray.length ctx.m.mops, r) :: ctx.m.massign
+	ctx.m.massign <- (alloc_string ctx name, current_pos ctx - 1) :: ctx.m.massign
 
 let add_capture ctx r =
 	Array.iter (fun v ->
 		let name = real_name v in
-		ctx.m.massign <- (lookup ctx.cdebug_locals name (fun() -> name), -1, r) :: ctx.m.massign
+		ctx.m.massign <- (alloc_string ctx name, -(r+2)) :: ctx.m.massign
 	) ctx.m.mcaptured.c_vars
 
 let before_return ctx =
@@ -1454,7 +1455,7 @@ and eval_expr ctx e =
 			| None ->
 				let r = alloc_var ctx v true in
 				op ctx (OMov (r,ri));
-				add_assign ctx v r;
+				add_assign ctx v;
 			| Some idx ->
 				op ctx (OSetEnumField (ctx.m.mcaptreg, idx, ri));
 		);
@@ -2235,7 +2236,7 @@ and eval_expr ctx e =
 			| ALocal (v,l) ->
 				let r = value() in
 				op ctx (OMov (l, r));
-				add_assign ctx v l;
+				add_assign ctx v;
 				r
 			| AArray (ra,(at,vt),ridx) ->
 				hold ctx ra;
@@ -2307,7 +2308,6 @@ and eval_expr ctx e =
 			| ALocal (v,l) ->
 				let r = eval_to ctx { e with eexpr = TBinop (bop,e1,e2) } (to_type ctx e1.etype) in
 				op ctx (OMov (l, r));
-				add_assign ctx v l;
 				r
 			| acc ->
 				gen_assign_op ctx acc e1 (fun r ->
@@ -2369,13 +2369,11 @@ and eval_expr ctx e =
 		(match get_access ctx v, fix with
 		| ALocal (v,r), Prefix ->
 			unop r;
-			add_assign ctx v r;
 			r
 		| ALocal (v,r), Postfix ->
 			let r2 = alloc_tmp ctx (rtype ctx r) in
 			op ctx (OMov (r2,r));
 			unop r;
-			add_assign ctx v r;
 			r2
 		| acc, _ ->
 			let ret = ref 0 in
@@ -2576,7 +2574,7 @@ and eval_expr ctx e =
 				if rt <> HVoid then op ctx (OMov (r,re));
 				jends := jump ctx (fun i -> OJAlways i) :: !jends
 			) cases;
-			DynArray.set ctx.m.mops (switch_pos - 1) (OSwitch (ridx,indexes,current_pos ctx - switch_pos));
+			set_op ctx (switch_pos - 1) (OSwitch (ridx,indexes,current_pos ctx - switch_pos));
 			List.iter (fun j -> j()) (!jends);
 		with Exit ->
 			let jends = ref [] in
@@ -2649,13 +2647,13 @@ and eval_expr ctx e =
 		before_break_continue ctx;
 		let pos = current_pos ctx in
 		op ctx (OJAlways (-1)); (* loop *)
-		ctx.m.mcontinues <- (fun target -> DynArray.set ctx.m.mops pos (OJAlways (target - (pos + 1)))) :: ctx.m.mcontinues;
+		ctx.m.mcontinues <- (fun target -> set_op ctx pos (OJAlways (target - (pos + 1)))) :: ctx.m.mcontinues;
 		alloc_tmp ctx HVoid
 	| TBreak ->
 		before_break_continue ctx;
 		let pos = current_pos ctx in
 		op ctx (OJAlways (-1)); (* loop *)
-		ctx.m.mbreaks <- (fun target -> DynArray.set ctx.m.mops pos (OJAlways (target - (pos + 1)))) :: ctx.m.mbreaks;
+		ctx.m.mbreaks <- (fun target -> set_op ctx pos (OJAlways (target - (pos + 1)))) :: ctx.m.mbreaks;
 		alloc_tmp ctx HVoid
 	| TTry (etry,catches) ->
 		let pos = current_pos ctx in
@@ -2669,7 +2667,7 @@ and eval_expr ctx e =
 		ctx.m.mtrys <- ctx.m.mtrys - 1;
 		op ctx (OEndTrap true);
 		let j = jump ctx (fun n -> OJAlways n) in
-		DynArray.set ctx.m.mops pos (OTrap (rtrap, current_pos ctx - (pos + 1)));
+		set_op ctx pos (OTrap (rtrap, current_pos ctx - (pos + 1)));
 		let rec loop l =
 			match l with
 			| [] ->
@@ -2902,10 +2900,10 @@ and gen_method_wrapper ctx rt t p =
 			regs = DynArray.to_array ctx.m.mregs.arr;
 			code = DynArray.to_array ctx.m.mops;
 			debug = make_debug ctx ctx.m.mdebug;
+			assigns = Array.of_list (List.rev ctx.m.massign);
 		} in
 		ctx.m <- old;
 		DynArray.add ctx.cfunctions f;
-		DynArray.add ctx.cdebug_assigns [||];
 		fid
 
 and make_fun ?gen_content ctx name fidx f cthis cparent =
@@ -2943,7 +2941,7 @@ and make_fun ?gen_content ctx name fidx f cthis cparent =
 	let args = List.map (fun (v,o) ->
 		let t = to_type ctx v.v_type in
 		let r = alloc_var ctx (if o = None then v else { v with v_type = if not (is_nullable t) then TAbstract(ctx.ref_abstract,[v.v_type]) else v.v_type }) true in
-		add_assign ctx v r;
+		add_assign ctx v; (* record var name *)
 		rtype ctx r
 	) f.tf_args in
 
@@ -2988,11 +2986,11 @@ and make_fun ?gen_content ctx name fidx f cthis cparent =
 				| _ -> assert false)
 			| _ ->
 				assert false);
-			if capt = None then add_assign ctx v t;
+			if capt = None then add_assign ctx v;
 			let jend = jump ctx (fun n -> OJAlways n) in
 			j();
 			op ctx (OUnref (t,r));
-			if capt = None then add_assign ctx v t;
+			if capt = None then add_assign ctx v;
 			jend();
 			Hashtbl.replace ctx.m.mvars v.v_id t;
 			free ctx r;
@@ -3024,7 +3022,6 @@ and make_fun ?gen_content ctx name fidx f cthis cparent =
 			| TString s ->
 				op ctx (OMov (r, make_string ctx s f.tf_expr.epos))
 			);
-			if capt = None then add_assign ctx v r;
 			j();
 		);
 		(match capt with
@@ -3066,13 +3063,12 @@ and make_fun ?gen_content ctx name fidx f cthis cparent =
 		regs = DynArray.to_array ctx.m.mregs.arr;
 		code = DynArray.to_array ctx.m.mops;
 		debug = make_debug ctx ctx.m.mdebug;
+		assigns = Array.of_list (List.rev ctx.m.massign);
 	} in
-	let assigns = Array.of_list (List.rev ctx.m.massign) in
 	ctx.m <- old;
 	Hashtbl.add ctx.defined_funs fidx ();
 	let f = if ctx.optimize then Hlopt.optimize ctx.dump_out f else f in
 	DynArray.add ctx.cfunctions f;
-	DynArray.add ctx.cdebug_assigns assigns;
 	capt
 
 let generate_static ctx c f =
@@ -3647,7 +3643,14 @@ let write_code ch code debug =
 		write_index (Array.length f.code);
 		Array.iter write_type f.regs;
 		Array.iter write_op f.code;
-		if debug then write_debug_infos f.debug;
+		if debug then begin
+			write_debug_infos f.debug;
+			write_index (Array.length f.assigns);
+			Array.iter (fun (i,p) ->
+				write_index i;
+				write_index (p + 1);
+			) f.assigns;
+		end;
 	) code.functions
 
 (* --------------------------------------------------------------------------------------------------------------------- *)
@@ -3709,8 +3712,6 @@ let create_context com is_macro dump =
 		method_wrappers = PMap.empty;
 		cdebug_files = new_lookup();
 		macro_typedefs = Hashtbl.create 0;
-		cdebug_locals = new_lookup();
-		cdebug_assigns = DynArray.create();
 	} in
 	ignore(alloc_string ctx "");
 	ignore(class_type ctx ctx.base_class [] false);
@@ -3757,7 +3758,7 @@ let add_types ctx types =
 let build_code ctx types main =
 	let ep = generate_static_init ctx types main in
 	{
-		version = 2;
+		version = 3;
 		entrypoint = ep;
 		strings = DynArray.to_array ctx.cstrings.arr;
 		ints = DynArray.to_array ctx.cints.arr;
@@ -3815,33 +3816,11 @@ let generate com =
 		t();
 	end else begin
 		let ch = IO.output_string() in
-		write_code ch code true;
+		write_code ch code (not (Common.raw_defined com "hl-no-debug"));
 		let str = IO.close_out ch in
 		let ch = open_out_bin com.file in
 		output_string ch str;
 		close_out ch;
-(*
-		let ch = IO.output_string() in
-		let byte = IO.write_byte ch in
-		let write_index = write_index_gen byte in
-		write_index (DynArray.length ctx.cdebug_locals.arr);
-		DynArray.iter (fun s ->
-			write_index (String.length s);
-			IO.write_string ch s;
-		) ctx.cdebug_locals.arr;
-		write_index (DynArray.length ctx.cdebug_assigns);
-		DynArray.iter (fun a ->
-			write_index (Array.length a);
-			Array.iter (fun (i,p,r) ->
-				write_index i;
-				write_index p;
-				write_index r;
-			) a;
-		) ctx.cdebug_assigns;
-		let str = IO.close_out ch in
-		let dbg = open_out_bin (com.file ^ "d") in
-		output_string dbg str;
-		close_out dbg; *)
 	end;
 	t();
 	if Common.raw_defined com "run" then begin

+ 1 - 0
src/generators/hlcode.ml

@@ -206,6 +206,7 @@ type fundecl = {
 	regs : ttype array;
 	code : opcode array;
 	debug : (int * int) array;
+	assigns : (string index * int) array;
 }
 
 type code = {

+ 7 - 1
src/generators/hlopt.ml

@@ -785,6 +785,7 @@ let optimize dump (f:fundecl) =
 	let code = ref f.code in
 	let regs = ref f.regs in
 	let debug = ref f.debug in
+	let assigns = ref f.assigns in
 
 	if !nop_count > 0 || reg_remap then begin
 		let new_pos = Array.make (Array.length f.code) 0 in
@@ -831,8 +832,13 @@ let optimize dump (f:fundecl) =
 			| OTrap (r,d) -> OTrap (r,pos d)
 			| _ -> assert false)
 		) !jumps;
+
+		let new_assigns = List.filter (fun (i,p) -> p < 0 || (match f.code.(p) with ONop _ -> false | _ -> true)) (Array.to_list !assigns) in
+		let new_assigns = List.map (fun (i,p) -> i, if p < 0 then p else new_pos.(p)) new_assigns in
+
 		code := out_code;
 		debug := new_debug;
+		assigns := Array.of_list new_assigns;
 		if reg_remap then begin
 			let new_regs = Array.make !used_regs HVoid in
 			for i=0 to nregs-1 do
@@ -843,4 +849,4 @@ let optimize dump (f:fundecl) =
 		end;
 	end;
 
-	{ f with code = !code; regs = !regs; debug = !debug }
+	{ f with code = !code; regs = !regs; debug = !debug; assigns = !assigns }