Browse Source

added --flash-debug

Nicolas Cannasse 19 years ago
parent
commit
33ff65e90a
2 changed files with 23 additions and 4 deletions
  1. 22 4
      genswf9.ml
  2. 1 0
      main.ml

+ 22 - 4
genswf9.ml

@@ -69,6 +69,8 @@ type context = {
 	functions : as3_function lookup;
 	functions : as3_function lookup;
 	rpublic : as3_base_right index;
 	rpublic : as3_base_right index;
 	gpublic : as3_rights index;
 	gpublic : as3_rights index;
+	debug : bool;
+	mutable last_line : int;
 
 
 	(* per-function *)
 	(* per-function *)
 	mutable locals : (string,local) PMap.t;
 	mutable locals : (string,local) PMap.t;
@@ -211,10 +213,6 @@ let write ctx op =
 	| _ ->
 	| _ ->
 		()
 		()
 
 
-let debug ctx ?file line =
-	(match file with None -> () | Some f -> write ctx (A3DebugFile (string ctx f)));
-	write ctx (A3DebugLine line)
-
 let jump ctx cond =
 let jump ctx cond =
 	let op = DynArray.length ctx.code in
 	let op = DynArray.length ctx.code in
 	write ctx (A3Jump (cond,-4));
 	write ctx (A3Jump (cond,-4));
@@ -353,6 +351,13 @@ let open_block ctx el retval =
 		ctx.curblock <- old_block;
 		ctx.curblock <- old_block;
 	)
 	)
 
 
+let debug ctx p =
+	let line = Lexer.get_error_line p in
+	if ctx.last_line <> line then begin
+		write ctx (A3DebugLine line);
+		ctx.last_line <- line;
+	end
+
 let begin_fun ctx ?(varargs=false) args el stat =
 let begin_fun ctx ?(varargs=false) args el stat =
 	let old_locals = ctx.locals in
 	let old_locals = ctx.locals in
 	let old_code = ctx.code in
 	let old_code = ctx.code in
@@ -360,11 +365,20 @@ let begin_fun ctx ?(varargs=false) args el stat =
 	let old_trys = ctx.trys in
 	let old_trys = ctx.trys in
 	let old_bvars = ctx.block_vars in
 	let old_bvars = ctx.block_vars in
 	let old_static = ctx.in_static in
 	let old_static = ctx.in_static in
+	let last_line = ctx.last_line in
 	ctx.infos <- default_infos();
 	ctx.infos <- default_infos();
 	ctx.code <- DynArray.create();
 	ctx.code <- DynArray.create();
 	ctx.trys <- [];
 	ctx.trys <- [];
 	ctx.block_vars <- [];
 	ctx.block_vars <- [];
 	ctx.in_static <- stat;
 	ctx.in_static <- stat;
+	ctx.last_line <- -1;
+	(match el with
+	| [] -> ()
+	| e :: _ ->
+		if ctx.debug then begin
+			write ctx (A3DebugFile (lookup e.epos.pfile ctx.strings));
+			debug ctx e.epos
+		end);
 	ctx.locals <- PMap.foldi (fun name l acc ->
 	ctx.locals <- PMap.foldi (fun name l acc ->
 		match l with
 		match l with
 		| LReg _ -> acc
 		| LReg _ -> acc
@@ -437,6 +451,7 @@ let begin_fun ctx ?(varargs=false) args el stat =
 		ctx.trys <- old_trys;
 		ctx.trys <- old_trys;
 		ctx.block_vars <- old_bvars;
 		ctx.block_vars <- old_bvars;
 		ctx.in_static <- old_static;
 		ctx.in_static <- old_static;
+		ctx.last_line <- last_line;
 		f.fun3_id
 		f.fun3_id
 	)
 	)
 
 
@@ -938,6 +953,7 @@ and gen_expr_obj ctx retval e =
 
 
 and gen_expr ctx retval e =
 and gen_expr ctx retval e =
 	let old = ctx.infos.istack in
 	let old = ctx.infos.istack in
+	if ctx.debug then debug ctx e.epos;
 	gen_expr_content ctx retval e;
 	gen_expr_content ctx retval e;
 	if old <> ctx.infos.istack then begin
 	if old <> ctx.infos.istack then begin
 		if old + 1 <> ctx.infos.istack then stack_error e.epos;
 		if old + 1 <> ctx.infos.istack then stack_error e.epos;
@@ -1312,6 +1328,8 @@ let generate types hres =
 		curblock = [];
 		curblock = [];
 		block_vars = [];
 		block_vars = [];
 		in_static = false;
 		in_static = false;
+		debug = Plugin.defined "flash_debug";
+		last_line = -1;
 	} in
 	} in
 	List.iter (generate_type ctx) types;
 	List.iter (generate_type ctx) types;
 	Hashtbl.iter (fun _ _ -> assert false) hres;
 	Hashtbl.iter (fun _ _ -> assert false) hres;

+ 1 - 0
main.ml

@@ -235,6 +235,7 @@ try
 		),": ensure that overriden methods are declared with 'override'");
 		),": ensure that overriden methods are declared with 'override'");
 		("--no-traces", define "no_traces", ": don't compile trace calls in the program");
 		("--no-traces", define "no_traces", ": don't compile trace calls in the program");
 		("--flash-use-stage", define "flash_use_stage", ": place objects found on the stage of the SWF lib");
 		("--flash-use-stage", define "flash_use_stage", ": place objects found on the stage of the SWF lib");
+		("--flash-debug", define "flash_debug", ": add debug informations to the generated SWF");
 		("--gen-hx-classes", Arg.String (fun file ->
 		("--gen-hx-classes", Arg.String (fun file ->
 			gen_hx := true;
 			gen_hx := true;
 			Genswf9.genhx file
 			Genswf9.genhx file