revert libs to r233

libs/extc/extc.ml

@@ -71,7 +71,6 @@ external dlalloc_string : value -> string = "sys_dlalloc_string"
 external dlmemcpy : value -> value -> int -> unit = "sys_dlmemcpy"
 external dlcallback : int -> value = "sys_dlcallback"
 external dlcaml_callback : int -> value = "sys_dlcaml_callback"
-external dlint32 : int32 -> value = "sys_dlint32"
 
 (* support for backward compatibility *)
 let zlib_deflate_init lvl = zlib_deflate_init2 lvl 15

libs/extc/extc_stubs.c

@@ -301,10 +301,6 @@ CAMLprim value sys_dltoint( value i ) {
 	return Val_int((int)i);
 }
 
-CAMLprim value sys_dlint32( value i ) {
-	return (value)Int32_val(i);
-}
-
 typedef value (*c_prim0)();
 typedef value (*c_prim1)(value);
 typedef value (*c_prim2)(value,value);

libs/extlib/Makefile

@@ -30,5 +30,5 @@ uninstall:
 	ocamlfind remove extlib
 
 clean:
-	rm -f $(wildcard *.cmo) $(wildcard *.cmx) $(wildcard *.o) $(wildcard *.cmi) $(wildcard *.cma) $(wildcard *.cmxa) $(wildcard *.a) $(wildcard *.lib) $(wildcard *.obj)
+	rm -f *.cmo *.cmx *.o *.cmi *.cma *.cmxa *.a *.lib *.obj
 	rm -Rf doc

libs/extlib/extHashtbl.ml

@@ -36,8 +36,6 @@ module Hashtbl =
 	external h_conv : ('a, 'b) t -> ('a, 'b) h_t = "%identity"
 	external h_make : ('a, 'b) h_t -> ('a, 'b) t = "%identity"
 
-	let create (size:int) = create size
-	
 	let exists = mem
 
 	let enum h =

libs/neko/Makefile

@@ -1,5 +1,5 @@
 all:
-	ocamlopt -I ../extlib -a -o neko.cmxa nast.ml nxml.ml binast.ml nbytecode.ml ncompile.ml
-
+	ocamlopt -I ../extlib -a -o neko.cmxa nast.ml binast.ml nxml.ml
+	
 clean:
-	rm -rf neko.cmxa neko.lib neko.a $(wilcard *.cmx) $(wildcard *.obj) $(wildcard *.o) $(wildcard *.cmi)
+	rm -rf neko.cmxa neko.lib neko.a *.cmx *.obj *.o *.cmi

libs/neko/binast.ml

@@ -72,9 +72,6 @@ let write_constant ctx = function
 	| Ident s ->
 		b ctx 9;
 		write_string ctx s
-	| Int32 n ->
-		b ctx 10;
-		IO.write_real_i32 ctx.ch n
 
 let write_op ctx op =
 	b ctx (match op with

libs/neko/nast.ml

@@ -32,7 +32,6 @@ type constant =
 	| String of string
 	| Builtin of string
 	| Ident of string
-	| Int32 of int32
 
 type while_flag =
 	| NormalWhile
@@ -150,5 +149,3 @@ let s_constant = function
 	| String s -> "\"" ^ escape s ^ "\""
 	| Builtin s -> "$" ^ s
 	| Ident s -> s
-	| Int32 i -> Int32.to_string i
-

libs/neko/nbytecode.ml

@@ -1,377 +0,0 @@
-(*
- *  Neko Compiler
- *  Copyright (c)2005 Motion-Twin
- *
- *  This library is free software; you can redistribute it and/lor
- *  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, lor (at your option) any later version.
- *
- *  This library is distributed in the hope that it will be useful,
- *  but WITHOUT ANY WARRANTY; without even the implied warranty of
- *  MERCHANTABILITY lor FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
- *  Lesser General Public License lor the LICENSE file for more details.
- *)
-
-type opcode =
-	(* getters *)
-	| AccNull
-	| AccTrue
-	| AccFalse
-	| AccThis
-	| AccInt of int
-	| AccStack of int
-	| AccGlobal of int
-	| AccEnv of int
-	| AccField of string
-	| AccArray
-	| AccIndex of int
-	| AccBuiltin of string
-	(* setters *)
-	| SetStack of int
-	| SetGlobal of int
-	| SetEnv of int
-	| SetField of string
-	| SetArray
-	| SetIndex of int
-	| SetThis
-	(* stack ops *)
-	| Push
-	| Pop of int
-	| Call of int
-	| ObjCall of int
-	| Jump of int
-	| JumpIf of int
-	| JumpIfNot of int
-	| Trap of int
-	| EndTrap
-	| Ret of int
-	| MakeEnv of int
-	| MakeArray of int
-	(* value ops *)
-	| Bool
-	| IsNull
-	| IsNotNull
-	| Add
-	| Sub
-	| Mult
-	| Div
-	| Mod
-	| Shl
-	| Shr
-	| UShr
-	| Or
-	| And
-	| Xor
-	| Eq
-	| Neq
-	| Gt
-	| Gte
-	| Lt
-	| Lte
-	| Not
-	(* extra ops *)
-	| TypeOf
-	| Compare
-	| Hash
-	| New
-	| JumpTable of int
-	| Apply of int
-	| AccStack0
-	| AccStack1
-	| AccIndex0
-	| AccIndex1
-	| PhysCompare
-	| TailCall of int * int
-	| Loop
-	(* ocaml-specific *)
-	| AccInt32 of int32
-
-type global =
-	| GlobalVar of string
-	| GlobalFunction of int * int
-	| GlobalString of string
-	| GlobalFloat of string
-	| GlobalDebug of string array * ((int * int) array)
-	| GlobalVersion of int
-
-exception Invalid_file
-
-let error msg = failwith msg
-
-let trap_stack_delta = 6
-
-let hash_field f =
-	let h = ref 0 in
-	for i = 0 to String.length f - 1 do
-		h := !h * 223 + int_of_char (String.unsafe_get f i);
-	done;
-	if Sys.word_size = 64 then Int32.to_int (Int32.shift_right (Int32.shift_left (Int32.of_int !h) 1) 1) else !h
-
-
-let op_param x =
-	match x with
-	| AccInt _
-	| AccInt32 _
-	| AccStack _
-	| AccGlobal _
-	| AccEnv _
-	| AccField _
-	| AccBuiltin _
-	| SetStack _
-	| SetGlobal _
-	| SetEnv _
-	| SetField _
-	| Pop _
-	| Call _
-	| ObjCall _
-	| Jump _
-	| JumpIf _
-	| JumpIfNot _
-	| JumpTable _
-	| Trap _
-	| MakeEnv _
-	| MakeArray _
-	| Ret _
-	| AccIndex _
-	| SetIndex _
-	| Apply _
-	| TailCall _
-		-> true
-	| AccNull
-	| AccTrue
-	| AccFalse
-	| AccThis
-	| AccArray
-	| SetArray
-	| SetThis
-	| Push
-	| EndTrap
-	| Bool
-	| Add
-	| Sub
-	| Mult
-	| Div
-	| Mod
-	| Shl
-	| Shr
-	| UShr
-	| Or
-	| And
-	| Xor
-	| Eq
-	| Neq
-	| Gt
-	| Gte
-	| Lt
-	| Lte
-	| IsNull
-	| IsNotNull
-	| Not
-	| TypeOf
-	| Compare
-	| Hash
-	| New
-	| AccStack0
-	| AccStack1
-	| AccIndex0
-	| AccIndex1
-	| PhysCompare
-	| Loop
-		-> false
-
-let code_tables ops =
-	let ids = Hashtbl.create 0 in
-	let fids = DynArray.create() in
-	Array.iter (fun x ->
-		match x with
-		| AccField s
-		| SetField s
-		| AccBuiltin s ->
-			let id = hash_field s in
-			(try
-				let f = Hashtbl.find ids id in
-				if f <> s then error("Field hashing conflict " ^ s ^ " and " ^ f);
-			with Not_found ->
-				Hashtbl.add ids id s;
-				DynArray.add fids s
-			)
-		| _ -> ()
-	) ops;
-	let p = ref 0 in
-	let pos = Array.make (Array.length(ops) + 1) 0 in
-	Array.iteri (fun i op ->
-		pos.(i) <- !p;
-		p := !p + (if op_param op then 2 else 1);
-	) ops;
-	pos.(Array.length ops) <- !p;
-	(DynArray.to_array fids , pos , !p)
-
-let write_debug_infos ch files inf =
-	let nfiles = Array.length files in
-	(*
-	// the encoding of nfiles was set to keep
-	// backward compatibility with 1.3 which
-	// only allowed up to 127 filenames
-	*)
-	let lot_of_files = ref false in
-	if nfiles < 0x80 then
-		IO.write_byte ch nfiles
-	else if nfiles < 0x8000 then begin
-		lot_of_files := true;
-		IO.write_byte ch ((nfiles lsr 8) lor 0x80);
-		IO.write_byte ch (nfiles land 0xFF);
-	end else
-		assert false;
-	Array.iter (fun s -> IO.write_string ch s) files;
-    IO.write_i32 ch (Array.length inf);
-	let curfile = ref 0 in
-	let curpos = ref 0 in
-	let rcount = ref 0 in
-	let rec flush_repeat p =
-		if !rcount > 0 then begin
-			if !rcount > 15 then begin
-				IO.write_byte ch ((15 lsl 2) lor 2);
-				rcount := !rcount - 15;
-				flush_repeat(p)
-			end else begin
-				let delta = p - !curpos in
-				let delta = (if delta > 0 && delta < 4 then delta else 0) in
-				IO.write_byte ch ((delta lsl 6) lor (!rcount lsl 2) lor 2);
-				rcount := 0;
-				curpos := !curpos + delta;
-			end
-		end
-	in
-	Array.iter (fun (f,p) ->
-		if f <> !curfile then begin
-			flush_repeat(p);
-			curfile := f;
-			if !lot_of_files then begin
-				IO.write_byte ch ((f lsr 7) lor 1);
-				IO.write_byte ch (f land 0xFF);
-			end else
-				IO.write_byte ch ((f lsl 1) lor 1);
-		end;
-		if p <> !curpos then flush_repeat(p);
-		if p = !curpos then
-			rcount := !rcount + 1
-		else
-			let delta = p - !curpos in
-			if delta > 0 && delta < 32 then
-				IO.write_byte ch ((delta lsl 3) lor 4)
-			else begin
-				IO.write_byte ch (p lsl 3);
-				IO.write_byte ch (p lsr 5);
-				IO.write_byte ch (p lsr 13);
-			end;
-			curpos := p;
-	) inf;
-	flush_repeat(!curpos)
-
-let write ch (globals,ops) =
-	IO.nwrite ch "NEKO";
-	let ids , pos , csize = code_tables ops in
-	IO.write_i32 ch (Array.length globals);
-	IO.write_i32 ch (Array.length ids);
-	IO.write_i32 ch csize;
-	Array.iter (fun x ->
-		match x with
-		| GlobalVar s -> IO.write_byte ch 1; IO.write_string ch s
-		| GlobalFunction (p,nargs) -> IO.write_byte ch 2; IO.write_i32 ch (pos.(p) lor (nargs lsl 24))
-		| GlobalString s -> IO.write_byte ch 3; IO.write_ui16 ch (String.length s); IO.nwrite ch s
-		| GlobalFloat s -> IO.write_byte ch 4; IO.write_string ch s
-		| GlobalDebug (files,inf) -> IO.write_byte ch 5; write_debug_infos ch files inf;
-		| GlobalVersion v -> IO.write_byte ch 6; IO.write_byte ch v
-	) globals;
-	Array.iter (fun s ->
-		IO.write_string ch s;
-	) ids;
-	Array.iteri (fun i op ->
-		let pop = ref None in
-		let opid = (match op with
-			| AccNull -> 0
-			| AccTrue -> 1
-			| AccFalse -> 2
-			| AccThis -> 3
-			| AccInt n -> pop := Some n; 4
-			| AccInt32 n ->
-				let opid = 4 in
-				IO.write_byte ch ((opid lsl 2) lor 3);
-				IO.write_real_i32 ch n;
-				-1
-			| AccStack n -> pop := Some (n - 2); 5
-			| AccGlobal n -> pop := Some n; 6
-			| AccEnv n -> pop := Some n; 7
-			| AccField s -> pop := Some (hash_field s); 8
-			| AccArray -> 9
-			| AccIndex n -> pop := Some (n - 2); 10
-			| AccBuiltin s -> pop := Some (hash_field s); 11
-			| SetStack n -> pop := Some n; 12
-			| SetGlobal n -> pop := Some n; 13
-			| SetEnv n -> pop := Some n; 14
-			| SetField s -> pop := Some (hash_field s); 15
-			| SetArray -> 16
-			| SetIndex n -> pop := Some n; 17
-			| SetThis -> 18
-			| Push -> 19
-			| Pop n -> pop := Some n; 20
-			| Call n -> pop := Some n; 21
-			| ObjCall n -> pop := Some n; 22
-			| Jump n -> pop := Some (pos.(i+n) - pos.(i)); 23
-			| JumpIf n -> pop := Some (pos.(i+n) - pos.(i)); 24
-			| JumpIfNot n -> pop := Some (pos.(i+n) - pos.(i)); 25
-			| Trap n -> pop := Some (pos.(i+n) - pos.(i)); 26
-			| EndTrap -> 27
-			| Ret n -> pop := Some n; 28
-			| MakeEnv n -> pop := Some n; 29
-			| MakeArray n -> pop := Some n; 30
-			| Bool -> 31
-			| IsNull -> 32
-			| IsNotNull -> 33
-			| Add -> 34
-			| Sub -> 35
-			| Mult -> 36
-			| Div -> 37
-			| Mod -> 38
-			| Shl -> 39
-			| Shr -> 40
-			| UShr -> 41
-			| Or -> 42
-			| And -> 43
-			| Xor -> 44
-			| Eq -> 45
-			| Neq -> 46
-			| Gt -> 47
-			| Gte -> 48
-			| Lt -> 49
-			| Lte -> 50
-			| Not -> 51
-			| TypeOf -> 52
-			| Compare -> 53
-			| Hash -> 54
-			| New -> 55
-			| JumpTable n -> pop := Some n; 56
-			| Apply n -> pop := Some n; 57
-			| AccStack0 -> 58
-			| AccStack1 -> 59
-			| AccIndex0 -> 60
-			| AccIndex1 -> 61
-			| PhysCompare -> 62
-			| TailCall (args,st) -> pop := Some (args lor (st lsl 3)); 63
-			| Loop -> pop := Some 64; 0
-		) in
-		match !pop with
-		| None ->
-			if opid >= 0 then IO.write_byte ch (opid lsl 2)
-		| Some n ->
-			if opid < 32 && (n = 0 || n = 1) then
-				IO.write_byte ch ((opid lsl 3) lor (n lsl 2) lor 1)
-			else if n >= 0 && n <= 0xFF then begin
-				IO.write_byte ch ((opid lsl 2) lor 2);
-				IO.write_byte ch n;
-			end else begin
-				IO.write_byte ch ((opid lsl 2) lor 3);
-				IO.write_i32 ch n;
-			end
-	) ops

libs/neko/ncompile.ml

@@ -1,1045 +0,0 @@
-(*
- *  Neko Compiler
- *  Copyright (c)2005 Motion-Twin
- *
- *  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.
- *
- *  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 or the LICENSE file for more details.
- *)
-open Nast
-open Nbytecode
-
-type access =
-	| XEnv of int
-	| XStack of int
-	| XGlobal of int
-	| XField of string
-	| XIndex of int
-	| XArray
-	| XThis
-
-type label = {
-	lname : string;
-	ltraps : int list;
-	lstack : int;
-	mutable lpos : int option;
-	mutable lwait : (unit -> unit) list;
-}
-
-type globals = {
-	globals : (global,int) Hashtbl.t;
-	gobjects : (string list,int) Hashtbl.t;
-	mutable functions : (opcode DynArray.t * (int * int) DynArray.t * int * int) list;
-	mutable gtable : global DynArray.t;
-	labels : (string,label) Hashtbl.t;
-	hfiles : (string,int) Hashtbl.t;
-	files : string DynArray.t;
-}
-
-type context = {
-	g : globals;
-	version : int;
-	mutable ops : opcode DynArray.t;
-	mutable locals : (string,int) PMap.t;
-	mutable env : (string,int) PMap.t;
-	mutable nenv : int;
-	mutable stack : int;
-	mutable loop_limit : int;
-	mutable limit : int;
-	mutable traps : int list;
-	mutable breaks : ((unit -> unit) * pos) list;
-	mutable continues : ((unit -> unit) * pos) list;
-	mutable pos : (int * int) DynArray.t;
-	mutable curpos : (int * int);
-	mutable curfile : string;
-}
-
-type error_msg = string
-
-exception Error of error_msg * pos
-
-let error e p =
-	raise (Error(e,p))
-
-let error_msg s =
-	s
-
-let stack_delta o =
-	match o with
-	| AccNull
-	| AccTrue
-	| AccFalse
-	| AccThis
-	| AccInt _
-	| AccInt32 _
-	| AccStack _
-	| AccGlobal _
-	| AccEnv _
-	| AccField _
-	| AccBuiltin _
-	| AccIndex _
-	| JumpIf _
-	| JumpIfNot _
-	| Jump _
-	| JumpTable _
-	| Ret _
-	| SetGlobal _
-	| SetStack _
-	| SetEnv _
-	| SetThis
-	| Bool
-	| IsNull
-	| IsNotNull
-	| Not
-	| Hash
-	| TypeOf
-	| New
-	| AccStack0
-	| AccStack1
-	| AccIndex0
-	| AccIndex1
-	| Loop
-		-> 0
-	| Add
-	| Sub
-	| Mult
-	| Div
-	| Mod
-	| Shl
-	| Shr
-	| UShr
-	| Or
-	| And
-	| Xor
-	| Eq
-	| Neq
-	| Gt
-	| Gte
-	| Lt
-	| Lte
-	| PhysCompare
-		-> -1
-	| AccArray -> -1
-	| SetField _ | SetIndex _ | Compare -> -1
-	| SetArray -> -2
-	| Push -> 1
-	| Pop x -> -x
-	| Apply nargs | Call nargs | TailCall (nargs,_) -> -nargs
-	| ObjCall nargs -> -(nargs + 1)
-	| MakeEnv size | MakeArray size -> -size
-	| Trap _ -> trap_stack_delta
-	| EndTrap -> -trap_stack_delta
-
-let check_stack ctx stack p =
-	if ctx.stack <> stack then error "Stack alignment failure" p
-
-let pos ctx =
-	DynArray.length ctx.ops
-
-let real_null_pos =
-	{ pline = 0; psource = "<null>" }
-
-let set_pos ctx p =
-	if p.psource = ctx.curfile then begin
-		if p.pline <> snd ctx.curpos then ctx.curpos <- (fst ctx.curpos, p.pline);
-	end else if p = real_null_pos then
-		()
-	else
-		let fid = (try
-			Hashtbl.find ctx.g.hfiles p.psource
-		with Not_found ->
-			let fid = DynArray.length ctx.g.files in
-			DynArray.add ctx.g.files p.psource;
-			Hashtbl.add ctx.g.hfiles p.psource fid;
-			fid
-		) in
-		ctx.curfile <- p.psource;
-		ctx.curpos <- (fid,p.pline)
-
-let write ctx op =
-	ctx.stack <- ctx.stack + stack_delta op;
-	DynArray.add ctx.pos ctx.curpos;
-	if op_param op then DynArray.add ctx.pos ctx.curpos;
-	DynArray.add ctx.ops op
-
-let jmp ctx =
-	let p = pos ctx in
-	write ctx (Jump 0);
-	(fun() -> DynArray.set ctx.ops p (Jump(pos ctx - p)))
-
-let cjmp cond ctx =
-	let p = pos ctx in
-	write ctx (Jump 0);
-	(fun() -> DynArray.set ctx.ops p (if cond then JumpIf(pos ctx - p) else JumpIfNot(pos ctx - p)))
-
-let trap ctx =
-	let p = pos ctx in
-	write ctx (Trap 0);
-	(fun() -> DynArray.set ctx.ops p (Trap(pos ctx - p)))
-
-let goto ctx p =
-	write ctx (Jump(p - pos ctx))
-
-let global ctx g =
-	let ginf = ctx.g in
-	try
-		Hashtbl.find ginf.globals g
-	with Not_found ->
-		let gid = DynArray.length ginf.gtable in
-		Hashtbl.add ginf.globals g gid;
-		DynArray.add ginf.gtable g;
-		gid
-
-let save_breaks ctx =
-	let oldc = ctx.continues in
-	let oldb = ctx.breaks in
-	let oldl = ctx.loop_limit in
-	ctx.loop_limit <- ctx.stack;
-	ctx.breaks <- [];
-	ctx.continues <- [];
-	(ctx , oldc, oldb , oldl)
-
-let process_continues (ctx,oldc,_,_) =
-	List.iter (fun (f,_) -> f()) ctx.continues;
-	ctx.continues <- oldc
-
-let process_breaks (ctx,_,oldb,oldl) =
-	List.iter (fun (f,_) -> f()) ctx.breaks;
-	ctx.loop_limit <- oldl;
-	ctx.breaks <- oldb
-
-let check_breaks ctx =
-	List.iter (fun (_,p) -> error "Break outside a loop" p) ctx.breaks;
-	List.iter (fun (_,p) -> error "Continue outside a loop" p) ctx.continues
-
-let make_array p el =
-	(ECall ((EConst (Builtin "array"),p),el), p)
-
-let get_cases_ints(cases) =
-	let max = ref (-1) in
-	let l = List.map (fun (e,e2) ->
-		match e with
-		| (EConst (Int n),_) when n >= 0 ->
-			if n > !max then max := n;
-			(n,e2)
-		| _ -> raise Exit
-	) cases in
-	(* // only create jump table if small or >10% cases matched *)
-	let nmatches = List.length l in
-	if nmatches < 3 then raise Exit;
-	if !max >= 16 && (nmatches * 100) / (!max + 1) < 10 then raise Exit;
-	if !max > 512 then raise Exit;
-	(l,!max + 1)
-
-let rec scan_labels ctx supported in_block e =
-	match fst e with
-	| EFunction (args,e) ->
-		let nargs = List.length args in
-		let traps = ctx.traps in
-		ctx.traps <- [];
-		ctx.stack <- ctx.stack + nargs;
-		scan_labels ctx supported false e;
-		ctx.stack <- ctx.stack - nargs;
-		ctx.traps <- traps
-	| EBlock _ ->
-		let old = ctx.stack in
-		Nast.iter (scan_labels ctx supported true) e;
-		ctx.stack <- old
-	| EVars l ->
-		if not in_block then error "Variable declaration must be done inside a block" (snd e);
-		List.iter (fun (_,e) ->
-			(match e with
-			| None -> ()
-			| Some e -> scan_labels ctx supported false e);
-			ctx.stack <- ctx.stack + 1
-		) l
-	| ELabel l when not supported ->
-		error "Label is not supported in this part of the program" (snd e);
-	| ELabel l when Hashtbl.mem ctx.g.labels l ->
-		error ("Duplicate label " ^ l) (snd e)
-	| ELabel l ->
-		let label = {
-			lname = l;
-			ltraps = List.rev ctx.traps;
-			lstack = ctx.stack;
-			lpos = None;
-			lwait = [];
-		} in
-		Hashtbl.add ctx.g.labels l label
-	| ETry (e,_,e2) ->
-		ctx.stack <- ctx.stack + trap_stack_delta;
-		ctx.traps <- ctx.stack :: ctx.traps;
-		scan_labels ctx supported false e;
-		ctx.stack <- ctx.stack - trap_stack_delta;
-		ctx.traps <- (match ctx.traps with [] -> assert false | _ :: l -> l);
-		ctx.stack <- ctx.stack + 1;
-		scan_labels ctx supported false e2;
-		ctx.stack <- ctx.stack - 1;
-	| EBinop ("=",e1,e2) ->
-		let rec is_extended (e,_) =
-			match e with
-			| EParenthesis e -> is_extended e
-			| EArray _
-			| EField _ ->
-				true
-			| _ ->
-				false
-		in
-		let ext = is_extended e1 in
-		if ext then ctx.stack <- ctx.stack + 1;
-		scan_labels ctx supported false e2;
-		ctx.stack <- ctx.stack + 1;
-		scan_labels ctx supported false e1;
-		ctx.stack <- ctx.stack - (if ext then 2 else 1);
-	| ECall ((EConst (Builtin "array"),_),e :: el) ->
-		if ctx.version >= 2 then begin
-			scan_labels ctx supported false e;
-			List.iter (fun e ->
-				ctx.stack <- ctx.stack + 1;
-				scan_labels ctx supported false e;
-			) el;
-			ctx.stack <- ctx.stack - List.length el
-		end else begin
-			List.iter (fun e ->
-				scan_labels ctx supported false e;
-				ctx.stack <- ctx.stack + 1;
-			) el;
-			scan_labels ctx supported false e;
-			ctx.stack <- ctx.stack - List.length el
-		end
-	| ECall ((EConst (Builtin x),_),el) when x <> "apply" ->
-		Nast.iter (scan_labels ctx false false) e
-	| ECall ((EConst (Builtin "apply"),_),e :: el)
-	| ECall(e,el) ->
-		List.iter (fun e ->
-			scan_labels ctx supported false e;
-			ctx.stack <- ctx.stack + 1;
-		) el;
-		scan_labels ctx supported false e;
-		ctx.stack <- ctx.stack - List.length el
-	| EObject fl ->
-		ctx.stack <- ctx.stack + 2;
-		List.iter (fun (s,e) ->
-			scan_labels ctx supported false e
-		) fl;
-		ctx.stack <- ctx.stack - 2;
-	| ESwitch (ee,[(econd,exec)],eo) ->
-		let p = snd e in
-		scan_labels ctx supported false (EIf ((EBinop ("==",ee,econd),p),exec,eo),p)
-	| ESwitch (e,cases,eo) ->
-		scan_labels ctx supported false e;
-		let delta = (try ignore(get_cases_ints cases); 0 with Exit -> 1) in
-		ctx.stack <- ctx.stack + delta;
-		List.iter (fun (e1,e2) ->
-			ctx.stack <- ctx.stack + delta;
-			scan_labels ctx supported false e1;
-			ctx.stack <- ctx.stack - delta;
-			scan_labels ctx supported false e2;
-		) cases;
-		(match eo with
-		| None -> ()
-		| Some e -> scan_labels ctx supported false e);
-		ctx.stack <- ctx.stack - delta;
-	| ENext (e1,e2) ->
-		scan_labels ctx supported in_block e1;
-		scan_labels ctx supported in_block e2;
-	| EConst _
-	| EContinue
-	| EBreak _
-	| EReturn _
-	| EIf _
-	| EWhile _
-	| EParenthesis _ ->
-		Nast.iter (scan_labels ctx supported false) e
-	| EBinop (_,_,_)
-	| EArray _
-	| EField _
-		->
-		Nast.iter (scan_labels ctx false false) e
-	| ENeko _ ->
-		assert false
-
-let compile_constant ctx c p =
-	match c with
-	| True -> write ctx AccTrue
-	| False -> write ctx AccFalse
-	| Null -> write ctx AccNull
-	| This -> write ctx AccThis
-	| Int n -> write ctx (AccInt n)
-	| Int32 n -> write ctx (AccInt32 n)
-	| Float f -> write ctx (AccGlobal (global ctx (GlobalFloat f)))
-	| String s -> write ctx (AccGlobal (global ctx (GlobalString s)))
-	| Builtin s ->
-		(match s with
-		| "tnull" -> write ctx (AccInt 0)
-		| "tint" -> write ctx (AccInt 1)
-		| "tfloat" -> write ctx (AccInt 2)
-		| "tbool" -> write ctx (AccInt 3)
-		| "tstring" -> write ctx (AccInt 4)
-		| "tobject" -> write ctx (AccInt 5)
-		| "tarray" -> write ctx (AccInt 6)
-		| "tfunction" -> write ctx (AccInt 7)
-		| "tabstract" -> write ctx (AccInt 8)
-		| s ->
-			write ctx (AccBuiltin s))
-	| Ident s ->
-		try
-			let l = PMap.find s ctx.locals in
-			if l <= ctx.limit then
-				let e = (try
-					PMap.find s ctx.env
-				with Not_found ->
-					let e = ctx.nenv in
-					ctx.nenv <- ctx.nenv + 1;
-					ctx.env <- PMap.add s e ctx.env;
-					e
-				) in
-				write ctx (AccEnv e);
-			else
-				let p = ctx.stack - l in
-				write ctx (if p = 0 then AccStack0 else if p = 1 then AccStack1 else AccStack p);
-		with Not_found ->
-			let g = global ctx (GlobalVar s) in
-			write ctx (AccGlobal g)
-
-let rec compile_access ctx e =
-	match fst e with
-	| EConst (Ident s) ->
-		(try
-			let l = PMap.find s ctx.locals in
-			if l <= ctx.limit then
-				let e = (try
-					PMap.find s ctx.env
-				with Not_found ->
-					let e = ctx.nenv in
-					ctx.nenv <- ctx.nenv + 1;
-					ctx.env <- PMap.add s e ctx.env;
-					e
-				) in
-				XEnv e
-			else
-				XStack l
-		with Not_found ->
-			let g = global ctx (GlobalVar s) in
-			XGlobal g)
-	| EField (e,f) ->
-		compile ctx false e;
-		write ctx Push;
-		XField f
-	| EArray (e1,(EConst (Int n),_)) ->
-		compile ctx false e1;
-		write ctx Push;
-		XIndex n
-	| EArray (ea,ei) ->
-		compile ctx false ei;
-		write ctx Push;
-		compile ctx false ea;
-		write ctx Push;
-		XArray
-	| EConst This ->
-		XThis
-	| _ ->
-		error "Invalid access" (snd e)
-
-and compile_access_set ctx a =
-	match a with
-	| XEnv n -> write ctx (SetEnv n)
-	| XStack l -> write ctx (SetStack (ctx.stack - l))
-	| XGlobal g -> write ctx (SetGlobal g)
-	| XField f -> write ctx (SetField f)
-	| XIndex i -> write ctx (SetIndex i)
-	| XThis -> write ctx SetThis
-	| XArray -> write ctx SetArray
-
-and compile_access_get ctx a =
-	match a with
-	| XEnv n -> write ctx (AccEnv n)
-	| XStack l -> write ctx (AccStack (ctx.stack - l))
-	| XGlobal g -> write ctx (AccGlobal g)
-	| XField f -> write ctx (AccField f)
-	| XIndex i -> write ctx (AccIndex i)
-	| XThis -> write ctx AccThis
-	| XArray ->
-		write ctx Push;
-		write ctx (AccStack 2);
-		write ctx AccArray
-
-and write_op ctx op p =
-	match op with
-	| "+" -> write ctx Add
-	| "-" -> write ctx Sub
-	| "/" -> write ctx Div
-	| "*" -> write ctx Mult
-	| "%" -> write ctx Mod
-	| "<<" -> write ctx Shl
-	| ">>" -> write ctx Shr
-	| ">>>" -> write ctx UShr
-	| "|" -> write ctx Or
-	| "&" -> write ctx And
-	| "^" -> write ctx Xor
-	| "==" -> write ctx Eq
-	| "!=" -> write ctx Neq
-	| ">" -> write ctx Gt
-	| ">=" -> write ctx Gte
-	| "<" -> write ctx Lt
-	| "<=" -> write ctx Lte
-	| _ -> error "Unknown operation" p
-
-and compile_binop ctx tail op e1 e2 p =
-	match op with
-	| "=" ->
-		let a = compile_access ctx e1 in
-		compile ctx false e2;
-		compile_access_set ctx a
-	| "&&" ->
-		compile ctx false e1;
-		let jnext = cjmp false ctx in
-		compile ctx tail e2;
-		jnext()
-	| "||" ->
-		compile ctx false e1;
-		let jnext = cjmp true ctx in
-		compile ctx tail e2;
-		jnext()
-	| "++="
-	| "--=" ->
-		write ctx Push;
-		let base = ctx.stack in
-		let a = compile_access ctx e1 in
-		compile_access_get ctx a;
-		write ctx (SetStack(ctx.stack - base));
-		write ctx Push;
-		compile ctx false e2;
-		write_op ctx (String.sub op 0 (String.length op - 2)) p;
-		compile_access_set ctx a;
-		write ctx (AccStack 0);
-		write ctx (Pop 1);
-	| "+="
-	| "-="
-	| "/="
-	| "*="
-	| "%="
-	| "<<="
-	| ">>="
-	| ">>>="
-	| "|="
-	| "&="
-	| "^=" ->
-		let a = compile_access ctx e1 in
-		compile_access_get ctx a;
-		write ctx Push;
-		compile ctx false e2;
-		write_op ctx (String.sub op 0 (String.length op - 1)) p;
-		compile_access_set ctx a
-	| _ ->
-		match (op , e1 , e2) with
-		| ("==" , _ , (EConst Null,_)) ->
-			compile ctx false e1;
-			write ctx IsNull
-		| ("!=" , _ , (EConst Null,_)) ->
-			compile ctx false e1;
-			write ctx IsNotNull
-		| ("==" , (EConst Null,_) , _) ->
-			compile ctx false e2;
-			write ctx IsNull
-		| ("!=" , (EConst Null,_) , _) ->
-			compile ctx false e2;
-			write ctx IsNotNull
-		| ("-", (EConst (Int 0),_) , (EConst (Int i),_)) ->
-			compile ctx tail (EConst (Int (-i)),p)
-		| _ ->
-			compile ctx false e1;
-			write ctx Push;
-			compile ctx false e2;
-			write_op ctx op p
-
-and compile_function main params e =
-	let ctx = {
-		g = main.g;
-		(* // reset *)
-		ops = DynArray.create();
-		pos = DynArray.create();
-		breaks = [];
-		continues = [];
-		env = PMap.empty;
-		nenv = 0;
-		traps = [];
-		limit = main.stack;
-		(* // dup *)
-		version = main.version;
-		stack = main.stack;
-		locals = main.locals;
-		loop_limit = main.loop_limit;
-		curpos = main.curpos;
-		curfile = main.curfile;
-	} in
-	List.iter (fun v ->
-		ctx.stack <- ctx.stack + 1;
-		ctx.locals <- PMap.add v ctx.stack ctx.locals;
-	) params;
-	let s = ctx.stack in
-	compile ctx true e;
-	write ctx (Ret (ctx.stack - ctx.limit));
-	check_stack ctx s (snd e);
-	check_breaks ctx;
-	(* // add let *)
-	let gid = DynArray.length ctx.g.gtable in
-	ctx.g.functions <- (ctx.ops,ctx.pos,gid,List.length params) :: ctx.g.functions;
-	DynArray.add ctx.g.gtable (GlobalFunction(gid,-1));
-	(* // environment *)
-	if ctx.nenv > 0 then
-		let a = Array.make ctx.nenv "" in
-		PMap.iter (fun v i -> a.(i) <- v) ctx.env;
-		Array.iter (fun v ->
-			compile_constant main (Ident v) (snd e);
-			write main Push;
-		) a;
-		write main (AccGlobal gid);
-		write main (MakeEnv ctx.nenv);
-	else
-		write main (AccGlobal gid);
-
-and compile_builtin ctx tail b el p =
-	match (b , el) with
-	| ("istrue" , [e]) ->
-		compile ctx false e;
-		write ctx Bool
-	| ("not" , [e]) ->
-		compile ctx false e;
-		write ctx Not
-	| ("typeof" , [e]) ->
-		compile ctx false e;
-		write ctx TypeOf
-	| ("hash" , [e]) ->
-		compile ctx false e;
-		write ctx Hash
-	| ("new" , [e]) ->
-		compile ctx false e;
-		write ctx New
-	| ("compare" , [e1;e2]) ->
-		compile ctx false e1;
-		write ctx Push;
-		compile ctx false e2;
-		write ctx Compare
-	| ("pcompare" , [e1;e2]) ->
-		compile ctx false e1;
-		write ctx Push;
-		compile ctx false e2;
-		write ctx PhysCompare
-	| ("goto" , [(EConst (Ident l) , _)] ) ->
-		let l = (try Hashtbl.find ctx.g.labels l with Not_found -> error ("Unknown label " ^ l) p) in
-		let os = ctx.stack in
-		let rec loop l1 l2 =
-			match l1, l2 with
-			| x :: l1 , y :: l2 when x == y -> loop l1 l2
-			| _ -> (l1,l2)
-		in
-		let straps , dtraps = loop (List.rev ctx.traps) l.ltraps in
-		List.iter (fun l ->
-			if ctx.stack <> l then write ctx (Pop(ctx.stack - l));
-			write ctx EndTrap;
-		) (List.rev straps);
-		let dtraps = List.map (fun l ->
-			let l = l - trap_stack_delta in
-			if l < ctx.stack then write ctx (Pop(ctx.stack - l));
-			while ctx.stack < l do
-				write ctx Push;
-			done;
-			trap ctx
-		) dtraps in
-		if l.lstack < ctx.stack then write ctx (Pop(ctx.stack - l.lstack));
-		while l.lstack > ctx.stack do
-			write ctx Push;
-		done;
-		ctx.stack <- os;
-		(match l.lpos with
-		| None -> l.lwait <- jmp ctx :: l.lwait
-		| Some p -> write ctx (Jump p));
-		List.iter (fun t ->
-			t();
-			write ctx Push;
-			compile_constant ctx (Builtin "raise") p;
-			write ctx (Call 1);
-			(* // insert an infinite loop in order to
-			// comply with bytecode checker *)
-			let _ = jmp ctx in
-			()
-		) dtraps;
-	| ("goto" , _) ->
-		error "Invalid $goto statement" p
-	| ("array",e :: el) ->
-		let count = List.length el in
-		(* // a single let can't have >128 stack *)
-		if count > 120 - ctx.stack && count > 8 then begin
-			(* // split in 8 and recurse *)
-			let part = count lsr 3 in
-			let rec loop el acc count =
-				match el with
-				| [] -> [List.rev acc]
-				| e :: l ->
-					if count == part then
-						(List.rev acc) :: loop el [] 0
-					else
-						loop l (e :: acc) (count + 1)
-			in
-			let arr = make_array p (List.map (make_array p) (loop (e :: el) [] 0)) in
-			compile_builtin ctx tail "aconcat" [arr] p;
-		end else if ctx.version >= 2 then begin
-			compile ctx false e;
-			List.iter (fun e ->
-				write ctx Push;
-				compile ctx false e;
-			) el;
-			write ctx (MakeArray count);
-		end else begin
-			List.iter (fun e ->
-				compile ctx false e;
-				write ctx Push;
-			) el;
-			compile ctx false e;
-			write ctx (MakeArray count);
-		end
-	| ("apply",e :: el) ->
-		List.iter (fun e ->
-			compile ctx false e;
-			write ctx Push;
-		) el;
-		compile ctx false e;
-		let nargs = List.length el in
-		if nargs > 0 then write ctx (Apply nargs);
-	| _ ->
-		List.iter (fun e ->
-			compile ctx false e;
-			write ctx Push;
-		) el;
-		compile_constant ctx (Builtin b) p;
-		if tail then
-			write ctx (TailCall(List.length el,ctx.stack - ctx.limit))
-		else
-			write ctx (Call (List.length el))
-
-and compile ctx tail (e,p) =
-	set_pos ctx p;
-	match e with
-	| EConst c ->
-		compile_constant ctx c p
-	| EBlock [] ->
-		write ctx AccNull
-	| EBlock el ->
-		let locals = ctx.locals in
-		let stack = ctx.stack in
-		let rec loop(el) =
-			match el with
-			| [] -> assert false
-			| [e] -> compile ctx tail e
-			| [e; (ELabel _,_) as f] ->
-				compile ctx tail e;
-				compile ctx tail f
-			| e :: el ->
-				compile ctx false e;
-				loop el
-		in
-		loop el;
-		if stack < ctx.stack then write ctx (Pop (ctx.stack - stack));
-		check_stack ctx stack p;
-		ctx.locals <- locals
-	| EParenthesis e ->
-		compile ctx tail e
-	| EField (e,f) ->
-		compile ctx false e;
-		write ctx (AccField f)
-	| ECall (e,a :: b :: c :: d :: x1 :: x2 :: l) when (match e with (EConst (Builtin "array"),_) -> false | _ -> true) ->
-		let call = (EConst (Builtin "call"),p) in
-		let args = (ECall ((EConst (Builtin "array"),p),(a :: b :: c :: d :: x1 :: x2 :: l)),p) in
-		(match e with
-		| (EField (e,name) , p2) ->
-			let locals = ctx.locals in
-			let etmp = (EConst (Ident "$tmp"),p2) in
-			compile ctx false (EVars [("$tmp",Some e)],p2);
-			compile ctx tail (ECall (call,[(EField (etmp,name),p2);etmp;args]), p);
-			write ctx (Pop 1);
-			ctx.locals <- locals
-		| _ ->
-			compile ctx tail (ECall (call,[e; (EConst This,p); args]),p))
-	| ECall ((EConst (Builtin b),_),el) ->
-		compile_builtin ctx tail b el p
-	| ECall ((EField (e,f),_),el) ->
-		List.iter (fun e ->
-			compile ctx false e;
-			write ctx Push;
-		) el;
-		compile ctx false e;
-		write ctx Push;
-		write ctx (AccField f);
-		write ctx (ObjCall(List.length el))
-	| ECall (e,el) ->
-		List.iter (fun e ->
-			compile ctx false e;
-			write ctx Push;
-		) el;
-		compile ctx false e;
-		if tail then
-			write ctx (TailCall(List.length el,ctx.stack - ctx.limit))
-		else
-			write ctx (Call(List.length el))
-	| EArray (e1,(EConst (Int n),_)) ->
-		compile ctx false e1;
-		write ctx (if n == 0 then AccIndex0 else if n == 1 then AccIndex1 else AccIndex n)
-	| EArray (e1,e2) ->
-		compile ctx false e1;
-		write ctx Push;
-		compile ctx false e2;
-		write ctx AccArray
-	| EVars vl ->
-		List.iter (fun (v,o) ->
-			(match o with
-			| None -> write ctx AccNull
-			| Some e -> compile ctx false e);
-			write ctx Push;
-			ctx.locals <- PMap.add v ctx.stack ctx.locals;
-		) vl
-	| EWhile (econd,e,NormalWhile) ->
-		let start = pos ctx in
-		if ctx.version >= 2 then write ctx Loop;
-		compile ctx false econd;
-		let jend = cjmp false ctx in
-		let save = save_breaks ctx in
-		compile ctx false e;
-		process_continues save;
-		goto ctx start;
-		process_breaks save;
-		jend();
-	| EWhile (econd,e,DoWhile) ->
-		let start = pos ctx in
-		if ctx.version >= 2 then write ctx Loop;
-		let save = save_breaks ctx in
-		compile ctx false e;
-		process_continues save;
-		compile ctx false econd;
-		write ctx (JumpIf (start - pos ctx));
-		process_breaks save
-	| EIf (e,e1,e2) ->
-		let stack = ctx.stack in
-		compile ctx false e;
-		let jelse = cjmp false ctx in
-		compile ctx tail e1;
-		check_stack ctx stack p;
-		(match e2 with
-		| None ->
-			jelse()
-		| Some e2 ->
-			let jend = jmp ctx in
-			jelse();
-			compile ctx tail e2;
-			check_stack ctx stack p;
-			jend())
-	| ETry (e,v,ecatch) ->
-		let trap = trap ctx in
-		let breaks = ctx.breaks in
-		let continues = ctx.continues in
-		ctx.breaks <- [];
-		ctx.continues <- [];
-		ctx.traps <- ctx.stack :: ctx.traps;
-		compile ctx false e;
-		if ctx.breaks <> [] then error "Break in try...catch is not allowed" p;
-		if ctx.continues <> [] then error "Continue in try...catch is not allowed" p;
-		ctx.breaks <- breaks;
-		ctx.continues <- continues;
-		write ctx EndTrap;
-		ctx.traps <- (match ctx.traps with [] -> assert false | _ :: l -> l);
-		let jend = jmp ctx in
-		trap();
-		write ctx Push;
-		let locals = ctx.locals in
-		ctx.locals <- PMap.add v ctx.stack ctx.locals;
-		compile ctx tail ecatch;
-		write ctx (Pop 1);
-		ctx.locals <- locals;
-		jend()
-	| EBinop (op,e1,e2) ->
-		compile_binop ctx tail op e1 e2 p
-	| EReturn e ->
-		(match e with None -> write ctx AccNull | Some e -> compile ctx (ctx.traps == []) e);
-		let stack = ctx.stack in
-		List.iter (fun t ->
-			if ctx.stack > t then write ctx (Pop(ctx.stack - t));
-			write ctx EndTrap;
-		) ctx.traps;
-		write ctx (Ret (ctx.stack - ctx.limit));
-		ctx.stack <- stack
-	| EBreak e ->
-		(match e with
-		| None -> ()
-		| Some e -> compile ctx false e);
-		if ctx.loop_limit <> ctx.stack then begin
-			let s = ctx.stack in
-			write ctx (Pop(ctx.stack - ctx.loop_limit));
-			ctx.stack <- s;
-		end;
-		ctx.breaks <- (jmp ctx , p) :: ctx.breaks
-	| EContinue ->
-		if ctx.loop_limit <> ctx.stack then begin
-			let s = ctx.stack in
-			write ctx (Pop(ctx.stack - ctx.loop_limit));
-			ctx.stack <- s;
-		end;
-		ctx.continues <- (jmp ctx , p) :: ctx.continues
-	| EFunction (params,e) ->
-		compile_function ctx params e
-	| ENext (e1,e2) ->
-		compile ctx false e1;
-		compile ctx tail e2
-	| EObject [] ->
-		write ctx AccNull;
-		write ctx New
-	| EObject fl ->
-		let fields = List.sort compare (List.map fst fl) in
-		let id = (try
-			Hashtbl.find ctx.g.gobjects fields
-		with Not_found ->
-			let id = global ctx (GlobalVar ("o:" ^ string_of_int (Hashtbl.length ctx.g.gobjects))) in
-			Hashtbl.add ctx.g.gobjects fields id;
-			id
-		) in
-		write ctx (AccGlobal id);
-		write ctx New;
-		write ctx Push;
-		List.iter (fun (f,e) ->
-			write ctx Push;
-			compile ctx false e;
-			write ctx (SetField f);
-			write ctx AccStack0;
-		) fl;
-		write ctx (Pop 1)
-	| ELabel l ->
-		let l = (try Hashtbl.find ctx.g.labels l with Not_found -> assert false) in
-		if ctx.stack <> l.lstack || List.rev ctx.traps <> l.ltraps then error (Printf.sprintf "Label failure %d %d" ctx.stack l.lstack) p;
-		List.iter (fun f -> f()) l.lwait;
-		l.lwait <- [];
-		l.lpos <- Some (pos ctx)
-	| ESwitch (e,[(econd,exec)],eo) ->
-		compile ctx tail (EIf ((EBinop ("==",e,econd),p),exec,eo),p)
-	| ENeko _ ->
-		assert false
-	| ESwitch (e,cases,eo) ->
-		try
-			let ints , size = get_cases_ints cases in
-			compile ctx false e;
-			write ctx (JumpTable size);
-			let tbl = Array.make size None in
-			List.iter (fun (i,e) ->
-				tbl.(i) <- Some e;
-			) ints;
-			let tbl = Array.map (fun e -> (jmp ctx,e)) tbl in
-			Array.iter (fun (j,e) ->
-				if e == None then j()
-			) tbl;
-			(match eo with
-			| None -> write ctx AccNull
-			| Some e -> compile ctx tail e);
-			let jump_end = jmp ctx in
-			let tbl = Array.map (fun (j,e) ->
-				match e with
-				| Some e ->
-					j();
-					compile ctx tail e;
-					jmp ctx
-				| None ->
-					(fun() -> ())
-			) tbl in
-			jump_end();
-			Array.iter (fun j -> j()) tbl
-		with Exit ->
-			compile ctx false e;
-			write ctx Push;
-			let jumps = List.map (fun (e1,e2) ->
-				write ctx AccStack0;
-				write ctx Push;
-				compile ctx false e1;
-				write ctx Eq;
-				(cjmp true ctx , e2)
-			) cases in
-			(match eo with
-			| None -> write ctx AccNull
-			| Some e -> compile ctx tail (EBlock [e],p));
-			let jump_end = jmp ctx in
-			let jumps = List.map (fun (j,e) ->
-				j();
-				compile ctx tail (EBlock [e],p);
-				jmp ctx;
-			) jumps in
-			jump_end();
-			List.iter (fun j -> j()) jumps;
-			write ctx (Pop 1)
-
-let compile version ast =
-	let g = {
-		globals = Hashtbl.create 0;
-		gobjects = Hashtbl.create 0;
-		gtable = DynArray.create();
-		functions = [];
-		labels = Hashtbl.create 0;
-		hfiles = Hashtbl.create 0;
-		files = DynArray.create();
-	} in
-	let ctx = {
-		g = g;
-		version = version;
-		stack = 0;
-		loop_limit = 0;
-		limit = -1;
-		locals = PMap.empty;
-		ops = DynArray.create();
-		breaks = [];
-		continues = [];
-		env = PMap.empty;
-		nenv = 0;
-		traps = [];
-		pos = DynArray.create();
-		curpos = (0,0);
-		curfile = "_";
-	} in
-	if version >= 2 then DynArray.add g.gtable (GlobalVersion version);
-	scan_labels ctx true true ast;
-	compile ctx false ast;
-	check_breaks ctx;
-	if g.functions <> [] || Hashtbl.length g.gobjects <> 0 then begin
-		let ctxops = ctx.ops in
-		let ctxpos = ctx.pos in
-		let ops = DynArray.create() in
-		let pos = DynArray.create() in
-		ctx.pos <- pos;
-		ctx.ops <- ops;
-		write ctx (Jump 0);
-		List.iter (fun (fops,fpos,gid,nargs) ->
-			DynArray.set g.gtable gid (GlobalFunction(DynArray.length ops,nargs));
-			DynArray.append fops ops;
-			DynArray.append fpos pos;
-		) (List.rev g.functions);
-		DynArray.set ops 0 (Jump (DynArray.length ops));
-		let objects = DynArray.create() in
-		Hashtbl.iter (fun fl g -> DynArray.add objects (fl,g)) g.gobjects;
-		let objects = DynArray.to_array objects in
-		Array.sort (fun (_,g1) (_,g2) -> g1 - g2) objects;
-		Array.iter (fun (fl,g) ->
-			write ctx AccNull;
-			write ctx New;
-			write ctx (SetGlobal g);
-			List.iter (fun f ->
-				write ctx (AccGlobal g);
-				write ctx Push;
-				write ctx (SetField f);
-			) fl
-		) objects;
-		DynArray.append ctxpos pos;
-		DynArray.append ctxops ops;
-	end;
-	DynArray.add g.gtable (GlobalDebug (DynArray.to_array ctx.g.files,DynArray.to_array ctx.pos));
-	(DynArray.to_array g.gtable, DynArray.to_array ctx.ops)
-

libs/neko/nxml.ml

@@ -49,9 +49,6 @@ let rec to_xml_rec p2 ast =
 		| String s ->
 			name := "s";
 			aval := Some s;
-		| Int32 i ->
-			name := "i";
-			aval := Some (Int32.to_string i);
 		)
 	| EBlock el ->
 		name := "b";

libs/swflib/Makefile

@@ -33,7 +33,7 @@ swfPic.cmx: swf.cmx png.cmi
 
 
 clean:
-	rm -f swflib.cmxa swflib.lib swflib.a as3.cmi as3hl.cmi
+	rm -f swflib.cmxa swflib.lib swflib.a
 	rm -f $(MODULES) $(MODULES:.cmx=.obj) $(MODULES:.cmx=.cmi) $(MODULES:.cmx=.o)
 
 # SUFFIXES

libs/swflib/swf.ml

@@ -444,7 +444,6 @@ type button_record = {
 	btr_mpos : matrix;
 	btr_color : color_transform_alpha option;
 	btr_filters : filter list option;
-	btr_blendmode : int option;
 }
 
 type button_action = {

libs/swflib/swfParser.ml

@@ -251,7 +251,6 @@ let filters_length l =
 let button_record_length r =
 	1 + 2 + 2 + matrix_length r.btr_mpos + (match r.btr_color with None -> 0 | Some c -> cxa_length c)
 	+ opt_len filters_length r.btr_filters
-	+ (match r.btr_blendmode with None -> 0 | Some c -> 1)
 
 let button_action_length r =
 	2 + 2 + actions_length r.bta_actions
@@ -1054,7 +1053,6 @@ let rec parse_button_records ch color =
 		let mpos = read_matrix ch in
 		let cxa = (if color then Some (read_cxa ch) else None) in
 		let filters = (if flags land 16 = 0 then None else Some (parse_filters ch)) in
-		let blendmode = (if flags land 32 = 0 then None else Some (read_byte ch)) in
 		let r = {
 			btr_flags = flags;
 			btr_cid = cid;
@@ -1062,7 +1060,6 @@ let rec parse_button_records ch color =
 			btr_mpos = mpos;
 			btr_color = cxa;
 			btr_filters = filters;
-			btr_blendmode = blendmode;
 		} in
 		r :: parse_button_records ch color
 
@@ -1755,11 +1752,7 @@ let write_button_record ch r =
 	opt (fun l ->
 		write_byte ch (List.length l);
 		List.iter (write_filter ch) l
-	) r.btr_filters;
-	(match r.btr_blendmode with
-	| None -> ()
-	| Some c ->
-		write_byte ch c)
+	) r.btr_filters
 
 let rec write_button_actions ch = function
 	| [] -> assert false

libs/xml-light/dtd.ml

@@ -20,7 +20,7 @@
  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
  * MA 02110-1301 USA
  *)
-
+  
 open Xml
 open Printf
 
@@ -102,18 +102,16 @@ exception Prove_error of prove_error
 
 type dtd = dtd_item list
 
-module StringMap = Map.Make(String)
-
-type 'a map = 'a StringMap.t ref
+type ('a,'b) hash = ('a,'b) Hashtbl.t
 
 type checked = {
-	c_elements : dtd_element_type map;
-	c_attribs : (dtd_attr_type * dtd_attr_default) map map;
+	c_elements : (string,dtd_element_type) hash;
+	c_attribs : (string,(string,(dtd_attr_type * dtd_attr_default)) hash) hash;
 }
 
 type dtd_state = {
-	elements : dtd_element_type map;
-	attribs : (dtd_attr_type * dtd_attr_default) map map;
+	elements : (string,dtd_element_type) hash;
+	attribs : (string,(string,(dtd_attr_type * dtd_attr_default)) hash) hash;
 	mutable current : dtd_element_type;
 	mutable curtag : string;
 	state : (string * dtd_element_type) Stack.t;
@@ -124,21 +122,7 @@ let file_not_found = ref (fun _ -> assert false)
 let _raises e =
 	file_not_found := e
 
-let create_map() = ref StringMap.empty
-
-let empty_map = create_map()
-
-let find_map m k = StringMap.find k (!m)
-
-let set_map m k v = m := StringMap.add k v (!m)
-
-let unset_map m k = m := StringMap.remove k (!m)
-
-let iter_map f m = StringMap.iter f (!m)
-
-let fold_map f m = StringMap.fold f (!m)
-
-let mem_map m k = StringMap.mem k (!m)
+let empty_hash = Hashtbl.create 0
 
 let pos source =
 	let line, lstart, min, max = Xml_lexer.pos source in
@@ -183,30 +167,30 @@ let parse_file fname =
 			raise e
 
 let check dtd =
-	let attribs = create_map() in
-	let hdone = create_map() in
-	let htodo = create_map() in
+	let attribs = Hashtbl.create 0 in
+	let hdone = Hashtbl.create 0 in
+	let htodo = Hashtbl.create 0 in
 	let ftodo tag from =
 		try
-			ignore(find_map hdone tag);
+			ignore(Hashtbl.find hdone tag);
 		with
 			Not_found ->
 				try
-					match find_map htodo tag with
-					| None -> set_map htodo tag from
+					match Hashtbl.find htodo tag with
+					| None -> Hashtbl.replace htodo tag from
 					| Some _ -> ()
 				with
 					Not_found ->
-						set_map htodo tag from
+						Hashtbl.add htodo tag from
 	in
 	let fdone tag edata =
-		try
-			ignore(find_map hdone tag);
+		try 
+			ignore(Hashtbl.find hdone tag);
 			raise (Check_error (ElementDefinedTwice tag));
 		with
 			Not_found ->
-				unset_map htodo tag;
-				set_map hdone tag edata
+				Hashtbl.remove htodo tag;
+				Hashtbl.add hdone tag edata
 	in
 	let fattrib tag aname adata =
 		(match adata with
@@ -215,18 +199,18 @@ let check dtd =
 	    | DTDID,_ -> raise (Check_error (WrongImplicitValueForID (tag,aname)))
 	    | _ -> ());
 		let h = (try
-				find_map attribs tag
+				Hashtbl.find attribs tag
 			with
 				Not_found ->
-					let h = create_map() in
-					set_map attribs tag h;
+					let h = Hashtbl.create 1 in
+					Hashtbl.add attribs tag h;
 					h) in
 		try
-			ignore(find_map h aname);
+			ignore(Hashtbl.find h aname);
 			raise (Check_error (AttributeDefinedTwice (tag,aname)));
 		with
 			Not_found ->
-				set_map h aname adata
+				Hashtbl.add h aname adata
 	in
 	let check_item = function
 		| DTDAttribute (tag,aname,atype,adef) ->
@@ -259,7 +243,7 @@ let check dtd =
 			check_type etype
 	in
 	List.iter check_item dtd;
-	iter_map (fun t from ->
+	Hashtbl.iter (fun t from ->
 		match from with
 		| None -> raise (Check_error (ElementNotDeclared t))
 		| Some tag -> raise (Check_error (ElementReferenced (t,tag)))
@@ -278,7 +262,7 @@ let start_prove dtd root =
 		curtag = "_root";
 	} in
 	try
-		ignore(find_map d.elements (String.uppercase root));
+		ignore(Hashtbl.find d.elements (String.uppercase root));
 		d
 	with
 		Not_found -> raise (Check_error (ElementNotDeclared root))
@@ -296,7 +280,7 @@ let trace dtd tag =
 
 exception TmpResult of dtd_result
 
-let prove_child dtd tag =
+let prove_child dtd tag = 
 	match dtd.current with
 	| DTDEmpty -> raise (Prove_error EmptyExpected)
 	| DTDAny -> ()
@@ -339,7 +323,7 @@ let prove_child dtd tag =
 				| true -> DTDMatched
 				| false -> DTDNotMatched)
 			with
-				TmpResult r -> r)
+				TmpResult r -> r)	
 		| DTDChildren [] -> assert false (* DTD is checked ! *)
 		| DTDChildren (h :: t) ->
 			(match update h with
@@ -383,11 +367,11 @@ let prove_attrib dtd hid hidref attr aname (atype,adef) accu =
 		if not (List.exists ((=) v) l) then raise (Prove_error (InvalidAttributeValue aname))
 	| DTDID, None -> ()
 	| DTDID, Some id ->
-		if mem_map hid id then raise (Prove_error (DuplicateID id));
-		set_map hid id ()
+		if Hashtbl.mem hid id then raise (Prove_error (DuplicateID id));
+		Hashtbl.add hid id ()
 	| DTDIDRef, None -> ()
-	| DTDIDRef, Some idref ->
-		set_map hidref idref ());
+	| DTDIDRef, Some idref -> 
+		Hashtbl.add hidref idref ());
 	match adef, aval with
 	| DTDRequired, None -> raise (Prove_error (RequiredAttribute aname))
 	| DTDFixed v, Some av when v <> av -> raise (Prove_error (InvalidAttributeValue aname))
@@ -401,7 +385,7 @@ let prove_attrib dtd hid hidref attr aname (atype,adef) accu =
 
 let check_attrib ahash (aname,_) =
 	try
-		ignore(find_map ahash aname);
+		ignore(Hashtbl.find ahash aname);
 	with
 		Not_found -> raise (Prove_error (UnexpectedAttribute aname))
 
@@ -414,12 +398,12 @@ let rec do_prove hid hidref dtd = function
 		let uattr = List.map (fun (aname,aval) -> String.uppercase aname , aval) attr in
 		prove_child dtd (Some utag);
 		Stack.push (dtd.curtag,dtd.current) dtd.state;
-		let elt = (try find_map dtd.elements utag with Not_found -> raise (Prove_error (UnexpectedTag tag))) in
-		let ahash = (try find_map dtd.attribs utag with Not_found -> empty_map) in
+		let elt = (try Hashtbl.find dtd.elements utag with Not_found -> raise (Prove_error (UnexpectedTag tag))) in
+		let ahash = (try Hashtbl.find dtd.attribs utag with Not_found -> empty_hash) in
 		dtd.curtag <- tag;
 		dtd.current <- elt;
 		List.iter (check_attrib ahash) uattr;
-		let attr = fold_map (prove_attrib dtd hid hidref uattr) ahash [] in
+		let attr = Hashtbl.fold (prove_attrib dtd hid hidref uattr) ahash [] in
 		let childs = ref (List.map (do_prove hid hidref dtd) childs) in
 		(match dtd.current with
 		| DTDAny
@@ -427,7 +411,7 @@ let rec do_prove hid hidref dtd = function
 		| DTDChild elt ->
 			let name = ref "" in
 			let rec check = function
-				| DTDTag t ->
+				| DTDTag t -> 
 					name := t;
 					false
 				| DTDPCData when !childs = [] ->
@@ -453,11 +437,11 @@ let rec do_prove hid hidref dtd = function
 		Element (tag,attr,!childs)
 
 let prove dtd root xml =
-	let hid = create_map() in
-	let hidref = create_map() in
+	let hid = Hashtbl.create 0 in
+	let hidref = Hashtbl.create 0 in
 	let x = do_prove hid hidref (start_prove dtd root) xml in
-	iter_map (fun id () ->
-		if not (mem_map hid id) then raise (Prove_error (MissingID id))
+	Hashtbl.iter (fun id () ->
+		if not (Hashtbl.mem hid id) then raise (Prove_error (MissingID id))
 	) hidref;
 	x
 
@@ -534,7 +518,7 @@ let to_string = function
 				in
 				let rec root = function
 					| DTDOptional c
-					| DTDZeroOrMore c
+					| DTDZeroOrMore c 
 					| DTDOneOrMore c ->
 						root c
 					| DTDChoice [_]