Runtime/wasm: fix method lookup, take 2

CHANGES.md

@@ -59,7 +59,7 @@
 * Runtime: fix caml_string_concat when not using JS strings (#1874)
 * Runtime: consistent bigarray hashing across all architectures (#1977)
 * Runtime: fix caml_utf8_of_utf16 bug in high surrogate case (#2008)
-* Runtime/wasm: fix method lookup (#2034)
+* Runtime/wasm: fix method lookup (#2034, #2038)
 * Tools: fix jsoo_mktop and jsoo_mkcmis (#1877)
 * Toplevel: fix for when use-js-strings is disabled (#1997)
 

compiler/tests-wasm_of_ocaml/gh2034.ml

@@ -12,6 +12,30 @@ let o2 =
     method b = ()
   end
 
+let g x = x#d
+
+let o3 =
+  object
+    method a = ()
+
+    method b = ()
+
+    method c = ()
+
+    method d = ()
+  end
+
+let o4 =
+  object
+    method b = ()
+
+    method c = ()
+
+    method d = ()
+  end
+
 let () =
   f o1;
-  f o2
+  f o2;
+  g o3;
+  g o4

runtime/wasm/obj.wat

@@ -379,10 +379,11 @@
       (ref.i31 (i32.const 0)))
 
    (global $method_cache (mut (ref $int_array))
-      (array.new $int_array (i32.const 0) (i32.const 8)))
+      (array.new $int_array (i32.const 4) (i32.const 8)))
 
    (func (export "caml_get_public_method")
-      (param $obj (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
+      (param $obj (ref eq)) (param $vtag (ref eq)) (param (ref eq))
+      (result (ref eq))
       (local $meths (ref $block))
       (local $tag i32) (local $cacheid i32) (local $ofs i32)
       (local $li i32) (local $mi i32) (local $hi i32)
@@ -391,15 +392,14 @@
          (ref.cast (ref $block)
             (array.get $block
                (ref.cast (ref $block) (local.get $obj)) (i32.const 1))))
-      (local.set $tag (i31.get_s (ref.cast (ref i31) (local.get 1))))
       (local.set $cacheid (i31.get_u (ref.cast (ref i31) (local.get 2))))
       (local.set $len (array.len (global.get $method_cache)))
       (if (i32.ge_s (local.get $cacheid) (local.get $len))
          (then
             (loop $size
                (local.set $len (i32.shl (local.get $len) (i32.const 1)))
                (br_if $size (i32.ge_s (local.get $cacheid) (local.get $len))))
-            (local.set $a (array.new $int_array (i32.const 0) (local.get $len)))
+            (local.set $a (array.new $int_array (i32.const 4) (local.get $len)))
             (array.copy $int_array $int_array
                (local.get $a) (i32.const 0)
                (global.get $method_cache) (i32.const 0)
@@ -409,16 +409,14 @@
          (array.get $int_array (global.get $method_cache) (local.get $cacheid)))
       (if (i32.lt_u (local.get $ofs) (array.len (local.get $meths)))
          (then
-            (if (i32.eq (local.get $tag)
-                   (i31.get_s
-                      (ref.cast (ref i31)
-                         (array.get $block (local.get $meths)
-                            (local.get $ofs)))))
+            (if (ref.eq (local.get $vtag)
+                   (array.get $block (local.get $meths) (local.get $ofs)))
                (then
                   (return
                      (array.get $block
                         (local.get $meths)
                         (i32.sub (local.get $ofs) (i32.const 1))))))))
+      (local.set $tag (i31.get_s (ref.cast (ref i31) (local.get $vtag))))
       (local.set $li (i32.const 3))
       (local.set $hi
          (i32.add
@@ -450,11 +448,9 @@
       (array.set $int_array (global.get $method_cache) (local.get $cacheid)
          (i32.add (local.get $li) (i32.const 1)))
       (if (result (ref eq))
-          (i32.eq (local.get $tag)
-             (i31.get_s
-                (ref.cast (ref i31)
-                   (array.get $block (local.get $meths)
-                      (i32.add (local.get $li) (i32.const 1))))))
+          (ref.eq (local.get $vtag)
+             (array.get $block (local.get $meths)
+                (i32.add (local.get $li) (i32.const 1))))
          (then
             (array.get $block (local.get $meths) (local.get $li)))
          (else