Nicolas Cannasse 14 years ago
parent
commit
bbdcda1774
3 changed files with 66 additions and 57 deletions
  1. 33 46
      genswf.ml
  2. 3 1
      interp.ml
  3. 30 10
      main.ml

+ 33 - 46
genswf.ml

@@ -417,33 +417,26 @@ let build_class com c file =
 	} in
 	(path.tpackage, [(EClass class_data,pos)])
 
-let extract_data swf =
-	let cache = ref None in
-	(fun() ->
-		match !cache with
-		| Some h -> h
-		| None ->
-			let _, tags = swf() in
-			let t = Common.timer "read swf" in
-			let h = Hashtbl.create 0 in
-			let rec loop_field f =
-				match f.hlf_kind with
-				| HFClass c ->
-					let path = make_tpath f.hlf_name in
-					(match path with
-					| { tpackage = []; tname = "Float" | "Bool" | "MethodClosure" | "Int" | "UInt" | "Dynamic" } -> ()
-					| _ -> Hashtbl.add h (path.tpackage,path.tname) c)
-				| _ -> ()
-			in
-			List.iter (fun t ->
-				match t.tdata with
-				| TActionScript3 (_,as3) ->
-					List.iter (fun i -> Array.iter loop_field i.hls_fields) (As3hlparse.parse as3)
-				| _ -> ()
-			) tags;
-			cache := Some h;
-			t();
-			h)
+let extract_data (_,tags) =
+	let t = Common.timer "read swf" in
+	let h = Hashtbl.create 0 in
+	let rec loop_field f =
+		match f.hlf_kind with
+		| HFClass c ->
+			let path = make_tpath f.hlf_name in
+			(match path with
+			| { tpackage = []; tname = "Float" | "Bool" | "MethodClosure" | "Int" | "UInt" | "Dynamic" } -> ()
+			| _ -> Hashtbl.add h (path.tpackage,path.tname) c)
+		| _ -> ()
+	in
+	List.iter (fun t ->
+		match t.tdata with
+		| TActionScript3 (_,as3) ->
+			List.iter (fun i -> Array.iter loop_field i.hls_fields) (As3hlparse.parse as3)
+		| _ -> ()
+	) tags;
+	t();
+	h
 
 let remove_debug_infos as3 =
 	let hl = As3hlparse.parse as3 in
@@ -516,25 +509,19 @@ let remove_debug_infos as3 =
 	As3hlparse.flatten (List.map loop_static hl)
 
 let parse_swf com file =
-	let data = ref None in
-	(fun () ->
-		match !data with
-		| Some swf -> swf
-		| None ->
-			let t = Common.timer "read swf" in
-			let file = (try Common.find_file com file with Not_found -> failwith ("SWF Library not found : " ^ file)) in
-			let ch = IO.input_channel (open_in_bin file) in
-			let h, tags = (try Swf.parse ch with _ -> failwith ("The input swf " ^ file ^ " is corrupted")) in
-			IO.close_in ch;
-			List.iter (fun t ->
-				match t.tdata with
-				| TActionScript3 (id,as3) when not com.debug && not com.display ->
-					t.tdata <- TActionScript3 (id,remove_debug_infos as3)
-				| _ -> ()
-			) tags;
-			t();
-			data := Some (h,tags);
-			(h,tags))
+	let t = Common.timer "read swf" in
+	let file = (try Common.find_file com file with Not_found -> failwith ("SWF Library not found : " ^ file)) in
+	let ch = IO.input_channel (open_in_bin file) in
+	let h, tags = (try Swf.parse ch with _ -> failwith ("The input swf " ^ file ^ " is corrupted")) in
+	IO.close_in ch;
+	List.iter (fun t ->
+		match t.tdata with
+		| TActionScript3 (id,as3) when not com.debug && not com.display ->
+			t.tdata <- TActionScript3 (id,remove_debug_infos as3)
+		| _ -> ()
+	) tags;
+	t();
+	(h,tags)
 
 (* ------------------------------- *)
 

+ 3 - 1
interp.ml

@@ -1691,7 +1691,9 @@ let macro_lib =
 		);
 		"add_resource", Fun2 (fun name data ->
 			match name, data with
-			| VString name, VString data -> Hashtbl.replace (get_ctx()).com.Common.resources name data; VNull
+			| VString name, VString data ->
+				(* ressources are shared between the commons *)
+				Hashtbl.replace (get_ctx()).com.Common.resources name data; VNull
 			| _ -> error()
 		);
 		"curclass", Fun0 (fun() ->

+ 30 - 10
main.ml

@@ -218,6 +218,34 @@ let lookup_classes com fpath =
 	in
 	loop com.class_path
 
+let add_swf_lib com file =
+	let swf_data = ref None in
+	let swf_classes = ref None in
+	let getSWF = (fun() ->
+		match !swf_data with
+		| None ->
+			let d = Genswf.parse_swf com file in
+			swf_data := Some d;
+			d
+		| Some d -> d
+	) in
+	let extract = (fun() ->
+		match !swf_classes with
+		| None -> 
+			let d = Genswf.extract_data (getSWF()) in
+			swf_classes := Some d;
+			d
+		| Some d -> d
+	) in
+	let build cl p =
+		match (try Some (Hashtbl.find (extract()) cl) with Not_found -> None) with
+		| None -> None
+		| Some c -> Some (Genswf.build_class com c file)
+	in
+	com.load_extern_type <- com.load_extern_type @ [build];
+	com.swf_libs <- (file,getSWF,extract) :: com.swf_libs
+
+
 exception Hxml_found
 
 let rec process_params acc = function
@@ -356,15 +384,7 @@ try
 				_ -> raise (Arg.Bad "Invalid SWF header format")
 		),"<header> : define SWF header (width:height:fps:color)");
 		("-swf-lib",Arg.String (fun file ->
-			let getSWF = Genswf.parse_swf com file in
-			let extract = Genswf.extract_data getSWF in
-			let build cl p =
-				match (try Some (Hashtbl.find (extract()) cl) with Not_found -> None) with
-				| None -> None
-				| Some c -> Some (Genswf.build_class com c file)
-			in
-			com.load_extern_type <- com.load_extern_type @ [build];
-			com.swf_libs <- (file,getSWF,extract) :: com.swf_libs
+			add_swf_lib com file
 		),"<file> : add the SWF library to the compiled SWF");
 		("-x", Arg.String (fun file ->
 			let neko_file = file ^ ".n" in
@@ -710,7 +730,7 @@ if !measure_times then begin
 	Hashtbl.iter (fun _ t -> tot := !tot +. t.total) Common.htimers;
 	Printf.eprintf "Total time : %.3fs\n" !tot;
 	Printf.eprintf "------------------------------------\n";
-	let timers = List.sort (fun t1 t2 -> compare t2.total t1.total) (Hashtbl.fold (fun _ t acc -> t :: acc) Common.htimers []) in
+	let timers = List.sort (fun t1 t2 -> compare t1.name t2.name) (Hashtbl.fold (fun _ t acc -> t :: acc) Common.htimers []) in
 	List.iter (fun t ->
 		Printf.eprintf "  %s : %.3fs, %.0f%%\n" t.name t.total (t.total *. 100. /. !tot);
 	) timers;