Browse Source

added regdata and regoffset for more direct pointer manipulation

Nicolas Cannasse 8 years ago
parent
commit
d2911df23c

+ 17 - 2
src/generators/genhl.ml

@@ -1780,8 +1780,12 @@ and eval_expr ctx e =
 		| "$aset", [a; pos; value] ->
 		| "$aset", [a; pos; value] ->
 			let et = (match follow a.etype with TAbstract ({ a_path = ["hl"],"NativeArray" },[t]) -> to_type ctx t | _ -> invalid()) in
 			let et = (match follow a.etype with TAbstract ({ a_path = ["hl"],"NativeArray" },[t]) -> to_type ctx t | _ -> invalid()) in
 			let arr = eval_to ctx a HArray in
 			let arr = eval_to ctx a HArray in
+			hold ctx arr;
 			let pos = eval_to ctx pos HI32 in
 			let pos = eval_to ctx pos HI32 in
+			hold ctx pos;
 			let r = eval_to ctx value et in
 			let r = eval_to ctx value et in
+			free ctx pos;
+			free ctx arr;
 			op ctx (OSetArray (arr, pos, r));
 			op ctx (OSetArray (arr, pos, r));
 			r
 			r
 		| "$abytes", [a] ->
 		| "$abytes", [a] ->
@@ -1826,6 +1830,17 @@ and eval_expr ctx e =
 			let out = alloc_tmp ctx (match rtype ctx r with HRef t -> t | _ -> invalid()) in
 			let out = alloc_tmp ctx (match rtype ctx r with HRef t -> t | _ -> invalid()) in
 			op ctx (OUnref (out,r));
 			op ctx (OUnref (out,r));
 			out
 			out
+		| "$refdata", [e1] ->
+			let v = eval_expr ctx e1 in
+			let r = alloc_tmp ctx (match to_type ctx e.etype with HRef _ as t -> t | _ -> invalid()) in
+			op ctx (ORefData (r,v));
+			r
+		| "$refoffset", [r;e1] ->
+			let r = eval_expr ctx r in
+			let e = eval_to ctx e1 HI32 in
+			let r2 = alloc_tmp ctx (match rtype ctx r with HRef _ as t -> t | _ -> invalid()) in
+			op ctx (ORefOffset (r2,r,e));
+			r2
 		| "$ttype", [v] ->
 		| "$ttype", [v] ->
 			let r = alloc_tmp ctx HType in
 			let r = alloc_tmp ctx HType in
 			op ctx (OType (r,to_type ctx v.etype));
 			op ctx (OType (r,to_type ctx v.etype));
@@ -3759,7 +3774,7 @@ let generate com =
 		Hlcode.dump (fun s -> output_string ch (s ^ "\n")) code;
 		Hlcode.dump (fun s -> output_string ch (s ^ "\n")) code;
 		close_out ch;
 		close_out ch;
 	end;
 	end;
-	if Common.raw_defined com "hl-dump-spec" then begin
+	(*if Common.raw_defined com "hl-dump-spec" then begin
 		let ch = open_out_bin "dump/hlspec.txt" in
 		let ch = open_out_bin "dump/hlspec.txt" in
 		let write s = output_string ch (s ^ "\n") in
 		let write s = output_string ch (s ^ "\n") in
 		Array.iter (fun f ->
 		Array.iter (fun f ->
@@ -3769,7 +3784,7 @@ let generate com =
 			write "";
 			write "";
 		) code.functions;
 		) code.functions;
 		close_out ch;
 		close_out ch;
-	end;
+	end;*)
 	if Common.raw_defined com "hl-check" then begin
 	if Common.raw_defined com "hl-check" then begin
 		check ctx;
 		check ctx;
 		Hlinterp.check code false;
 		Hlinterp.check code false;

+ 8 - 0
src/generators/hl2c.ml

@@ -945,6 +945,14 @@ let generate_function ctx f =
 			if b then decr trap_depth;
 			if b then decr trap_depth;
 		| OAssert _ ->
 		| OAssert _ ->
 			sexpr "hl_assert()"
 			sexpr "hl_assert()"
+		| ORefData (r,d) ->
+			(match rtype d with
+			| HArray ->
+				sexpr "%s = (%s)hl_aptr(%s,void*)" (reg r) (ctype (rtype r)) (reg d)
+			| _ ->
+				assert false)
+		| ORefOffset (r,r2,off) ->
+			sexpr "%s = %s + %s" (reg r) (reg r2) (reg off)
 		| ONop _ ->
 		| ONop _ ->
 			()
 			()
 	) f.code;
 	) f.code;

+ 4 - 0
src/generators/hlcode.ml

@@ -195,6 +195,8 @@ type opcode =
 	| OSetEnumField of reg * int * reg
 	| OSetEnumField of reg * int * reg
 	(* misc *)
 	(* misc *)
 	| OAssert of unused
 	| OAssert of unused
+	| ORefData of reg * reg
+	| ORefOffset of reg * reg * reg
 	| ONop of string
 	| ONop of string
 
 
 type fundecl = {
 type fundecl = {
@@ -562,6 +564,8 @@ let ostr fstr o =
 	| OTrap (r,i) -> Printf.sprintf "trap %d, %d" r i
 	| OTrap (r,i) -> Printf.sprintf "trap %d, %d" r i
 	| OEndTrap b -> Printf.sprintf "endtrap %b" b
 	| OEndTrap b -> Printf.sprintf "endtrap %b" b
 	| OAssert _ -> "assert"
 	| OAssert _ -> "assert"
+	| ORefData (r,d) -> Printf.sprintf "refdata %d, %d" r d
+	| ORefOffset (r,r2,off) -> Printf.sprintf "refoffset %d, %d, %d" r r2 off
 	| ONop s -> if s = "" then "nop" else "nop " ^ s
 	| 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)
 let fundecl_name f = if snd f.fpath = "" then "fun$" ^ (string_of_int f.findex) else (fst f.fpath) ^ "." ^ (snd f.fpath)

+ 22 - 0
src/generators/hlinterp.ml

@@ -45,6 +45,7 @@ type value =
 and ref_value =
 and ref_value =
 	| RStack of int
 	| RStack of int
 	| RValue of value ref
 	| RValue of value ref
+	| RArray of value array * int
 
 
 and vabstract =
 and vabstract =
 	| AHashBytes of (string, value) Hashtbl.t
 	| AHashBytes of (string, value) Hashtbl.t
@@ -273,11 +274,13 @@ let make_dyn v t =
 let get_ref ctx = function
 let get_ref ctx = function
 	| RStack i -> ctx.stack.(i)
 	| RStack i -> ctx.stack.(i)
 	| RValue r -> !r
 	| RValue r -> !r
+	| RArray (a,i) -> a.(i)
 
 
 let set_ref ctx r v =
 let set_ref ctx r v =
 	match r with
 	match r with
 	| RStack i -> ctx.stack.(i) <- v
 	| RStack i -> ctx.stack.(i) <- v
 	| RValue r -> r := v
 	| RValue r -> r := v
+	| RArray (a,i) -> a.(i) <- v
 
 
 let fstr = function
 let fstr = function
 	| FFun f -> "function@" ^ string_of_int f.findex
 	| FFun f -> "function@" ^ string_of_int f.findex
@@ -1038,6 +1041,8 @@ let interp ctx f args =
 			| VArray (a,t), VInt i ->
 			| VArray (a,t), VInt i ->
 				let v = get v in
 				let v = get v in
 				check v t (fun() -> "array");
 				check v t (fun() -> "array");
+				let idx = Int32.to_int i in
+				if ctx.checked && (idx < 0 || idx >= Array.length a) then error (Printf.sprintf "Can't set array index %d with %s" idx (vstr_d ctx v));
 				a.(Int32.to_int i) <- v
 				a.(Int32.to_int i) <- v
 			| _ -> assert false);
 			| _ -> assert false);
 		| OSafeCast (r, v) ->
 		| OSafeCast (r, v) ->
@@ -1139,6 +1144,14 @@ let interp ctx f args =
 			traps := List.tl !traps
 			traps := List.tl !traps
 		| OAssert _ ->
 		| OAssert _ ->
 			throw_msg ctx "Assert"
 			throw_msg ctx "Assert"
+		| ORefData (r,d) ->
+			(match get d with
+			| VArray (a,t) -> set r (VRef (RArray (a,0),t))
+			| _ -> assert false)
+		| ORefOffset (r,r2,off) ->
+			(match get r2, get off with
+			| VRef (RArray (a,pos),t), VInt i -> set r (VRef (RArray (a,pos + Int32.to_int i),t))
+			| _ -> assert false)
 		| ONop _ ->
 		| ONop _ ->
 			()
 			()
 		);
 		);
@@ -2501,6 +2514,13 @@ let check code macros =
 				()
 				()
 			| OAssert _ ->
 			| OAssert _ ->
 				()
 				()
+			| ORefData (r,d) ->
+				reg d HArray;
+				(match rtype r with HRef _ -> () | _ -> reg r (HRef HDyn))
+			| ORefOffset (r,r2,off) ->
+				(match rtype r2 with HRef _ -> () | _ -> reg r2 (HRef HDyn));
+				reg r (rtype r2);
+				reg off HI32;
 			| ONop _ ->
 			| ONop _ ->
 				()
 				()
 		) f.code
 		) f.code
@@ -2521,6 +2541,7 @@ let check code macros =
 	Array.iter check_fun code.functions
 	Array.iter check_fun code.functions
 
 
 (* ------------------------------- SPEC ---------------------------------------------- *)
 (* ------------------------------- SPEC ---------------------------------------------- *)
+(*
 
 
 open Hlopt
 open Hlopt
 
 
@@ -2907,3 +2928,4 @@ let make_spec (code:code) (f:fundecl) =
 	in
 	in
 	loop 0;
 	loop 0;
 	List.rev !out_spec
 	List.rev !out_spec
+*)

+ 20 - 2
src/generators/hlopt.ml

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

+ 4 - 0
std/hl/NativeArray.hx

@@ -68,6 +68,10 @@ package hl;
 		return n;
 		return n;
 	}
 	}
 
 
+	@:extern public inline function getRef() : Ref<T> {
+		return untyped $refdata(this);
+	}
+
 	@:hlNative("std","array_type") public function getType() : Type {
 	@:hlNative("std","array_type") public function getType() : Type {
 		return null;
 		return null;
 	}
 	}

+ 3 - 0
std/hl/Ref.hx

@@ -36,4 +36,7 @@ package hl;
 	@:extern public inline function set( v : T ) : Void {
 	@:extern public inline function set( v : T ) : Void {
 		return untyped $setref(this,v);
 		return untyped $setref(this,v);
 	}
 	}
+	@:extern public inline function offset( v : Int ) : Ref<T> {
+		return untyped $refoffset(this, v);
+	}
 }
 }