WIP

Author: vouillon

compiler/lib-wasm/code_generation.ml

@@ -368,6 +368,7 @@ module Arith = struct
       (match e, e' with
       | W.Const (I32 n), W.Const (I32 n') when Int32.(n' < 31l) ->
           W.Const (I32 (Int32.shift_left n (Int32.to_int n')))
+      | _, W.Const (I32 0l) -> e
       | _ -> W.BinOp (I32 Shl, e, e'))
 
   let ( lsr ) = binary (Shr U)

compiler/lib-wasm/gc_target.ml

@@ -1406,10 +1406,10 @@ module Bigarray = struct
               let* x = x in
               Memory.box_float (return (W.F64PromoteF32 x)) )
       | Float64 -> "dv_get_f64", F64, 3, Memory.box_float
-      | Int8_signed -> "dv_get_i8", I32, 2, Fun.id
-      | Int8_unsigned | Char -> "dv_get_ui8", I32, 2, Fun.id
-      | Int16_signed -> "dv_get_i16", I32, 2, Fun.id
-      | Int16_unsigned -> "dv_get_ui16", I32, 2, Fun.id
+      | Int8_signed -> "dv_get_i8", I32, 0, Fun.id
+      | Int8_unsigned | Char -> "dv_get_ui8", I32, 0, Fun.id
+      | Int16_signed -> "dv_get_i16", I32, 1, Fun.id
+      | Int16_unsigned -> "dv_get_ui16", I32, 1, Fun.id
       | Int32 -> "dv_get_i32", I32, 2, Memory.box_int32
       | Nativeint -> "dv_get_i32", I32, 2, Memory.box_nativeint
       | Int64 -> "dv_get_i64", I64, 3, Memory.box_int64
@@ -1427,8 +1427,8 @@ module Bigarray = struct
     in
     let* ty = Type.bigarray_type in
     let* ta = Memory.wasm_struct_get ty (Memory.wasm_cast ty a) 2 in
-    let* i = if size = 1 then i else Arith.(i lsl const (Int32.of_int size)) in
-    box (return (W.Call (f, [ ta; i ])))
+    let* ofs = Arith.(i lsl const (Int32.of_int size)) in
+    box (return (W.Call (f, [ ta; ofs ])))
 
   let set ~kind a i v =
     let name, (typ : Wasm_ast.value_type), size, unbox =
@@ -1442,10 +1442,10 @@ module Bigarray = struct
               let* e = Memory.unbox_float x in
               return (W.F32DemoteF64 e) )
       | Float64 -> "dv_set_f64", F64, 3, Memory.unbox_float
-      | Int8_signed -> "dv_set_i8", I32, 2, Fun.id
-      | Int8_unsigned | Char -> "dv_set_ui8", I32, 2, Fun.id
-      | Int16_signed -> "dv_set_i16", I32, 2, Fun.id
-      | Int16_unsigned -> "dv_set_ui16", I32, 2, Fun.id
+      | Int8_signed -> "dv_set_i8", I32, 0, Fun.id
+      | Int8_unsigned | Char -> "dv_set_ui8", I32, 0, Fun.id
+      | Int16_signed -> "dv_set_i16", I32, 1, Fun.id
+      | Int16_unsigned -> "dv_set_ui16", I32, 1, Fun.id
       | Int32 -> "dv_set_i32", I32, 2, Memory.unbox_int32
       | Nativeint -> "dv_set_i32", I32, 2, Memory.unbox_nativeint
       | Int64 -> "dv_set_i64", I64, 3, Memory.unbox_int64
@@ -1454,7 +1454,7 @@ module Bigarray = struct
     in
     let* ty = Type.bigarray_type in
     let* ta = Memory.wasm_struct_get ty (Memory.wasm_cast ty a) 2 in
-    let* i = if size = 1 then i else Arith.(i lsl const (Int32.of_int size)) in
+    let* ofs = Arith.(i lsl const (Int32.of_int size)) in
     let* v = unbox v in
     let* f =
       register_import
@@ -1465,7 +1465,7 @@ module Bigarray = struct
            ; result = []
            })
     in
-    instr (W.CallInstr (f, [ ta; i; v ]))
+    instr (W.CallInstr (f, [ ta; ofs; v ]))
 end
 
 module JavaScript = struct