fix for -swf-lib with libs that have too many opcodes

Makefile

@@ -35,11 +35,11 @@ MODULES=ast type lexer common genxml parser typecore optimizer typeload \
 all: libs haxe tools
 
 libs:
-	(cd libs/extlib; make opt)
-	(cd libs/extc; make native)
-	(cd libs/neko; make)
-	(cd libs/swflib; make)
-	(cd libs/xml-light; make xml-light.cmxa)
+	make -C libs/extlib opt
+	make -C libs/extc native
+	make -C libs/neko
+	make -C libs/swflib
+	make -C libs/xml-light xml-light.cmxa
 
 haxe: $(MODULES:=.cmx)
 	$(OCAMLOPT) -o $(OUTPUT) $(NATIVE_LIBS) $(LIBS) $(MODULES:=.cmx)

genswf.ml

@@ -477,21 +477,21 @@ let remove_debug_infos as3 =
 			m2
 	and loop_function f =
 		let cur = ref 0 in
-		let positions = Array.map (fun op ->
+		let positions = MultiArray.map (fun op ->
 			let p = !cur in
 			(match op with
 			| HDebugReg _ | HDebugLine _ | HDebugFile _ | HBreakPointLine _ | HTimestamp -> ()
 			| _ -> incr cur);
 			p
 		) f.hlf_code in
-		let positions = Array.concat [positions;[|!cur|]] in
-		let code = DynArray.create() in
-		Array.iteri (fun pos op ->
+		MultiArray.add positions (!cur);
+		let code = MultiArray.create() in
+		MultiArray.iteri (fun pos op ->
 			match op with
 			| HDebugReg _ | HDebugLine _ | HDebugFile _ | HBreakPointLine _ | HTimestamp -> ()
 			| _ ->
 				let p delta =
-					positions.(pos + delta) - DynArray.length code
+					MultiArray.get positions (pos + delta) - MultiArray.length code
 				in
 				let op = (match op with
 				| HJump (j,delta) -> HJump (j, p delta)
@@ -500,15 +500,15 @@ let remove_debug_infos as3 =
 				| HCallStatic (m,args) -> HCallStatic (loop_method m,args)
 				| HClassDef c -> HClassDef c (* mutated *)
 				| _ -> op) in
-				DynArray.add code op
+				MultiArray.add code op
 		) f.hlf_code;
-		f.hlf_code <- DynArray.to_array code;
+		f.hlf_code <- code;
 		f.hlf_trys <- Array.map (fun t ->
 			{
 				t with
-				hltc_start = positions.(t.hltc_start);
-				hltc_end = positions.(t.hltc_end);
-				hltc_handle = positions.(t.hltc_handle);
+				hltc_start = MultiArray.get positions t.hltc_start;
+				hltc_end = MultiArray.get positions t.hltc_end;
+				hltc_handle = MultiArray.get positions t.hltc_handle;
 			}
 		) f.hlf_trys;
 		f
@@ -924,11 +924,11 @@ let build_swf9 com file swc =
 										(* ID3 *)
 										if IO.nread i 2 <> "D3" then raise Exit;
 										ignore(IO.read_ui16 i); (* version *)
-										ignore(IO.read_byte i); (* flags *)
-										let size = IO.read_byte i land 0x7F in
-										let size = size lsl 7 lor (IO.read_byte i land 0x7F) in
-										let size = size lsl 7 lor (IO.read_byte i land 0x7F) in
-										let size = size lsl 7 lor (IO.read_byte i land 0x7F) in
+										ignore(IO.read_byte i); (* flags *)
+										let size = IO.read_byte i land 0x7F in
+										let size = size lsl 7 lor (IO.read_byte i land 0x7F) in
+										let size = size lsl 7 lor (IO.read_byte i land 0x7F) in
+										let size = size lsl 7 lor (IO.read_byte i land 0x7F) in
 										ignore(IO.nread i size); (* id3 data *)
 										read_frame()
 									| 0xFF ->
@@ -938,8 +938,8 @@ let build_swf9 com file swc =
 										let bits = IO.read_byte i in
 										let bitrate = (if ver = 3 then [|0;32;40;48;56;64;80;96;112;128;160;192;224;256;320;-1|] else [|0;8;16;24;32;40;48;56;64;80;96;112;128;144;160;-1|]).(bits lsr 4) in
 										let srate = [|
-											[|11025;-1;22050;44100|];
-											[|12000;-1;24000;48000|];
+											[|11025;-1;22050;44100|];
+											[|12000;-1;24000;48000|];
 											[|8000;-1;16000;32000|];
 											[|-1;-1;-1;-1|]
 										|].((bits lsr 2) land 2).(ver) in

genswf9.ml

@@ -739,7 +739,7 @@ let begin_fun ctx args tret el stat p =
 			hlf_nregs = DynArray.length ctx.infos.iregs + 1;
 			hlf_init_scope = 1;
 			hlf_max_scope = ctx.infos.imaxscopes + 1 + (if hasblock then 2 else if this_reg then 1 else 0);
-			hlf_code = Array.of_list (extra @ code);
+			hlf_code = MultiArray.of_list (extra @ code);
 			hlf_trys = Array.of_list (List.map (fun t ->
 				{
 					hltc_start = t.tr_pos + delta;

libs/extlib/Makefile

@@ -2,7 +2,7 @@
 
 MODULES = \
  enum bitSet dynArray extArray extHashtbl extList extString global IO option \
- pMap std uChar uTF8 base64 unzip refList optParse dllist
+ pMap std uChar uTF8 base64 unzip refList optParse dllist multiArray
 
 # the list is topologically sorted
 

libs/extlib/multiArray.ml

@@ -0,0 +1,191 @@
+(*
+ * MultiArray - Resizeable Big Ocaml arrays
+ * Copyright (C) 2012 Nicolas Cannasse
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version,
+ * with the special exception on linking described in file LICENSE.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *)
+
+type 'a intern
+
+external ilen : 'a intern -> int = "%obj_size"
+let idup (x : 'a intern) = if ilen x = 0 then x else (Obj.magic (Obj.dup (Obj.repr x)) : 'a intern)
+let imake tag len = (Obj.magic (Obj.new_block tag len) : 'a intern)
+external iget : 'a intern -> int -> 'a = "%obj_field"
+external iset : 'a intern -> int -> 'a -> unit = "%obj_set_field"
+
+type 'a t = {
+	mutable arr : 'a intern intern;
+	mutable len : int;
+}
+
+exception Invalid_arg of int * string * string
+
+let invalid_arg n f p = raise (Invalid_arg (n,f,p))
+
+let length d = d.len
+
+(* create 1K chunks, which allows up to 4GB elements *)
+
+let nbits = 10
+let size = 1 lsl nbits
+let mask = size - 1
+
+let create() =
+	{
+		len = 0;
+		arr = imake 0 0;
+	}
+
+let init len f =
+	let count = (len + size - 1) lsr nbits in
+	let d = {
+		len = len;
+		arr = imake 0 count;
+	} in
+	let max = count - 1 in
+	for i = 0 to max do
+		let arr = imake 0 size in
+		iset d.arr i arr;
+		for j = 0 to (if i = max then len land mask else size) - 1 do
+			iset arr j (f ((i lsl nbits) + j))
+		done;
+	done;
+	d
+
+let make len e =
+	let count = (len + size - 1) lsr nbits in
+	let d = {
+		len = len;
+		arr = imake 0 count;
+	} in
+	let max = count - 1 in
+	for i = 0 to max do
+		let arr = imake 0 size in
+		iset d.arr i arr;
+		for j = 0 to (if i = max then len land mask else size) - 1 do
+			iset arr j e
+		done;
+	done;
+	d
+
+let empty d =
+	d.len = 0
+
+let unsafe_get d idx =
+	iget (iget d.arr (idx lsr nbits)) (idx land mask)
+
+let unsafe_set d idx v =
+	iset (iget d.arr (idx lsr nbits)) (idx land mask) v
+
+let get d idx =
+	if idx < 0 || idx >= d.len then invalid_arg idx "get" "index";
+	iget (iget d.arr (idx lsr nbits)) (idx land mask)
+
+let set d idx v =
+	if idx < 0 || idx >= d.len then invalid_arg idx "set" "index";
+	iset (iget d.arr (idx lsr nbits)) (idx land mask) v
+
+let add d v =
+	let asize = ilen d.arr in
+	if d.len >= asize lsl nbits then begin
+		let narr = imake 0 (asize + 1) in
+		for i = 0 to asize-1 do
+			iset narr i (iget d.arr i);
+		done;
+		iset narr asize (imake 0 size);
+		d.arr <- narr;
+	end;
+	iset (iget d.arr (d.len lsr nbits)) (d.len land mask) v;
+	d.len <- d.len + 1
+
+let clear d =
+	d.len <- 0;
+	d.arr <- imake 0 0
+
+let reset_pos d =
+	d.len <- 0
+
+let of_array src =
+	let c = create() in
+	Array.iteri (fun i v -> add c v) src;
+	c
+
+let of_list src =
+	let c = create() in
+	List.iter (add c) src;
+	c
+	
+let iter f d =
+ 	let max = ilen d.arr - 1 in
+	for i = 0 to max do
+		let arr = iget d.arr i in
+		for j = 0 to (if i = max then (d.len land mask) else size) - 1 do
+			f (iget arr j)
+		done;
+	done
+
+let iteri f d =
+	let max = ilen d.arr - 1 in
+	for i = 0 to max do
+		let arr = iget d.arr i in
+		for j = 0 to (if i = max then (d.len land mask) else size) - 1 do
+			f ((i lsl nbits) + j) (iget arr j)
+		done;
+	done
+
+let map f d =
+	let max = ilen d.arr - 1 in
+	let d2 = {
+		len = d.len;
+		arr = imake 0 (max + 1);
+	} in
+	for i = 0 to max do
+		let arr = iget d.arr i in
+		let narr = imake 0 size in
+		iset d2.arr i narr;
+		for j = 0 to (if i = max then (d.len land mask) else size) - 1 do
+			iset narr j (f (iget arr j))
+		done;
+	done;
+	d2
+
+let mapi f d =
+	let max = ilen d.arr - 1 in
+	let d2 = {
+		len = d.len;
+		arr = imake 0 (max + 1);
+	} in
+	for i = 0 to max do
+		let arr = iget d.arr i in
+		let narr = imake 0 size in
+		iset d2.arr i narr;
+		for j = 0 to (if i = max then (d.len land mask) else size) - 1 do
+			iset narr j (f ((i lsl nbits) + j) (iget arr j))
+		done;
+	done;
+	d2
+
+let fold_left f acc d =
+	let acc = ref acc in
+	let max = ilen d.arr - 1 in
+	for i = 0 to max do
+		let arr = iget d.arr i in
+		for j = 0 to (if i = max then (d.len land mask) else size) - 1 do
+			acc := f !acc (iget arr j)
+		done;
+	done;
+	!acc
+

libs/extlib/multiArray.mli

@@ -0,0 +1,60 @@
+(*
+ * MultiArray - Resizeable Ocaml big arrays
+ * Copyright (C) 201 Nicolas Cannasse
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2.1 of the License, or (at your option) any later version,
+ * with the special exception on linking described in file LICENSE.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+ *)
+
+(** Dynamic Big arrays.
+
+   A dynamic array is equivalent to a OCaml array that will resize itself
+   when elements are added or removed. MultiArray is different from DynArray
+   since it allows more than 4 Millions elements on 32 bits systems.
+
+   MultiArray is slower since it requires an additional level of indirection.
+*)
+
+type 'a t
+
+exception Invalid_arg of int * string * string
+
+val create : unit -> 'a t
+val make : int -> 'a -> 'a t
+val init : int -> (int -> 'a) -> 'a t
+
+val empty : 'a t -> bool
+val length : 'a t -> int
+
+val get : 'a t -> int -> 'a
+val set : 'a t -> int -> 'a -> unit
+val add : 'a t -> 'a -> unit
+val clear : 'a t -> unit
+
+val reset_pos : 'a t -> unit
+
+val of_array : 'a array -> 'a t
+val of_list : 'a list -> 'a t
+
+val iter : ('a -> unit) -> 'a t -> unit
+val iteri : (int -> 'a -> unit) -> 'a t -> unit
+
+val map : ('a -> 'b) -> 'a t -> 'b t
+val mapi : (int -> 'a -> 'b) -> 'a t -> 'b t
+
+val fold_left : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
+
+val unsafe_get : 'a t -> int -> 'a
+val unsafe_set : 'a t -> int -> 'a -> unit

libs/swflib/as3.mli

@@ -306,7 +306,7 @@ type as3_function = {
 	fun3_nregs : int;
 	fun3_init_scope : int;
 	fun3_max_scope : int;
-	fun3_code : as3_opcode array;
+	fun3_code : as3_opcode MultiArray.t;
 	fun3_trys : as3_try_catch array;
 	fun3_locals : as3_field array;
 }

libs/swflib/as3code.ml

@@ -439,13 +439,13 @@ let opcode ch =
 let parse ch len =
 	let data = nread ch len in
 	let ch = input_string data in
-	let a = DynArray.create() in
+	let a = MultiArray.create() in
 	let rec loop() =
-		DynArray.add a (opcode ch);
+		MultiArray.add a (opcode ch);
 		loop();
 	in
 	(try loop() with Exit -> ());
-	DynArray.to_array a
+	a
 
 let write ch = function
 	| A3BreakPoint ->

libs/swflib/as3hl.mli

@@ -187,7 +187,7 @@ and hl_function = {
 	hlf_nregs : int;
 	hlf_init_scope : int;
 	hlf_max_scope : int;
-	mutable hlf_code : hl_opcode array;
+	mutable hlf_code : hl_opcode MultiArray.t;
 	mutable hlf_trys : hl_try_catch array;
 	hlf_locals : (hl_name * hl_name option * hl_slot * bool) array; (* bool = const - mostly false *)
 }

libs/swflib/as3hlparse.ml

@@ -257,29 +257,29 @@ let parse_opcode ctx i = function
 let parse_code ctx f trys =
 	let code = f.fun3_code in
 	let old = ctx.pos , ctx.jumps in
-	let indexes = DynArray.create() in
+	let indexes = MultiArray.create() in
 	ctx.pos <- 0;
 	ctx.jumps <- [];
 	let codepos pos delta =
-		let id = (try DynArray.get indexes (pos + delta) with _ -> -1) in
+		let id = (try MultiArray.get indexes (pos + delta) with _ -> -1) in
 		if id = -1 then begin
 			(*Printf.eprintf "MISALIGNED JUMP AT %d %c %d IN #%d\n" pos (if delta < 0 then '-' else '+') (if delta < 0 then -delta else delta) (idx (no_nz f.fun3_id));*)
-			DynArray.get indexes pos; (* jump 0 *)
+			MultiArray.get indexes pos; (* jump 0 *)
 		end else
 			id
 	in
-	let hcode = Array.mapi (fun i op ->
+	let hcode = MultiArray.mapi (fun i op ->
 		let len = As3code.length op in
-		DynArray.add indexes i;
-		for k = 2 to len do DynArray.add indexes (-1); done;
+		MultiArray.add indexes i;
+		for k = 2 to len do MultiArray.add indexes (-1); done;
 		ctx.pos <- ctx.pos + len;
 		parse_opcode ctx i op
 	) code in
 	(* in case we have a dead-jump at the end of code *)
-	DynArray.add indexes (Array.length code);
+	MultiArray.add indexes (MultiArray.length code);
 	(* patch jumps *)
 	List.iter (fun (j,pos) ->
-		Array.set hcode j (match Array.get hcode j with
+		MultiArray.set hcode j (match MultiArray.get hcode j with
 			| HJump (jc,n) ->
 				HJump (jc,codepos pos n - j)
 			| HSwitch (n,infos) ->
@@ -399,7 +399,7 @@ let parse_function ctx f =
 		hlf_nregs = f.fun3_nregs;
 		hlf_init_scope = f.fun3_init_scope;
 		hlf_max_scope = f.fun3_max_scope;
-		hlf_code = [||]; (* keep for later *)
+		hlf_code = MultiArray.create(); (* keep for later *)
 		hlf_trys = Array.map (parse_try_catch ctx) f.fun3_trys;
 		hlf_locals = Array.map (fun f ->
 			if f.f3_metas <> None then assert false;
@@ -763,31 +763,31 @@ let flatten_opcode ctx i = function
 	| HUnk c -> A3Unk c
 
 let flatten_code ctx hcode trys =
-	let positions = Array.create (Array.length hcode + 1) 0 in
+	let positions = MultiArray.make (MultiArray.length hcode + 1) 0 in
 	let pos = ref 0 in
 	let old = ctx.fjumps in
 	ctx.fjumps <- [];
-	let code = Array.mapi (fun i op ->
+	let code = MultiArray.mapi (fun i op ->
 		let op = flatten_opcode ctx i op in
 		pos := !pos + As3code.length op;
-		Array.set positions (i + 1) !pos;
+		MultiArray.set positions (i + 1) !pos;
 		op
 	) hcode in
 	(* patch jumps *)
 	List.iter (fun j ->
-		Array.set code j (match Array.get code j with
+		MultiArray.set code j (match MultiArray.get code j with
 			| A3Jump (jc,n) ->
-				A3Jump (jc,positions.(j+n) - positions.(j+1))
+				A3Jump (jc,MultiArray.get positions (j+n) - MultiArray.get positions (j+1))
 			| A3Switch (n,infos) ->
-				A3Switch (positions.(j+n) - positions.(j),List.map (fun n -> positions.(j+n) - positions.(j)) infos)
+				A3Switch (MultiArray.get positions (j+n) - MultiArray.get positions (j),List.map (fun n -> MultiArray.get positions (j+n) - MultiArray.get positions (j)) infos)
 			| _ -> assert false);
 	) ctx.fjumps;
 	(* patch trys *)
 	let trys = Array.mapi (fun i t ->
 		{
-			tc3_start = positions.(t.hltc_start);
-			tc3_end = positions.(t.hltc_end);
-			tc3_handle = positions.(t.hltc_handle);
+			tc3_start = MultiArray.get positions t.hltc_start;
+			tc3_end = MultiArray.get positions t.hltc_end;
+			tc3_handle = MultiArray.get positions t.hltc_handle;
 			tc3_type = opt lookup_name ctx t.hltc_type;
 			tc3_name = opt lookup_name ctx t.hltc_name;
 		}
@@ -847,7 +847,7 @@ let rec browse_method ctx m =
 		match m.hlmt_function with
 		| None -> ()
 		| Some f ->
-			Array.iter (function
+			MultiArray.iter (function
 				| HFunction f | HCallStatic (f,_) -> browse_method ctx f
 				| HClassDef _ -> () (* ignore, should be in fields list anyway *)
 				| _ -> ()

libs/swflib/as3parse.ml

@@ -213,7 +213,7 @@ let as3_try_catch_length t =
 	idx_opt_length t.tc3_name
 
 let as3_function_length f =
-	let clen = Array.fold_left (fun acc op -> acc + As3code.length op) 0 f.fun3_code in
+	let clen = MultiArray.fold_left (fun acc op -> acc + As3code.length op) 0 f.fun3_code in
 	idx_length_nz f.fun3_id +
 	int_length f.fun3_stack_size +
 	int_length f.fun3_nregs +
@@ -551,7 +551,7 @@ let read_function ctx ch =
 	let init_scope = read_int ch in
 	let max_scope = read_int ch in
 	let size = read_int ch in
-	let code = if parse_bytecode then As3code.parse ch size else Array.init size (fun _ -> A3Unk (IO.read ch)) in
+	let code = if parse_bytecode then As3code.parse ch size else MultiArray.init size (fun _ -> A3Unk (IO.read ch)) in
 	let trys = read_list2 ch (read_try_catch ctx) in
 	let local_funs = read_list2 ch (read_field ctx) in
 	{
@@ -857,9 +857,9 @@ let write_function ch f =
 	write_int ch f.fun3_nregs;
 	write_int ch f.fun3_init_scope;
 	write_int ch f.fun3_max_scope;
-	let clen = Array.fold_left (fun acc op -> acc + As3code.length op) 0 f.fun3_code in
+	let clen = MultiArray.fold_left (fun acc op -> acc + As3code.length op) 0 f.fun3_code in
 	write_int ch clen;
-	Array.iter (As3code.write ch) f.fun3_code;
+	MultiArray.iter (As3code.write ch) f.fun3_code;
 	write_list2 ch write_try_catch f.fun3_trys;
 	write_list2 ch write_field f.fun3_locals
 
@@ -1043,7 +1043,7 @@ let dump_function ctx ch idx f =
 	Array.iter (dump_field ctx ch false) f.fun3_locals;
 	Array.iter (dump_try_catch ctx ch) f.fun3_trys;
 	let pos = ref 0 in
-	Array.iter (fun op ->
+	MultiArray.iter (fun op ->
 		IO.printf ch "%4d    %s\n" !pos (As3code.dump ctx op);
 		if !dump_code_size then pos := !pos + As3code.length op else incr pos;
 	) f.fun3_code;