Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

[hl] Rework Null<Int/Float/Bool> comparison for spec/alloc #11612

Merged
merged 13 commits into from
Mar 20, 2024
Merged

[hl] Rework Null<Int/Float/Bool> comparison for spec/alloc #11612

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
13 commits
Select commit Hold shift + click to select a range
2531ca2
[tests] import some ops tests from genjvm
Simn Jun 14, 2019
eb0ffb9
echo lines on flash unit tests
Aurel300 Jun 14, 2019
a6f96c9
Merge branch 'development' into more_ops_tests
Simn Jun 19, 2019
f77e1db
Merge branch 'development' into more_ops_tests
Simn Feb 8, 2024
a2c469a
Merge branch 'Simn/more_ops_tests' (PR 8426) into dev-hlnull
yuxiaomao Mar 15, 2024
4a7a835
Something that pass the spec test
yuxiaomao Mar 15, 2024
b11bb44
Add jnull when compare nullnum with num
yuxiaomao Mar 15, 2024
22d4908
Improve syntax and fun name
yuxiaomao Mar 15, 2024
8ca2ba1
Remove the use of common_type_safe_number
yuxiaomao Mar 18, 2024
6951429
Also skip todyn for Null<Bool>/Bool eq
yuxiaomao Mar 18, 2024
f82a51c
Revert TestOps as Flash fail
yuxiaomao Mar 18, 2024
ab40e6c
Revert "Revert TestOps as Flash fail"
yuxiaomao Mar 20, 2024
c8ba2c3
Do not do testNadakoOps for flash
yuxiaomao Mar 20, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
193 changes: 121 additions & 72 deletions src/generators/genhl.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -951,34 +951,39 @@ let write_mem ctx bytes index t r =
| _ ->
die "" __LOC__

let common_type_number ctx t1 t2 p =
if t1 == t2 then t1 else
match t1, t2 with
| HUI8, (HUI16 | HI32 | HI64 | HF32 | HF64) -> t2
| HUI16, (HI32 | HI64 | HF32 | HF64) -> t2
| (HI32 | HI64), HF32 -> t2 (* possible loss of precision *)
| (HI32 | HI64 | HF32), HF64 -> t2
| (HUI8|HUI16|HI32|HI64|HF32|HF64), (HUI8|HUI16|HI32|HI64|HF32|HF64) -> t1
| _ ->
die "" __LOC__

let common_type ctx e1 e2 for_eq p =
let t1 = to_type ctx e1.etype in
let t2 = to_type ctx e2.etype in
let rec loop t1 t2 =
if t1 == t2 then t1 else
match t1, t2 with
| HUI8, (HUI16 | HI32 | HI64 | HF32 | HF64) -> t2
| HUI16, (HI32 | HI64 | HF32 | HF64) -> t2
| (HI32 | HI64), HF32 -> t2 (* possible loss of precision *)
| (HI32 | HI64 | HF32), HF64 -> t2
| (HUI8|HUI16|HI32|HI64|HF32|HF64), (HUI8|HUI16|HI32|HI64|HF32|HF64) -> t1
| (HUI8|HUI16|HI32|HI64|HF32|HF64), (HNull t2) -> if for_eq then HNull (loop t1 t2) else loop t1 t2
| (HNull t1), (HUI8|HUI16|HI32|HI64|HF32|HF64) -> if for_eq then HNull (loop t1 t2) else loop t1 t2
| (HNull t1), (HNull t2) -> if for_eq then HNull (loop t1 t2) else loop t1 t2
| HDyn, (HUI8|HUI16|HI32|HI64|HF32|HF64) -> HF64
| (HUI8|HUI16|HI32|HI64|HF32|HF64), HDyn -> HF64
| HDyn, _ -> HDyn
| _, HDyn -> HDyn
| _ when for_eq && safe_cast t1 t2 -> t2
| _ when for_eq && safe_cast t2 t1 -> t1
| HBool, HNull HBool when for_eq -> t2
| HNull HBool, HBool when for_eq -> t1
| HObj _, HVirtual _ | HVirtual _, HObj _ | HVirtual _ , HVirtual _ -> HDyn
| HFun _, HFun _ -> HDyn
| _ ->
abort ("Don't know how to compare " ^ tstr t1 ^ " and " ^ tstr t2) p
in
loop t1 t2
if t1 == t2 then t1 else
match t1, t2 with
| (HUI8|HUI16|HI32|HI64|HF32|HF64), (HUI8|HUI16|HI32|HI64|HF32|HF64) -> common_type_number ctx t1 t2 p
| (HUI8|HUI16|HI32|HI64|HF32|HF64 as t1), (HNull t2)
| (HNull t1), (HUI8|HUI16|HI32|HI64|HF32|HF64 as t2)
| (HNull t1), (HNull t2)
-> if for_eq then HNull (common_type_number ctx t1 t2 p) else common_type_number ctx t1 t2 p
| HDyn, (HUI8|HUI16|HI32|HI64|HF32|HF64) -> HF64
| (HUI8|HUI16|HI32|HI64|HF32|HF64), HDyn -> HF64
| HDyn, _ -> HDyn
| _, HDyn -> HDyn
| _ when for_eq && safe_cast t1 t2 -> t2
| _ when for_eq && safe_cast t2 t1 -> t1
| HBool, HNull HBool when for_eq -> t2
| HNull HBool, HBool when for_eq -> t1
| HObj _, HVirtual _ | HVirtual _, HObj _ | HVirtual _ , HVirtual _ -> HDyn
| HFun _, HFun _ -> HDyn
| _ ->
abort ("Can't find common type " ^ tstr t1 ^ " and " ^ tstr t2) p

let captured_index ctx v =
if not (has_var_flag v VCaptured) then None else try Some (PMap.find v.v_id ctx.m.mcaptured.c_map) with Not_found -> None
Expand Down Expand Up @@ -1479,24 +1484,92 @@ and jump_expr ctx e jcond =
jump ctx (fun i -> OJAlways i)
else
(fun i -> ())
| TBinop (OpEq | OpNotEq | OpGt | OpGte | OpLt | OpLte as jop, e1, e2) ->
let t = common_type ctx e1 e2 (match jop with OpEq | OpNotEq -> true | _ -> false) e.epos in
let r1 = eval_to ctx e1 t in
hold ctx r1;
let r2 = eval_to ctx e2 t in
free ctx r1;
let unsigned = unsigned_op e1 e2 in
jump ctx (fun i ->
let lt a b = if unsigned then OJULt (a,b,i) else if not jcond && is_float t then OJNotGte (a,b,i) else OJSLt (a,b,i) in
let gte a b = if unsigned then OJUGte (a,b,i) else if not jcond && is_float t then OJNotLt (a,b,i) else OJSGte (a,b,i) in
| TBinop (OpEq | OpNotEq as jop, e1, e2) ->
let jumpeq r1 r2 = jump ctx (fun i ->
match jop with
| OpEq -> if jcond then OJEq (r1,r2,i) else OJNotEq (r1,r2,i)
| OpNotEq -> if jcond then OJNotEq (r1,r2,i) else OJEq (r1,r2,i)
| OpGt -> if jcond then lt r2 r1 else gte r2 r1
| OpGte -> if jcond then gte r1 r2 else lt r1 r2
| OpLt -> if jcond then lt r1 r2 else gte r1 r2
| OpLte -> if jcond then gte r2 r1 else lt r2 r1
| _ -> die "" __LOC__
) in
let t1 = to_type ctx e1.etype in
let t2 = to_type ctx e2.etype in
(match t1, t2 with
| HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
| (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
| HNull (HBool as ti1), (HBool as ti2)
| (HBool as ti1), HNull (HBool as ti2)
->
let t1,t2,e1,e2 = if is_nullt t2 then t2,t1,e2,e1 else t1,t2,e1,e2 in
let r1 = eval_expr ctx e1 in
hold ctx r1;
let jnull = if is_nullt t1 then jump ctx (fun i -> OJNull (r1, i)) else (fun i -> ()) in
let t = common_type_number ctx ti1 ti2 e.epos in (* HBool has t==ti1==ti2 *)
let a = cast_to ctx r1 t e1.epos in
hold ctx a;
let b = eval_to ctx e2 t in
free ctx a;
free ctx r1;
let j = jumpeq a b in
if jcond then (jnull(););
(fun() -> if not jcond then (jnull();); j());
| _ ->
let t = common_type ctx e1 e2 true e.epos in
let a = eval_to ctx e1 t in
hold ctx a;
let b = eval_to ctx e2 t in
free ctx a;
let j = jumpeq a b in
(fun() -> j());
)
| TBinop (OpGt | OpGte | OpLt | OpLte as jop, e1, e2) ->
let t1 = to_type ctx e1.etype in
let t2 = to_type ctx e2.etype in
let unsigned = unsigned_op e1 e2 in
let jumpcmp t r1 r2 = jump ctx (fun i ->
let lt a b = if unsigned then OJULt (a,b,i) else if not jcond && is_float t then OJNotGte (a,b,i) else OJSLt (a,b,i) in
let gte a b = if unsigned then OJUGte (a,b,i) else if not jcond && is_float t then OJNotLt (a,b,i) else OJSGte (a,b,i) in
match jop with
| OpGt -> if jcond then lt r2 r1 else gte r2 r1
| OpGte -> if jcond then gte r1 r2 else lt r1 r2
| OpLt -> if jcond then lt r1 r2 else gte r1 r2
| OpLte -> if jcond then gte r2 r1 else lt r2 r1
| _ -> die "" __LOC__
) in
(match t1, t2 with
| (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
| HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
| (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
| HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti1), HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 as ti2)
->
let r1 = eval_expr ctx e1 in
hold ctx r1;
let jnull1 = if is_nullt t1 then jump ctx (fun i -> OJNull (r1, i)) else (fun i -> ()) in
let r2 = eval_expr ctx e2 in
hold ctx r2;
let jnull2 = if is_nullt t2 then jump ctx (fun i -> OJNull (r2, i)) else (fun i -> ()) in
let t = common_type_number ctx ti1 ti2 e.epos in
let a = cast_to ctx r1 t e1.epos in
hold ctx a;
let b = cast_to ctx r2 t e2.epos in
free ctx a;
free ctx r1;
free ctx r2;
let j = jumpcmp t a b in
if jcond then (jnull1(); jnull2(););
(fun() -> if not jcond then (jnull1(); jnull2();); j());
| HObj { pname = "String" }, HObj { pname = "String" }
| HDyn, _
| _, HDyn
->
let t = common_type ctx e1 e2 false e.epos in
let a = eval_to ctx e1 t in
hold ctx a;
let b = eval_to ctx e2 t in
free ctx a;
let j = jumpcmp t a b in
(fun() -> j());
| _ ->
abort ("Don't know how to compare " ^ tstr t1 ^ " and " ^ tstr t2) e.epos
)
| TBinop (OpBoolAnd, e1, e2) ->
let j = jump_expr ctx e1 false in
Expand Down Expand Up @@ -2341,23 +2414,9 @@ and eval_expr ctx e =
jexit());
out
| TBinop (bop, e1, e2) ->
let is_unsigned() = unsigned_op e1 e2 in
let boolop r f =
let j = jump ctx f in
op ctx (OBool (r,false));
op ctx (OJAlways 1);
j();
op ctx (OBool (r, true));
in
let binop r a b =
let arithbinop r a b =
let rec loop bop =
match bop with
| OpLte -> boolop r (fun d -> if is_unsigned() then OJUGte (b,a,d) else OJSLte (a,b,d))
| OpGt -> boolop r (fun d -> if is_unsigned() then OJULt (b,a,d) else OJSGt (a,b,d))
| OpGte -> boolop r (fun d -> if is_unsigned() then OJUGte (a,b,d) else OJSGte (a,b,d))
| OpLt -> boolop r (fun d -> if is_unsigned() then OJULt (a,b,d) else OJSLt (a,b,d))
| OpEq -> boolop r (fun d -> OJEq (a,b,d))
| OpNotEq -> boolop r (fun d -> OJNotEq (a,b,d))
| OpAdd ->
(match rtype ctx r with
| HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 ->
Expand Down Expand Up @@ -2404,23 +2463,13 @@ and eval_expr ctx e =
loop bop
in
(match bop with
| OpLte | OpGt | OpGte | OpLt ->
| OpLte | OpGt | OpGte | OpLt | OpEq | OpNotEq ->
let r = alloc_tmp ctx HBool in
let t = common_type ctx e1 e2 false e.epos in
let a = eval_to ctx e1 t in
hold ctx a;
let b = eval_to ctx e2 t in
free ctx a;
binop r a b;
r
| OpEq | OpNotEq ->
let r = alloc_tmp ctx HBool in
let t = common_type ctx e1 e2 true e.epos in
let a = eval_to ctx e1 t in
hold ctx a;
let b = eval_to ctx e2 t in
free ctx a;
binop r a b;
let j = jump_expr ctx e false in
op ctx (OBool (r, true));
op ctx (OJAlways 1);
j();
op ctx (OBool (r, false));
r
| OpAdd | OpSub | OpMult | OpDiv | OpMod | OpShl | OpShr | OpUShr | OpAnd | OpOr | OpXor ->
let t = (match to_type ctx e.etype with HNull t -> t | t -> t) in
Expand All @@ -2437,7 +2486,7 @@ and eval_expr ctx e =
hold ctx a;
let b = eval e2 in
free ctx a;
binop r a b;
arithbinop r a b;
r
| OpAssign ->
let value() = eval_to ctx e2 (real_type ctx e1) in
Expand Down Expand Up @@ -2555,7 +2604,7 @@ and eval_expr ctx e =
hold ctx r;
let b = if bop = OpAdd && is_string (rtype ctx r) then to_string ctx (eval_expr ctx e2) e2.epos else eval_to ctx e2 (rtype ctx r) in
free ctx r;
binop r r b;
arithbinop r r b;
r))
| OpInterval | OpArrow | OpIn | OpNullCoal ->
die "" __LOC__)
Expand Down
8 changes: 7 additions & 1 deletion src/generators/hlcode.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -45,7 +45,7 @@ type ttype =
| HDynObj
| HAbstract of string * string index
| HEnum of enum_proto
| HNull of ttype
| HNull of ttype (* for not nullable type only *)
| HMethod of ttype list * ttype
| HStruct of class_proto
| HPacked of ttype
Expand Down Expand Up @@ -277,6 +277,12 @@ let is_number = function
| HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64 -> true
| _ -> false

let is_nullt = function
| HNull (HUI8 | HUI16 | HI32 | HI64 | HF32 | HF64) -> true
| HNull HBool -> true
| HNull _ -> Globals.die "" __LOC__
| _ -> false

(*
does the runtime value carry its type
*)
Expand Down
Loading