WIP

Author: vouillon

compiler/lib-wasm/gc_target.ml

@@ -442,6 +442,7 @@ module Type = struct
                   ; typ = Value (Ref { nullable = false; typ = Type custom_operations })
                   }
                 ; { mut = true; typ = Value (Ref { nullable = false; typ = Extern }) }
+                ; { mut = true; typ = Value (Ref { nullable = false; typ = Extern }) }
                 ; { mut = false
                   ; typ = Value (Ref { nullable = false; typ = Type int_array })
                   }
@@ -1390,7 +1391,7 @@ module Bigarray = struct
     let* ty = Type.bigarray_type in
     Memory.wasm_array_get
       ~ty:Type.int_array_type
-      (Memory.wasm_struct_get ty (Memory.wasm_cast ty a) 2)
+      (Memory.wasm_struct_get ty (Memory.wasm_cast ty a) 3)
       (Arith.const 0l)
 
   let get ~kind a i =
@@ -1399,15 +1400,15 @@ module Bigarray = struct
         let* f =
           register_import
             ~import_module:"bindings"
-            ~name:"ta_get_ui8"
+            ~name:"dv_get_ui8"
             (Fun
                { W.params = [ Ref { nullable = false; typ = Extern }; I32 ]
                ; result = [ I32 ]
                })
         in
         let* ty = Type.bigarray_type in
-        let* ta = Memory.wasm_struct_get ty (Memory.wasm_cast ty a) 1 in
-        let* i = Value.int_val i in
+        let* ta = Memory.wasm_struct_get ty (Memory.wasm_cast ty a) 2 in
+        let* i = i in
         return (W.Call (f, [ ta; i ]))
     | _ -> assert false
 
@@ -1417,20 +1418,16 @@ module Bigarray = struct
         let* f =
           register_import
             ~import_module:"bindings"
-            ~name:"ta_set_ui8"
+            ~name:"dv_set_ui8"
             (Fun
-               { W.params =
-                   [ Ref { nullable = false; typ = Extern }
-                   ; I32
-                   ; Ref { nullable = false; typ = I31 }
-                   ]
+               { W.params = [ Ref { nullable = false; typ = Extern }; I32; I32 ]
                ; result = []
                })
         in
         let* ty = Type.bigarray_type in
-        let* ta = Memory.wasm_struct_get ty (Memory.wasm_cast ty a) 1 in
-        let* i = Value.int_val i in
-        let* v = cast I31 v in
+        let* ta = Memory.wasm_struct_get ty (Memory.wasm_cast ty a) 2 in
+        let* i = i in
+        let* v = v in
         instr (W.CallInstr (f, [ ta; i; v ]))
     | _ -> assert false
 end

compiler/lib-wasm/generate.ml

@@ -889,31 +889,31 @@ module Generate (Target : Target_sig.S) = struct
         match l with
         | [ x; y ] -> (
             let x' = transl_prim_arg ctx x in
-            let y' = transl_prim_arg ctx y in
             match get_type ctx x with
             | Bigarray { kind = (Int8_unsigned | Char) as kind; layout = C } ->
+                let y' = transl_prim_arg ctx ~typ:(Int Unnormalized) y in
                 seq
-                  (let* cond = Arith.uge (Value.int_val y') (Bigarray.dim1 x') in
+                  (let* cond = Arith.uge y' (Bigarray.dim1 x') in
                    instr (W.Br_if (label_index context bound_error_pc, cond)))
                   (Bigarray.get ~kind x' y')
             | _ ->
                 let* f =
                   register_import ~name:"caml_ba_get_1" (Fun (Type.primitive_type 2))
                 in
                 let* x' = x' in
-                let* y' = y' in
+                let* y' = transl_prim_arg ctx y in
                 return (W.Call (f, [ x'; y' ])))
         | _ -> invalid_arity "caml_ba_get_1" l ~expected:2);
     register_prim "caml_ba_set_1" `Mutator (fun ctx context l ->
         match l with
         | [ x; y; z ] -> (
             let x' = transl_prim_arg ctx x in
-            let y' = transl_prim_arg ctx y in
-            let z' = transl_prim_arg ctx z in
             match get_type ctx x with
             | Bigarray { kind = (Int8_unsigned | Char) as kind; layout = C } ->
+                let y' = transl_prim_arg ctx ~typ:(Int Normalized) y in
+                let z' = transl_prim_arg ctx ~typ:(Int Unnormalized) z in
                 seq
-                  (let* cond = Arith.uge (Value.int_val y') (Bigarray.dim1 x') in
+                  (let* cond = Arith.uge y' (Bigarray.dim1 x') in
                    let* () = instr (W.Br_if (label_index context bound_error_pc, cond)) in
                    Bigarray.set ~kind x' y' z')
                   Value.unit
@@ -922,8 +922,8 @@ module Generate (Target : Target_sig.S) = struct
                   register_import ~name:"caml_ba_set_1" (Fun (Type.primitive_type 3))
                 in
                 let* x' = x' in
-                let* y' = y' in
-                let* z' = z' in
+                let* y' = transl_prim_arg ctx y in
+                let* z' = transl_prim_arg ctx z in
                 return (W.Call (f, [ x'; y'; z' ])))
         | _ -> invalid_arity "caml_ba_set_1" l ~expected:3)