Bladeren bron

[hl] added hl.Api.unsafeCast, allow CArray unsafe set

Nicolas Cannasse 1 jaar geleden
bovenliggende
commit
cc45917432
5 gewijzigde bestanden met toevoegingen van 34 en 9 verwijderingen
  1. 13 1
      src/generators/genhl.ml
  2. 14 2
      src/generators/hl2c.ml
  3. 2 6
      src/generators/hlinterp.ml
  4. 3 0
      std/hl/Api.hx
  5. 2 0
      std/hl/CArray.hx

+ 13 - 1
src/generators/genhl.ml

@@ -2082,6 +2082,10 @@ and eval_expr ctx e =
 			| AInstanceField (f, index) -> op ctx (OPrefetch (eval_expr ctx f, index + 1, mode))
 			| _ -> op ctx (OPrefetch (eval_expr ctx value, 0, mode)));
 			alloc_tmp ctx HVoid
+        | "$unsafecast", [value] ->
+			let r = alloc_tmp ctx (to_type ctx e.etype) in
+            op ctx (OUnsafeCast (r, eval_expr ctx value));
+			r
 		| _ ->
 			abort ("Unknown native call " ^ s) e.epos)
 	| TEnumIndex v ->
@@ -2469,6 +2473,14 @@ and eval_expr ctx e =
 				free ctx ra;
 				free ctx ridx;
 				v
+            | ACArray (ra, _, ridx) ->
+				hold ctx ra;
+				hold ctx ridx;
+                let v = value() in
+                op ctx (OSetArray (ra,ridx,v));
+                free ctx ridx;
+                free ctx ra;
+                v
 			| ADynamic (ethis,f) ->
 				let obj = eval_null_check ctx ethis in
 				hold ctx obj;
@@ -2480,7 +2492,7 @@ and eval_expr ctx e =
 				let r = value() in
 				op ctx (OSetEnumField (ctx.m.mcaptreg,index,r));
 				r
-			| AEnum _ | ANone | AInstanceFun _ | AInstanceProto _ | AStaticFun _ | AVirtualMethod _ | ACArray _ ->
+			| AEnum _ | ANone | AInstanceFun _ | AInstanceProto _ | AStaticFun _ | AVirtualMethod _ ->
 				die "" __LOC__)
 		| OpBoolOr ->
 			let r = alloc_tmp ctx HBool in

+ 14 - 2
src/generators/hl2c.ml

@@ -990,7 +990,15 @@ let generate_function ctx f =
 		| OGetMem (r,b,idx) ->
 			sexpr "%s = *(%s*)(%s + %s)" (reg r) (ctype (rtype r)) (reg b) (reg idx)
 		| OGetArray (r, arr, idx) ->
-			sexpr "%s = ((%s*)(%s + 1))[%s]" (reg r) (ctype (rtype r)) (reg arr) (reg idx)
+            (match rtype arr with
+            | HAbstract _ ->
+                (match rtype r with
+                | HStruct _ | HObj _ ->
+			        sexpr "%s = ((%s)%s) + %s" (reg r) (ctype (rtype r)) (reg arr) (reg idx)
+                | _ ->
+			        sexpr "%s = ((%s*)%s)[%s]" (reg r) (ctype (rtype r)) (reg arr) (reg idx))
+            | _ ->
+			    sexpr "%s = ((%s*)(%s + 1))[%s]" (reg r) (ctype (rtype r)) (reg arr) (reg idx))
 		| OSetUI8 (b,idx,r) ->
 			sexpr "*(unsigned char*)(%s + %s) = (unsigned char)%s" (reg b) (reg idx) (reg r)
 		| OSetUI16 (b,idx,r) ->
@@ -998,7 +1006,11 @@ let generate_function ctx f =
 		| OSetMem (b,idx,r) ->
 			sexpr "*(%s*)(%s + %s) = %s" (ctype (rtype r)) (reg b) (reg idx) (reg r)
 		| OSetArray (arr,idx,v) ->
-			sexpr "((%s*)(%s + 1))[%s] = %s" (ctype (rtype v)) (reg arr) (reg idx) (reg v)
+            (match rtype arr with
+            | HAbstract _ ->
+			    sexpr "((%s*)%s)[%s] = %s" (ctype (rtype v)) (reg arr) (reg idx) (reg v)
+            | _ ->
+			    sexpr "((%s*)(%s + 1))[%s] = %s" (ctype (rtype v)) (reg arr) (reg idx) (reg v))
 		| OSafeCast (r,v) ->
 			let tsrc = rtype v in
 			let t = rtype r in

+ 2 - 6
src/generators/hlinterp.ml

@@ -2456,17 +2456,13 @@ let check code macros =
 				reg p HI32;
 				(match rtype v with HI32 | HI64 | HF32 | HF64 -> () | _ -> error (reg_inf r ^ " should be numeric"));
 			| OSetArray (a,i,v) ->
-				reg a HArray;
+				(match rtype a with HAbstract ("hl_carray",_) -> () | _ -> reg a HArray);
 				reg i HI32;
 				ignore(rtype v);
-			| OUnsafeCast (a,b) ->
-				is_dyn a;
-				is_dyn b;
-			| OSafeCast (a,b) ->
+            | OUnsafeCast (a,b) | OSafeCast (a,b) ->
 				ignore(rtype a);
 				ignore(rtype b);
 			| OArraySize (r,a) ->
-				(match rtype a with HAbstract ("hl_carray",_) -> () | _ -> reg a HArray);
 				reg r HI32
 			| OType (r,_) ->
 				reg r HType

+ 3 - 0
std/hl/Api.hx

@@ -26,6 +26,9 @@ extern class Api {
 	static inline function rethrow(v:Dynamic):Void {
 		untyped $rethrow(v);
 	}
+	static inline function unsafeCast<From,To>(v:From):To {
+		return untyped $unsafecast(v);
+	}
 	@:hlNative("std", "obj_get_field") static function getField(obj:Dynamic, hash:Int):Dynamic;
 	@:hlNative("std", "obj_set_field") static function setField(obj:Dynamic, hash:Int, value:Dynamic):Void;
 	@:hlNative("std", "obj_has_field") static function hasField(obj:Dynamic, hash:Int):Bool;

+ 2 - 0
std/hl/CArray.hx

@@ -9,6 +9,8 @@ abstract CArray<T>(Abstract<"hl_carray">) {
 
 	@:arrayAccess inline function get( index : Int ) : T return untyped this[index];
 
+	public inline function unsafeSet( index : Int, v : T ) return untyped this[index] = v;
+
 	public static inline function alloc<T>( cl : Class<T>, size : Int ) : CArray<T> {
 		return cast alloc_carray( (cast cl:BaseType).__type__ , size );
 	}