瀏覽代碼

use unsafe casts for generic method returns, check all casts and assert in -debug

Nicolas Cannasse 8 年之前
父節點
當前提交
00c1d7add5
共有 5 個文件被更改,包括 43 次插入4 次删除
  1. 32 2
      src/generators/genhl.ml
  2. 2 0
      src/generators/hl2c.ml
  3. 2 0
      src/generators/hlcode.ml
  4. 5 0
      src/generators/hlinterp.ml
  5. 2 2
      src/generators/hlopt.ml

+ 32 - 2
src/generators/genhl.ml

@@ -1146,6 +1146,15 @@ and unsafe_cast_to ctx (r:reg) (t:ttype) p =
 		if is_dynamic (rtype ctx r) && is_dynamic t then
 			let r2 = alloc_tmp ctx t in
 			op ctx (OUnsafeCast (r2,r));
+			if ctx.com.debug then begin
+				hold ctx r2;
+				ctx.com.warning ("Unsafe cast " ^ tstr rt ^ " to " ^ tstr t) p;
+				let r3 = cast_to ~force:true ctx r t p in
+				let j = jump ctx (fun n -> OJEq (r2,r3,n)) in
+				op ctx (OAssert 0);
+				j();
+				free ctx r2;
+			end;
 			r2
 		else
 			cast_to ~force:true ctx r t p
@@ -1937,7 +1946,28 @@ and eval_expr ctx e =
 			op ctx (OCallClosure (ret, r, el)); (* if it's a value, it's a closure *)
 			def_ret := Some (cast_to ~force:true ctx ret (to_type ctx e.etype) e.epos);
 		);
-		(match !def_ret with None -> cast_to ~force:true ctx ret (to_type ctx e.etype) e.epos | Some r -> r)
+		(match !def_ret with
+		| None ->
+			let rt = to_type ctx e.etype in
+			let is_valid_method t =
+				match follow t with
+				| TFun (_,rt) ->
+					(match follow rt with
+					| TInst({ cl_kind = KTypeParameter tl },_) ->
+						(* don't allow if we have a constraint virtual, see hxbit.Serializer.getRef *)
+						not (List.exists (fun t -> match to_type ctx t with HVirtual _ -> true | _ -> false) tl)
+					| _ -> false)
+				| _ ->
+					false
+			in
+			(match ec.eexpr with
+			| TField (_, FInstance(_,_,{ cf_kind = Method (MethNormal|MethInline); cf_type = t })) when is_valid_method t ->
+				(* let's trust the compiler when it comes to casting the return value from a type parameter *)
+				unsafe_cast_to ctx ret rt e.epos
+			| _ ->
+				cast_to ~force:true ctx ret rt e.epos)
+		| Some r ->
+			r)
 	| TField (ec,FInstance({ cl_path = [],"Array" },[t],{ cf_name = "length" })) when to_type ctx t = HDyn ->
 		let r = alloc_tmp ctx HI32 in
 		op ctx (OCall1 (r,alloc_fun_path ctx (["hl";"types"],"ArrayDyn") "get_length", eval_null_check ctx ec));
@@ -3351,7 +3381,7 @@ let write_code ch code debug =
 		let oid = Obj.tag o in
 
 		match op with
-		| OLabel _ | ONop _ ->
+		| OLabel _ | ONop _ | OAssert _ ->
 			byte oid
 		| OCall2 (r,g,a,b) ->
 			byte oid;

+ 2 - 0
src/generators/hl2c.ml

@@ -943,6 +943,8 @@ let generate_function ctx f =
 		| OEndTrap b ->
 			sexpr "hl_endtrap(trap$%d)" (!trap_depth - 1);
 			if b then decr trap_depth;
+		| OAssert _ ->
+			sexpr "hl_assert()"
 		| ONop _ ->
 			()
 	) f.code;

+ 2 - 0
src/generators/hlcode.ml

@@ -194,6 +194,7 @@ type opcode =
 	| OEnumField of reg * reg * field index * int
 	| OSetEnumField of reg * int * reg
 	(* misc *)
+	| OAssert of unused
 	| ONop of string
 
 type fundecl = {
@@ -560,6 +561,7 @@ let ostr fstr o =
 	| ONullCheck r -> Printf.sprintf "nullcheck %d" r
 	| OTrap (r,i) -> Printf.sprintf "trap %d, %d" r i
 	| OEndTrap b -> Printf.sprintf "endtrap %b" b
+	| OAssert _ -> "assert"
 	| ONop s -> if s = "" then "nop" else "nop " ^ s
 
 let fundecl_name f = if snd f.fpath = "" then "fun$" ^ (string_of_int f.findex) else (fst f.fpath) ^ "." ^ (snd f.fpath)

+ 5 - 0
src/generators/hlinterp.ml

@@ -1137,6 +1137,8 @@ let interp ctx f args =
 			traps := (r,target) :: !traps
 		| OEndTrap _ ->
 			traps := List.tl !traps
+		| OAssert _ ->
+			throw_msg ctx "Assert"
 		| ONop _ ->
 			()
 		);
@@ -2497,6 +2499,8 @@ let check code macros =
 				can_jump idx
 			| OEndTrap _ ->
 				()
+			| OAssert _ ->
+				()
 			| ONop _ ->
 				()
 		) f.code
@@ -2888,6 +2892,7 @@ let make_spec (code:code) (f:fundecl) =
 			| OEnumIndex (d,r) -> args.(d) <- SConv ("index",args.(r))
 			| OEnumField (d,r,fid,cid) -> args.(d) <- SEnumField (args.(r),fid,cid)
 			| OSetEnumField (e,fid,r) -> semit (SSetEnumField (args.(e),fid,args.(r)))
+			| OAssert _  -> ()
 			| ONop _ -> ()
 		done;
 		Hashtbl.add block_args b.bstart args

+ 2 - 2
src/generators/hlopt.ml

@@ -149,7 +149,7 @@ let opcode_fx frw op =
 		write d
 	| OSetEnumField (a,_,b) ->
 		read a; read b
-	| ONop _ ->
+	| ONop _ | OAssert _ ->
 		()
 
 let opcode_eq a b =
@@ -408,7 +408,7 @@ let opcode_map read write op =
 		OMakeEnum (write d, e, rl)
 	| OSetEnumField (a,f,b) ->
 		OSetEnumField (read a, f, read b)
-	| ONop _ ->
+	| ONop _ | OAssert _ ->
 		op
 
 (* build code graph *)