Support Int64 natively on eval

src/macro/eval/evalContext.ml

@@ -534,6 +534,7 @@ let is v path =
 		v <> vnull
 	else match v with
 	| VInt32 _ -> path = key_Int || path = key_Float
+	| VInt64 _ -> path = key_eval_integers_Int64
 	| VFloat f -> path = key_Float || (path = key_Int && f = (float_of_int (int_of_float f)) && f <= 2147483647. && f >= -2147483648.)
 	| VTrue | VFalse -> path = key_Bool
 	| VPrototype {pkind = PClass _} -> path = key_Class

src/macro/eval/evalEmitter.ml

@@ -531,7 +531,8 @@ let emit_vector_write exec1 p1 exec2 p2 exec3 p env =
 (* Read + write *)
 
 let do_incr v p = match v with
-	| VInt32 i32 -> vint32 (Int32.add i32 Int32.one)
+	| VInt32 i32 -> vint32 (Int32.succ i32)
+	| VInt64 i64 -> vint64 (Int64.succ i64)
 	| VFloat f -> vfloat (f +. 1.)
 	| v -> unexpected_value_p v "number" p
 
@@ -731,6 +732,7 @@ let emit_bool_or exec1 exec2 env =
 let emit_neg exec p env = match exec env with
 	| VFloat f -> vfloat (-.f)
 	| VInt32 i -> vint32 (Int32.neg i)
+	| VInt64 i -> vint64 (Int64.neg i)
 	| _ -> throw_string "Invalid operation" p
 
 (* Function *)

src/macro/eval/evalHash.ml

@@ -213,6 +213,8 @@ let key_address = hash "address"
 let key_netmask = hash "netmask"
 let key_previous = hash "previous"
 let key_current = hash "current"
-let key_haxe_atomic_AtomicBool = hash "haxe.atomic.AtomicBool" 
-let key_haxe_atomic_AtomicInt = hash "haxe.atomic.AtomicInt" 
-let key_haxe_atomic_AtomicObject = hash "haxe.atomic.AtomicObject" 
+let key_haxe_atomic_AtomicBool = hash "haxe.atomic.AtomicBool"
+let key_haxe_atomic_AtomicInt = hash "haxe.atomic.AtomicInt"
+let key_haxe_atomic_AtomicObject = hash "haxe.atomic.AtomicObject"
+
+let key_eval_integers_Int64 = hash "eval.integers._Int64.Int64_Impl_" (* TODO: wonky... *)

src/macro/eval/evalIntegers.ml

@@ -12,36 +12,6 @@ open EvalMisc
 open Unsigned
 open Signed
 
-let encode_haxe_i64 low high =
-	let vi = create_instance key_haxe__Int64____Int64 in
-	set_instance_field vi key_high (vint32 high);
-	set_instance_field vi key_low (vint32 low);
-	vinstance vi
-
-let encode_haxe_i64_int64 value =
-	let high = Stdlib.Int64.to_int32 (Stdlib.Int64.shift_right_logical value 32) in
-	let low = Stdlib.Int64.to_int32 value in
-	let vi = create_instance key_haxe__Int64____Int64 in
-	set_instance_field vi key_high (vint32 high);
-	set_instance_field vi key_low (vint32 low);
-	vinstance vi
-
-let encode_haxe_i64_direct i64 =
-	let low = GInt64.to_int32 i64 in
-	let high = GInt64.to_int32 (GInt64.shift_right_logical i64 32) in
-	encode_haxe_i64 low high
-
-let decode_haxe_i64 v =
-	match v with
-	| VInstance vi when is v key_haxe__Int64____Int64 ->
-		let high = decode_i32 (vi.ifields.(get_instance_field_index_raise vi.iproto key_high))
-		and low = decode_i32 (vi.ifields.(get_instance_field_index_raise vi.iproto key_low)) in
-		let high64 = GInt64.shift_left (Int32.to_int64 high) 32
-		and low64 = GInt64.logand (Int32.to_int64 low) 0xffffffffL in
-		GInt64.logor high64 low64
-	| _ ->
-		unexpected_value v "haxe.Int64"
-
 let decode_u64 = function
 	| VUInt64 u -> u
 	| v -> unexpected_value v "eval.integers.UInt64"
@@ -163,6 +133,13 @@ let uint64_fields = [
 	);
 ]
 
+let make_int64 high low =
+	let high = GInt64.of_int32 high in
+	let high = Int64.shift_left high 32 in
+	let low = GInt64.of_int32 low in
+	let low = Int64.logand low (Int64.of_string "0xFFFFFFFF") in
+	Int64.logor high low
+
 let int64_fields = [
 	"MAX", VInt64 Int64.max_int;
 	"MIN", VInt64 Int64.min_int;
@@ -177,9 +154,6 @@ let int64_fields = [
 		try VInt64 (Int64.of_string s)
 		with Failure _ -> throw_string "The string is not a valid Int64 representation" null_pos
 	);
-	"ofHxInt64", vfun1 (fun v ->
-		VInt64 (decode_haxe_i64 v)
-	);
 	"max", vfun2 (fun v1 v2 ->
 		let a = decode_i64 v1
 		and b = decode_i64 v2 in
@@ -195,18 +169,23 @@ let int64_fields = [
 		and b = decode_i64 v2 in
 		vint (Int64.compare a b)
 	);
+	"make", vfun2 (fun vhigh vlow ->
+		let high = decode_i32 vhigh in
+		let low = decode_i32 vlow in
+		let i = make_int64 high low in
+		VInt64 i
+	);
 	"toInt", vfun1 (fun v ->
 		let i = decode_i64 v in
 		vint32 (GInt64.to_int32 i)
 	);
+	"toInt32", vfun1 (fun v ->
+		vint32 (Int32.of_int64 (decode_i64 v))
+	);
 	"toUInt64", vfun1 (fun v ->
 		let i = decode_i64 v in
 		VUInt64 (UInt64.of_int64 i)
 	);
-	"toHxInt64", vfun1 (fun v ->
-		let i = decode_i64 v in
-		encode_haxe_i64_direct i
-	);
 	"toString", vfun1 (fun v ->
 		let i = decode_i64 v in
 		EvalString.vstring (EvalString.create_ascii (Int64.to_string i))
@@ -271,6 +250,11 @@ let int64_fields = [
 		and i = decode_int v2 in
 		VInt64 (Int64.shift_right i64 i)
 	);
+	"shift_right_logical", vfun2 (fun v1 v2 ->
+		let i64 = decode_i64 v1
+		and i = decode_int v2 in
+		VInt64 (Int64.shift_right_logical i64 i)
+	);
 	"lognot", vfun1 (fun v ->
 		let i = decode_i64 v in
 		VInt64 (Int64.lognot i)

src/macro/eval/evalMisc.ml

@@ -123,10 +123,13 @@ let fcmp (a:float) b = if a = b then CEq else if a < b then CInf else if a > b t
 
 let icmp (a:int32) b = let l = Int32.compare a b in if l = 0 then CEq else if l < 0 then CInf else CSup
 
+let i64cmp (a:int64) b = let l = Int64.compare a b in if l = 0 then CEq else if l < 0 then CInf else CSup
+
 let rec compare a b =
 	match a, b with
 	| VNull,VNull -> CEq
 	| VInt32 a,VInt32 b -> icmp a b
+	| VInt64 a,VInt64 b -> i64cmp a b
 	| VFloat a,VFloat b -> fcmp a b
 	| VFloat a,VInt32 b -> fcmp a (Int32.to_float b)
 	| VInt32 a,VFloat b -> fcmp (Int32.to_float a) b
@@ -175,6 +178,7 @@ let rec arrays_equal cmp a1 a2 =
 and equals_structurally a b =
 	match a,b with
 	| VInt32 a,VInt32 b -> Int32.compare a b = 0
+	| VInt64 a,VInt64 b -> Int64.compare a b = 0
 	| VFloat a,VFloat b -> a = b
 	| VFloat a,VInt32 b -> a = (Int32.to_float b)
 	| VInt32 a,VFloat b -> (Int32.to_float a) = b
@@ -194,6 +198,11 @@ let is_true v = match v with
 
 let op_add p v1 v2 = match v1,v2 with
 	| VInt32 i1,VInt32 i2 -> vint32 (Int32.add i1 i2)
+	| VInt64 i1,VInt64 i2 -> vint64 (Int64.add i1 i2)
+	(* These two cases should technically not exist, but the analyzer emits code like this because
+	   our TConst only knows Int32 at the moment. *)
+	| VInt64 i1,VInt32 i2 -> vint64 (Int64.add i1 (Int64.of_int32 i2))
+	| VInt32 i1,VInt64 i2 -> vint64 (Int64.add (Int64.of_int32 i1) i2)
 	| VFloat f1,VFloat f2 -> vfloat (f1 +. f2)
 	| VInt32 i,VFloat f | VFloat f,VInt32 i -> vfloat ((Int32.to_float i) +. f)
 	| VNativeString s1,VNativeString s2 -> vnative_string (s1 ^ s2)
@@ -204,6 +213,7 @@ let op_add p v1 v2 = match v1,v2 with
 
 let op_mult p v1 v2 = match v1,v2 with
 	| VInt32 i1,VInt32 i2 -> vint32 (Int32.mul i1 i2)
+	| VInt64 i1,VInt64 i2 -> vint64 (Int64.mul i1 i2)
 	| VFloat f1,VFloat f2 -> vfloat (f1 *. f2)
 	| VInt32 i,VFloat f | VFloat f,VInt32 i -> vfloat ((Int32.to_float i) *. f)
 	| _ -> invalid_binop OpMult v1 v2 p
@@ -217,6 +227,10 @@ let op_div p v1 v2 = match v1,v2 with
 
 let op_sub p v1 v2 = match v1,v2 with
 	| VInt32 i1,VInt32 i2 -> vint32 (Int32.sub i1 i2)
+	| VInt64 i1,VInt64 i2 -> vint64 (Int64.sub i1 i2)
+	(* See op_add remark. *)
+	| VInt64 i1,VInt32 i2 -> vint64 (Int64.sub i1 (Int64.of_int32 i2))
+	| VInt32 i1,VInt64 i2 -> vint64 (Int64.sub (Int64.of_int32 i1) i2)
 	| VFloat f1,VFloat f2 -> vfloat (f1 -. f2)
 	| VInt32 i1,VFloat f2 -> vfloat ((Int32.to_float i1) -. f2)
 	| VFloat f1,VInt32 i2 -> vfloat (f1 -. (Int32.to_float i2))

src/macro/eval/evalStdLib.ml

@@ -333,7 +333,7 @@ module StdBytes = struct
 		try
 			let low = read_i32 this pos in
 			let high = read_i32 this (pos + 4) in
-			EvalIntegers.encode_haxe_i64 low high;
+			vint64 (EvalIntegers.make_int64 high low)
 		with _ ->
 			outside_bounds()
 	)
@@ -500,9 +500,9 @@ module StdBytesBuffer = struct
 
 	let addInt64 = vifun1 (fun vthis v ->
 		let this = this vthis in
-		let v = decode_instance v in
-		let high = decode_i32 (instance_field v key_high) in
-		let low = decode_i32 (instance_field v key_low) in
+		let i64 = EvalIntegers.decode_i64 v in
+		let high = Int64.to_int32 (Int64.shift_right i64 32) in
+		let low = Int64.to_int32 i64 in
 		add_i32 this low;
 		add_i32 this high;
 		vnull;
@@ -1164,7 +1164,7 @@ module StdFPHelper = struct
 	let doubleToI64 = vfun1 (fun v ->
 		let f = num v in
 		let i64 = Int64.bits_of_float f in
-		EvalIntegers.encode_haxe_i64_direct i64
+		vint64 i64
 	)
 
 	let floatToI32 = vfun1 (fun f ->
@@ -1581,11 +1581,11 @@ module StdInt64Map = struct
 	)
 
 	let exists = vifun1 (fun vthis vkey ->
-		vbool (RuntimeInt64Hashtbl.mem (this vthis) (EvalIntegers.decode_haxe_i64 vkey))
+		vbool (RuntimeInt64Hashtbl.mem (this vthis) (EvalIntegers.decode_i64 vkey))
 	)
 
 	let get = vifun1 (fun vthis vkey ->
-		try RuntimeInt64Hashtbl.find (this vthis) (EvalIntegers.decode_haxe_i64 vkey)
+		try RuntimeInt64Hashtbl.find (this vthis) (EvalIntegers.decode_i64 vkey)
 		with Not_found -> vnull
 	)
 
@@ -1595,22 +1595,22 @@ module StdInt64Map = struct
 	)
 
 	let keys = vifun0 (fun vthis ->
-		let keys = RuntimeInt64Hashtbl.fold (fun k _ acc -> EvalIntegers.encode_haxe_i64_int64 k :: acc) (this vthis) [] in
+		let keys = RuntimeInt64Hashtbl.fold (fun k _ acc -> vint64 k :: acc) (this vthis) [] in
 		encode_list_iterator keys
 	)
 
 	let keyValueIterator = map_key_value_iterator key_haxe_iterators_map_key_value_iterator
 
 	let remove = vifun1 (fun vthis vkey ->
 		let this = this vthis in
-		let key = EvalIntegers.decode_haxe_i64 vkey in
+		let key = EvalIntegers.decode_i64 vkey in
 		let b = RuntimeInt64Hashtbl.mem this key in
 		RuntimeInt64Hashtbl.remove this key;
 		vbool b
 	)
 
 	let set = vifun2 (fun vthis vkey vvalue ->
-		RuntimeInt64Hashtbl.add (this vthis) (EvalIntegers.decode_haxe_i64 vkey) vvalue;
+		RuntimeInt64Hashtbl.add (this vthis) (EvalIntegers.decode_i64 vkey) vvalue;
 		vnull
 	)
 
@@ -2796,7 +2796,7 @@ module StdSys = struct
 
 	let time = vfun0 (fun () -> vfloat (catch_unix_error Unix.gettimeofday()))
 
-	let timestamp_ms = vfun0 (fun () -> EvalIntegers.encode_haxe_i64_direct (* TODO: use vint64 once that works *) (Extc.timestamp_ms()))
+	let timestamp_ms = vfun0 (fun () -> vint64 (Extc.timestamp_ms()))
 end
 
 module StdThread = struct