added OSetMethod (allow to track which method belong to which object)

Makefile

@@ -175,7 +175,7 @@ src/generators/genpy.$(MODULE_EXT): src/typing/abstract.$(MODULE_EXT) src/global
 
 src/generators/genswf.$(MODULE_EXT): src/globals.$(MODULE_EXT) src/typing/type.$(MODULE_EXT) src/generators/genswf9.$(MODULE_EXT) src/context/common.$(MODULE_EXT) src/syntax/ast.$(MODULE_EXT)
 
-src/generators/hlinterp.$(MODULE_EXT): src/context/common.$(MODULE_EXT) src/generators/hlcode.$(MODULE_EXT) src/macro/interp.$(MODULE_EXT)
+src/generators/hlinterp.$(MODULE_EXT): src/context/common.$(MODULE_EXT) src/generators/hlcode.$(MODULE_EXT) src/macro/interp.$(MODULE_EXT) src/generators/hlopt.$(MODULE_EXT)
 
 src/generators/hl2c.$(MODULE_EXT): src/generators/hlcode.$(MODULE_EXT)
 

src/generators/genhl.ml

@@ -2723,7 +2723,7 @@ and make_fun ?gen_content ctx name fidx f cthis cparent =
 	} 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
+	(*let f = if ctx.optimize then Hlopt.optimize ctx.dump_out f else f in*)
 	DynArray.add ctx.cfunctions f;
 	capt
 
@@ -2853,14 +2853,7 @@ let generate_static_init ctx =
 
 				(match c.cl_constructor with
 				| None -> ()
-				| Some f ->
-					(* set __constructor__ *)
-					let r = alloc_tmp ctx (match to_type ctx f.cf_type with
-						| HFun (args,ret) -> HFun (class_type ctx c (List.map snd c.cl_params) false :: args, ret)
-						| _ -> assert false
-					) in
-					op ctx (OStaticClosure (r, alloc_fid ctx c f));
-					op ctx (OSetField (rc,index "__constructor__",r)));
+				| Some f -> op ctx (OSetMethod (rc,index "__constructor__",alloc_fid ctx c f)));
 
 				let gather_implements() =
 					let classes = ref [] in
@@ -2892,9 +2885,7 @@ let generate_static_init ctx =
 				List.iter (fun f ->
 					match f.cf_kind with
 					| Method _ when not (is_extern_field f) ->
-						let cl = alloc_tmp ctx (to_type ctx f.cf_type) in
-						op ctx (OStaticClosure (cl, alloc_fid ctx c f));
-						op ctx (OSetField (rc,index f.cf_name,cl));
+						op ctx (OSetMethod (rc,index f.cf_name,alloc_fid ctx c f));
 					| _ ->
 						()
 				) c.cl_ordered_statics;

src/generators/hl2c.ml

@@ -226,7 +226,7 @@ let write_c version file (code:code) =
 	Array.iter (fun f ->
 		Array.iteri (fun i op ->
 			match op with
-			| OStaticClosure (_,fid) ->
+			| OStaticClosure (_,fid) | OSetMethod (_,_,fid) ->
 				Hashtbl.replace used_closures fid ()
 			| OBytes (_,sid) ->
 				Hashtbl.replace bytes_strings sid ()
@@ -925,6 +925,9 @@ let write_c version file (code:code) =
 					assert false)
 			| OStaticClosure (r,fid) ->
 				sexpr "%s = &cl$%d" (reg r) fid
+			| OSetMethod (o,f,fid) ->
+				let name, t = resolve_field (match rtype o with HObj o -> o | _ -> assert false) f in
+				sexpr "%s->%s = (%s)&cl$%d" (reg o) (ident name) (ctype t) fid
 			| OInstanceClosure (r,fid,ptr) ->
 				let args, t = tfuns.(fid) in
 				sexpr "%s = hl_alloc_closure_ptr(%s,%s,%s)" (reg r) (type_value (HFun (args,t))) funnames.(fid) (reg ptr)

src/generators/hlcode.ml

@@ -132,6 +132,7 @@ type opcode =
 	| OSetThis of field index * reg
 	| ODynGet of reg * reg * string index
 	| ODynSet of reg * string index * reg
+	| OSetMethod of reg * field index * functable index (* init static method *)
 	(* jumps *)
 	| OJTrue of reg * int
 	| OJFalse of reg * int
@@ -496,6 +497,7 @@ let ostr fstr o =
 	| OCallThis (r,f,rl) -> Printf.sprintf "callthis %d, [%d](%s)" r f (String.concat "," (List.map string_of_int rl))
 	| OStaticClosure (r,f) -> Printf.sprintf "staticclosure %d, %s" r (fstr f)
 	| OInstanceClosure (r,f,v) -> Printf.sprintf "instanceclosure %d, %s(%d)" r (fstr f) v
+	| OSetMethod (o,f,fid) -> Printf.sprintf "setmethod %d[%d], %d" o f fid
 	| OGetGlobal (r,g) -> Printf.sprintf "global %d, %d" r g
 	| OSetGlobal (g,r) -> Printf.sprintf "setglobal %d, %d" g r
 	| ORet r -> Printf.sprintf "ret %d" r

src/generators/hlinterp.ml

@@ -823,6 +823,11 @@ let interp code =
 					check_obj rv o fid;
 					v.ofields.(fid) <- rv
 				| _ -> assert false)
+			| OSetMethod (o,fid,mid) ->
+				let o = get o in
+				(match o with
+				| VObj v -> v.ofields.(fid) <- VClosure (functions.(mid),None)
+				| _ -> assert false)
 			| OCallMethod (r,m,rl) ->
 				(match get (List.hd rl) with
 				| VObj v -> set r (fcall v.oproto.pmethods.(m) (List.map get rl))
@@ -1083,6 +1088,11 @@ let interp code =
 		| VVirtual v -> v.vvalue
 		| _ -> v
 	in
+	let make_stack (f,pos) =
+		let pos = !pos - 1 in
+		let file, line = (try let fid, line = f.debug.(pos) in code.debugfiles.(fid), line with _ -> "???", 0) in
+		Printf.sprintf "%s:%d: Called from fun(%d)@x%x" file line f.findex pos
+	in
 	let load_native lib name t =
 		let unresolved() = (fun args -> error ("Unresolved native " ^ lib ^ "@" ^ name)) in
 		let f = (match lib with
@@ -1685,6 +1695,10 @@ let interp code =
 					String.fill a (int pos) (int len) (char_of_int ((int v) land 0xFF));
 					VUndef
 				| _ -> assert false)
+			| "exception_stack" ->
+				(function
+				| [] -> VArray (Array.map (fun e -> VBytes (caml_to_hl (make_stack e))) (Array.of_list (List.rev !exc_stack)),HBytes)
+				| _ -> assert false)
 			| "date_new" ->
 				(function
 				| [VInt y; VInt mo; VInt d; VInt h; VInt m; VInt s] ->
@@ -1840,11 +1854,7 @@ let interp code =
 	Array.iter (fun (lib,name,t,idx) -> functions.(idx) <- load_native code.strings.(lib) code.strings.(name) t) code.natives;
 	Array.iter (fun fd -> functions.(fd.findex) <- FFun fd) code.functions;
 	let get_stack st =
-		String.concat "\n" (List.map (fun (f,pos) ->
-			let pos = !pos - 1 in
-			let file, line = (try let fid, line = f.debug.(pos) in code.debugfiles.(fid), line with _ -> "???", 0) in
-			Printf.sprintf "%s:%d: Called from fun(%d)@x%x" file line f.findex pos
-		) st)
+		String.concat "\n" (List.map make_stack st)
 	in
 	match functions.(code.entrypoint) with
 	| FFun f when f.ftype = HFun([],HVoid) ->
@@ -2054,6 +2064,8 @@ let check code =
 				reg r (tfield 0 fid false)
 			| OStaticClosure (r,f) ->
 				reg r ftypes.(f)
+			| OSetMethod (o,f,fid) ->
+				check ftypes.(fid) (tfield o f false)			
 			| OVirtualClosure (r,o,fid) ->
 				(match rtype o with
 				| HObj _ ->
@@ -2507,6 +2519,7 @@ let make_spec (code:code) (f:fundecl) =
 			| OCallThis (d,fid,rl) -> args.(d) <- make_call (SMethod fid) (List.map (fun r -> args.(r)) (0 :: rl))
 			| OCallClosure (d,r,rl) -> args.(d) <- make_call (SClosure args.(r)) (List.map (fun r -> args.(r)) rl)
 			| OStaticClosure (d,fid) -> args.(d) <- SFun (fid,None)
+			| OSetMethod (o,f,fid) -> semit (SFieldSet (args.(o),f,SFun(fid,None)))
 			| OInstanceClosure (d,fid,r) -> args.(d) <- SFun (fid,Some args.(r))
 			| OVirtualClosure (d,r,index) -> args.(d) <- SMeth (args.(r),index)
 			| OGetGlobal (d,g) -> args.(d) <- SGlobal g

src/generators/hlopt.ml

@@ -91,6 +91,8 @@ let opcode_fx frw op =
 		write d
 	| OSetGlobal (_,a) ->
 		read a;
+	| OSetMethod (o,_,_) ->
+		read o;
 	| OField (d,a,_) | ODynGet (d,a,_) ->
 		read a; write d
 	| OSetField (a,_,b) | ODynSet (a,_,b)->