Skip to content

Commit a0309ff

Browse files
vouillonvouillon
committed
WIP
1 parent 874e2f0 commit a0309ff

File tree

1 file changed

+68
-23
lines changed

1 file changed

+68
-23
lines changed

‎compiler/lib-wasm/generate.ml

Lines changed: 68 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -891,11 +891,16 @@ module Generate (Target : Target_sig.S) = struct
891891
let ta' = transl_prim_arg ctx ta in
892892
match get_type ctx ta with
893893
| Bigarray { kind; layout = C } ->
894-
let i' = transl_prim_arg ctx ~typ:(Int Normalized) i in
894+
let i' = Var.fresh () in
895+
let dim0 = Var.fresh () in
895896
seq
896-
(let* cond = Arith.uge i' (Bigarray.dim 0 ta') in
897+
(let* () =
898+
store ~typ:I32 i' (transl_prim_arg ctx ~typ:(Int Normalized) i)
899+
in
900+
let* () = store dim0 ~typ:I32 (Bigarray.dim 0 ta') in
901+
let* cond = Arith.uge (load i') (load dim0) in
897902
instr (W.Br_if (label_index context bound_error_pc, cond)))
898-
(Bigarray.get ~kind ta' i')
903+
(Bigarray.get ~kind ta' (load i'))
899904
| _ ->
900905
let* f =
901906
register_import ~name:"caml_ba_get_1" (Fun (Type.primitive_type 2))
@@ -910,15 +915,25 @@ module Generate (Target : Target_sig.S) = struct
910915
let ta' = transl_prim_arg ctx ta in
911916
match get_type ctx ta with
912917
| Bigarray { kind; layout = C } ->
913-
let i' = transl_prim_arg ctx ~typ:(Int Normalized) i in
914-
let j' = transl_prim_arg ctx ~typ:(Int Normalized) j in
918+
let i' = Var.fresh () in
919+
let j' = Var.fresh () in
920+
let dim0 = Var.fresh () in
921+
let dim1 = Var.fresh () in
915922
seq
916-
(let* cond = Arith.uge i' (Bigarray.dim 0 ta') in
923+
(let* () =
924+
store ~typ:I32 i' (transl_prim_arg ctx ~typ:(Int Normalized) i)
925+
in
926+
let* () =
927+
store ~typ:I32 j' (transl_prim_arg ctx ~typ:(Int Normalized) j)
928+
in
929+
let* () = store dim0 ~typ:I32 (Bigarray.dim 0 ta') in
930+
let* () = store dim1 ~typ:I32 (Bigarray.dim 1 ta') in
931+
let* cond = Arith.uge (load i') (load dim0) in
917932
let* () = instr (W.Br_if (label_index context bound_error_pc, cond)) in
918-
let* cond = Arith.uge j' (Bigarray.dim 1 ta') in
933+
let* cond = Arith.uge (load j') (load dim1) in
919934
let* () = instr (W.Br_if (label_index context bound_error_pc, cond)) in
920935
return ())
921-
(Bigarray.get ~kind ta' Arith.((i' * Bigarray.dim 1 ta') + j'))
936+
(Bigarray.get ~kind ta' Arith.((load i' * load dim1) + load j'))
922937
| _ ->
923938
let* f =
924939
register_import ~name:"caml_ba_get_2" (Fun (Type.primitive_type 3))
@@ -934,7 +949,8 @@ module Generate (Target : Target_sig.S) = struct
934949
let ta' = transl_prim_arg ctx ta in
935950
match get_type ctx ta with
936951
| Bigarray { kind; layout = C } ->
937-
let i' = transl_prim_arg ctx ~typ:(Int Normalized) i in
952+
let i' = Var.fresh () in
953+
let dim0 = Var.fresh () in
938954
let v' =
939955
transl_prim_arg
940956
ctx
@@ -947,9 +963,13 @@ module Generate (Target : Target_sig.S) = struct
947963
v
948964
in
949965
seq
950-
(let* cond = Arith.uge i' (Bigarray.dim 0 ta') in
966+
(let* () =
967+
store ~typ:I32 i' (transl_prim_arg ctx ~typ:(Int Normalized) i)
968+
in
969+
let* () = store dim0 ~typ:I32 (Bigarray.dim 0 ta') in
970+
let* cond = Arith.uge (load i') (load dim0) in
951971
let* () = instr (W.Br_if (label_index context bound_error_pc, cond)) in
952-
Bigarray.set ~kind ta' i' v')
972+
Bigarray.set ~kind ta' (load i') v')
953973
Value.unit
954974
| _ ->
955975
let* f =
@@ -966,8 +986,10 @@ module Generate (Target : Target_sig.S) = struct
966986
let ta' = transl_prim_arg ctx ta in
967987
match get_type ctx ta with
968988
| Bigarray { kind; layout = C } ->
969-
let i' = transl_prim_arg ctx ~typ:(Int Normalized) i in
970-
let j' = transl_prim_arg ctx ~typ:(Int Normalized) j in
989+
let i' = Var.fresh () in
990+
let j' = Var.fresh () in
991+
let dim0 = Var.fresh () in
992+
let dim1 = Var.fresh () in
971993
let v' =
972994
transl_prim_arg
973995
ctx
@@ -980,11 +1002,19 @@ module Generate (Target : Target_sig.S) = struct
9801002
v
9811003
in
9821004
seq
983-
(let* cond = Arith.uge i' (Bigarray.dim 0 ta') in
1005+
(let* () =
1006+
store ~typ:I32 i' (transl_prim_arg ctx ~typ:(Int Normalized) i)
1007+
in
1008+
let* () =
1009+
store ~typ:I32 j' (transl_prim_arg ctx ~typ:(Int Normalized) j)
1010+
in
1011+
let* () = store dim0 ~typ:I32 (Bigarray.dim 0 ta') in
1012+
let* () = store dim1 ~typ:I32 (Bigarray.dim 1 ta') in
1013+
let* cond = Arith.uge (load i') (load dim0) in
9841014
let* () = instr (W.Br_if (label_index context bound_error_pc, cond)) in
985-
let* cond = Arith.uge j' (Bigarray.dim 1 ta') in
1015+
let* cond = Arith.uge (load j') (load dim1) in
9861016
let* () = instr (W.Br_if (label_index context bound_error_pc, cond)) in
987-
Bigarray.set ~kind ta' Arith.((i' * Bigarray.dim 1 ta') + j') v')
1017+
Bigarray.set ~kind ta' Arith.((load i' * load dim1) + load j') v')
9881018
Value.unit
9891019
| _ ->
9901020
let* f =
@@ -1002,9 +1032,12 @@ module Generate (Target : Target_sig.S) = struct
10021032
let ta' = transl_prim_arg ctx ta in
10031033
match get_type ctx ta with
10041034
| Bigarray { kind; layout = C } ->
1005-
let i' = transl_prim_arg ctx ~typ:(Int Normalized) i in
1006-
let j' = transl_prim_arg ctx ~typ:(Int Normalized) j in
1007-
let k' = transl_prim_arg ctx ~typ:(Int Normalized) k in
1035+
let i' = Var.fresh () in
1036+
let j' = Var.fresh () in
1037+
let k' = Var.fresh () in
1038+
let dim0 = Var.fresh () in
1039+
let dim1 = Var.fresh () in
1040+
let dim2 = Var.fresh () in
10081041
let v' =
10091042
transl_prim_arg
10101043
ctx
@@ -1017,16 +1050,28 @@ module Generate (Target : Target_sig.S) = struct
10171050
v
10181051
in
10191052
seq
1020-
(let* cond = Arith.uge i' (Bigarray.dim 0 ta') in
1053+
(let* () =
1054+
store ~typ:I32 i' (transl_prim_arg ctx ~typ:(Int Normalized) i)
1055+
in
1056+
let* () =
1057+
store ~typ:I32 j' (transl_prim_arg ctx ~typ:(Int Normalized) j)
1058+
in
1059+
let* () =
1060+
store ~typ:I32 k' (transl_prim_arg ctx ~typ:(Int Normalized) k)
1061+
in
1062+
let* () = store dim0 ~typ:I32 (Bigarray.dim 0 ta') in
1063+
let* () = store dim1 ~typ:I32 (Bigarray.dim 1 ta') in
1064+
let* () = store dim2 ~typ:I32 (Bigarray.dim 2 ta') in
1065+
let* cond = Arith.uge (load i') (load dim0) in
10211066
let* () = instr (W.Br_if (label_index context bound_error_pc, cond)) in
1022-
let* cond = Arith.uge j' (Bigarray.dim 1 ta') in
1067+
let* cond = Arith.uge (load j') (load dim1) in
10231068
let* () = instr (W.Br_if (label_index context bound_error_pc, cond)) in
1024-
let* cond = Arith.uge k' (Bigarray.dim 2 ta') in
1069+
let* cond = Arith.uge (load k') (load dim2) in
10251070
let* () = instr (W.Br_if (label_index context bound_error_pc, cond)) in
10261071
Bigarray.set
10271072
~kind
10281073
ta'
1029-
Arith.((((i' * Bigarray.dim 1 ta') + j') * Bigarray.dim 2 ta') + k')
1074+
Arith.((((load i' * load dim1) + load j') * load dim2) + load k')
10301075
v')
10311076
Value.unit
10321077
| _ ->

0 commit comments

Comments
 (0)