Fix method lookup cache with separate compilation (#2039)

hhugo · vouillon · web-flow · commit 3324e4afb600 · 2025-06-17T14:02:20.000+02:00
* Fix method lookup cache with separate compilation

* Tests: check-runtime now filter internal primitives

* Runtime: caml_get_public_method is expose in stdlib mli. respect the arity

Co-authored-by: Jérôme Vouillon &lt;jerome.vouillon@gmail.com&gt;
diff --git a/CHANGES.md b/CHANGES.md
@@ -64,7 +64,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, #2038)
+* Runtime/wasm/js: fix method lookup (#2034, #2038, #2039)
 * Tools: fix jsoo_mktop and jsoo_mkcmis (#1877)
 * Toplevel: fix for when use-js-strings is disabled (#1997)
 
diff --git a/compiler/bin-js_of_ocaml/check_runtime.ml b/compiler/bin-js_of_ocaml/check_runtime.ml
@@ -91,16 +91,30 @@ let f (runtime_files, bytecode, target_env) =
   in
   let needed = StringSet.of_list (List.map ~f:fst needed) in
   let needed =
-    (* this list was copied from parse_bytecode *)
     List.fold_left
       ~f:(fun acc x -> StringSet.remove x acc)
       ~init:needed
-      [ "caml_ensure_stack_capacity"
+      [ (* this list was copied from parse_bytecode *)
+        "caml_ensure_stack_capacity"
       ; "caml_process_pending_actions_with_root"
       ; "caml_make_array"
       ; "caml_array_of_uniform_array"
       ]
   in
+  let needed =
+    (* internal primitives *)
+    List.fold_left
+      ~f:(fun acc x -> StringSet.add x acc)
+      ~init:needed
+      [ "caml_register_global"
+      ; "caml_js_set"
+      ; "caml_js_get"
+      ; "caml_get_global_data"
+      ; "caml_oo_cache_id"
+      ; "caml_get_public_method"
+      ; "caml_get_cached_method"
+      ]
+  in
   let from_runtime1 = Linker.list_all () in
   let from_runtime2 = Primitive.get_external () in
   (* [from_runtime2] is a superset of [from_runtime1].
diff --git a/compiler/lib/parse_bytecode.ml b/compiler/lib/parse_bytecode.ml
@@ -532,6 +532,7 @@ type globals =
   ; mutable is_const : bool array
   ; mutable is_exported : bool array
   ; mutable named_value : string option array
+  ; mutable cache_ids : Var.t list
   ; constants : Code.constant array
   ; primitives : string array
   }
@@ -541,6 +542,7 @@ let make_globals size constants primitives =
   ; is_const = Array.make size false
   ; is_exported = Array.make size false
   ; named_value = Array.make size None
+  ; cache_ids = []
   ; constants
   ; primitives
   }
@@ -818,8 +820,6 @@ let tagged_blocks = ref Addr.Map.empty
 
 let compiled_blocks : (_ * instr list * last) Addr.Map.t ref = ref Addr.Map.empty
 
-let method_cache_id = ref 1
-
 let clo_offset_3 = 3
 
 type compile_info =
@@ -2353,34 +2353,29 @@ and compile infos pc state (instrs : instr list) =
           (Let (x, Prim (Ult, [ Pv z; Pv y ])) :: instrs)
     | GETPUBMET ->
         let n = gets32 code (pc + 1) in
-        let cache = !method_cache_id in
-        incr method_cache_id;
         let obj = State.accu state in
         let state = State.push state in
-        let tag, state = State.fresh_var state in
+        let cache_id = Var.fresh_n "cache_id" in
+        state.globals.cache_ids <- cache_id :: state.globals.cache_ids;
         let m, state = State.fresh_var state in
-
-        if debug_parser () then Format.printf "%a = %ld@." Var.print tag n;
         if debug_parser ()
         then
           Format.printf
-            "%a = caml_get_public_method(%a, %a)@."
+            "%a = caml_get_cached_method(%a, %ld)@."
             Var.print
             m
             Var.print
             obj
-            Var.print
-            tag;
+            n;
         compile
           infos
           (pc + 3)
           state
           (Let
              ( m
              , Prim
-                 ( Extern "caml_get_public_method"
-                 , [ Pv obj; Pv tag; Pc (Int (Targetint.of_int_exn cache)) ] ) )
-          :: Let (tag, const32 n)
+                 ( Extern "caml_get_cached_method"
+                 , [ Pv obj; Pc (Int (Targetint.of_int32_exn n)); Pv cache_id ] ) )
           :: instrs)
     | GETDYNMET ->
         let tag = State.accu state in
@@ -2401,12 +2396,7 @@ and compile infos pc state (instrs : instr list) =
           infos
           (pc + 1)
           state
-          (Let
-             ( m
-             , Prim
-                 ( Extern "caml_get_public_method"
-                 , [ Pv obj; Pv tag; Pc (Int Targetint.zero) ] ) )
-          :: instrs)
+          (Let (m, Prim (Extern "caml_get_public_method", [ Pv obj; Pv tag ])) :: instrs)
     | GETMETHOD ->
         let lab = State.accu state in
         let obj = State.peek 0 state in
@@ -2537,7 +2527,12 @@ let parse_bytecode code globals debug_data =
   in
   compiled_blocks := Addr.Map.empty;
   tagged_blocks := Addr.Map.empty;
-  Code.compact p
+  let p = Code.compact p in
+  let body =
+    List.fold_left globals.cache_ids ~init:[] ~f:(fun body cache_id ->
+        Let (cache_id, Prim (Extern "caml_oo_cache_id", [])) :: body)
+  in
+  Code.prepend p body
 
 module Toc : sig
   type t
diff --git a/compiler/tests-check-prim/main.4.14.output b/compiler/tests-check-prim/main.4.14.output
@@ -116,11 +116,8 @@ caml_string_concat
 caml_to_js_string (deprecated)
 
 From +stdlib.js:
-caml_build_symbols
 caml_is_printable
 caml_maybe_print_stats
-caml_register_global
-jsoo_toplevel_reloc
 
 From +sync.js:
 MlMutex
diff --git a/compiler/tests-check-prim/main.5.2.output b/compiler/tests-check-prim/main.5.2.output
@@ -118,11 +118,8 @@ caml_runtime_events_read_poll
 caml_runtime_events_user_resolve
 
 From +stdlib.js:
-caml_build_symbols
 caml_is_printable
 caml_maybe_print_stats
-caml_register_global
-jsoo_toplevel_reloc
 
 From +sys.js:
 caml_fatal_uncaught_exception
diff --git a/compiler/tests-check-prim/main.5.3.output b/compiler/tests-check-prim/main.5.3.output
@@ -117,11 +117,8 @@ caml_runtime_events_read_poll
 caml_runtime_events_user_resolve
 
 From +stdlib.js:
-caml_build_symbols
 caml_is_printable
 caml_maybe_print_stats
-caml_register_global
-jsoo_toplevel_reloc
 
 From +sys.js:
 caml_fatal_uncaught_exception
diff --git a/compiler/tests-check-prim/main.5.4.output b/compiler/tests-check-prim/main.5.4.output
@@ -116,11 +116,8 @@ caml_runtime_events_read_poll
 caml_runtime_events_user_resolve
 
 From +stdlib.js:
-caml_build_symbols
 caml_is_printable
 caml_maybe_print_stats
-caml_register_global
-jsoo_toplevel_reloc
 
 From +sys.js:
 caml_fatal_uncaught_exception
diff --git a/compiler/tests-check-prim/unix-Unix.4.14.output b/compiler/tests-check-prim/unix-Unix.4.14.output
@@ -192,11 +192,8 @@ caml_string_concat
 caml_to_js_string (deprecated)
 
 From +stdlib.js:
-caml_build_symbols
 caml_is_printable
 caml_maybe_print_stats
-caml_register_global
-jsoo_toplevel_reloc
 
 From +sync.js:
 MlMutex
diff --git a/compiler/tests-check-prim/unix-Unix.5.2.output b/compiler/tests-check-prim/unix-Unix.5.2.output
@@ -194,11 +194,8 @@ caml_runtime_events_read_poll
 caml_runtime_events_user_resolve
 
 From +stdlib.js:
-caml_build_symbols
 caml_is_printable
 caml_maybe_print_stats
-caml_register_global
-jsoo_toplevel_reloc
 
 From +sys.js:
 caml_fatal_uncaught_exception
diff --git a/compiler/tests-check-prim/unix-Unix.5.3.output b/compiler/tests-check-prim/unix-Unix.5.3.output
@@ -193,11 +193,8 @@ caml_runtime_events_read_poll
 caml_runtime_events_user_resolve
 
 From +stdlib.js:
-caml_build_symbols
 caml_is_printable
 caml_maybe_print_stats
-caml_register_global
-jsoo_toplevel_reloc
 
 From +sys.js:
 caml_fatal_uncaught_exception
diff --git a/compiler/tests-check-prim/unix-Unix.5.4.output b/compiler/tests-check-prim/unix-Unix.5.4.output
@@ -193,11 +193,8 @@ caml_runtime_events_read_poll
 caml_runtime_events_user_resolve
 
 From +stdlib.js:
-caml_build_symbols
 caml_is_printable
 caml_maybe_print_stats
-caml_register_global
-jsoo_toplevel_reloc
 
 From +sys.js:
 caml_fatal_uncaught_exception
diff --git a/compiler/tests-check-prim/unix-Win32.4.14.output b/compiler/tests-check-prim/unix-Win32.4.14.output
@@ -164,11 +164,8 @@ caml_string_concat
 caml_to_js_string (deprecated)
 
 From +stdlib.js:
-caml_build_symbols
 caml_is_printable
 caml_maybe_print_stats
-caml_register_global
-jsoo_toplevel_reloc
 
 From +sync.js:
 MlMutex
diff --git a/compiler/tests-check-prim/unix-Win32.5.2.output b/compiler/tests-check-prim/unix-Win32.5.2.output
@@ -167,11 +167,8 @@ caml_runtime_events_read_poll
 caml_runtime_events_user_resolve
 
 From +stdlib.js:
-caml_build_symbols
 caml_is_printable
 caml_maybe_print_stats
-caml_register_global
-jsoo_toplevel_reloc
 
 From +sys.js:
 caml_fatal_uncaught_exception
diff --git a/compiler/tests-check-prim/unix-Win32.5.3.output b/compiler/tests-check-prim/unix-Win32.5.3.output
@@ -166,11 +166,8 @@ caml_runtime_events_read_poll
 caml_runtime_events_user_resolve
 
 From +stdlib.js:
-caml_build_symbols
 caml_is_printable
 caml_maybe_print_stats
-caml_register_global
-jsoo_toplevel_reloc
 
 From +sys.js:
 caml_fatal_uncaught_exception
diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc
@@ -689,6 +689,21 @@
  (preprocess
   (pps ppx_expect)))
 
+(library
+ ;; compiler/tests-compiler/oo.ml
+ (name oo_15)
+ (enabled_if true)
+ (modules oo)
+ (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper)
+ (inline_tests
+  (enabled_if true)
+  (deps
+   (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe)
+   (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe)))
+ (flags (:standard -open Jsoo_compiler_expect_tests_helper))
+ (preprocess
+  (pps ppx_expect)))
+
 (library
  ;; compiler/tests-compiler/rec.ml
  (name rec_15)
diff --git a/compiler/tests-compiler/oo.ml b/compiler/tests-compiler/oo.ml
@@ -0,0 +1,54 @@
+(* Js_of_ocaml compiler
+ * http://www.ocsigen.org/js_of_ocaml/
+ * Copyright (C) 2025 Hugo Heuzard
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, with linking exception;
+ * either version 2.1 of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+ *)
+
+let%expect_test _ =
+  let prog =
+    {|
+
+     let f o = o#a
+
+     let o1 = object
+       method a = print_endline "a from o1"
+     end
+
+     let o2 = object
+       method b = ()
+       method a = print_endline "a from o2"
+     end
+
+     let () = f o1; f o2
+|}
+  in
+  Util.compile_and_run prog;
+  [%expect {|
+    a from o1
+    a from o2
+    |}];
+  let program = Util.compile_and_parse prog in
+  Util.print_var_decl program "cache_id";
+  Util.print_fun_decl program (Some "f");
+  [%expect
+    {|
+    var cache_id = runtime.caml_oo_cache_id();
+    //end
+    function f(o){
+     return caml_call1(runtime.caml_get_cached_method(o, 97, cache_id), o);
+    }
+    //end
+    |}]
diff --git a/compiler/tests-full/stdlib.cma.expected.js b/compiler/tests-full/stdlib.cma.expected.js
@@ -31666,15 +31666,15 @@
          /*<<camlinternalOO.ml:587:57>>*/ new_cache(table);
          /*<<camlinternalOO.ml:492:2>>*/ return function(obj){
           /*<<camlinternalOO.ml:492:18>>*/ return caml_call1
-                 (caml_get_public_method(x$9, m$2, 0), x$9) /*<<camlinternalOO.ml:492:58>>*/ ;} /*<<camlinternalOO.ml:492:2>>*/ ;
+                 (caml_get_public_method(x$9, m$2), x$9) /*<<camlinternalOO.ml:492:58>>*/ ;} /*<<camlinternalOO.ml:492:2>>*/ ;
        case 21:
         var
          m$3 =  /*<<camlinternalOO.ml:589:14>>*/ next(0),
          n$16 =  /*<<camlinternalOO.ml:589:32>>*/ next(0);
          /*<<camlinternalOO.ml:589:56>>*/ new_cache(table);
          /*<<camlinternalOO.ml:494:2>>*/ return function(obj){
          var _g_ =  /*<<camlinternalOO.ml:495:4>>*/ obj[n$16 + 1];
-         return caml_call1(caml_get_public_method(_g_, m$3, 0), _g_) /*<<camlinternalOO.ml:496:32>>*/ ;} /*<<camlinternalOO.ml:494:2>>*/ ;
+         return caml_call1(caml_get_public_method(_g_, m$3), _g_) /*<<camlinternalOO.ml:496:32>>*/ ;} /*<<camlinternalOO.ml:494:2>>*/ ;
        case 22:
         var
          m$4 =  /*<<camlinternalOO.ml:591:14>>*/ next(0),
@@ -31683,7 +31683,7 @@
          /*<<camlinternalOO.ml:592:21>>*/ new_cache(table);
          /*<<camlinternalOO.ml:498:2>>*/ return function(obj){
          var _g_ =  /*<<camlinternalOO.ml:499:4>>*/ obj[e$4 + 1][n$17 + 1];
-         return caml_call1(caml_get_public_method(_g_, m$4, 0), _g_) /*<<camlinternalOO.ml:502:34>>*/ ;} /*<<camlinternalOO.ml:498:2>>*/ ;
+         return caml_call1(caml_get_public_method(_g_, m$4), _g_) /*<<camlinternalOO.ml:502:34>>*/ ;} /*<<camlinternalOO.ml:498:2>>*/ ;
        default:
         var
          m$5 =  /*<<camlinternalOO.ml:594:14>>*/ next(0),
@@ -31695,7 +31695,7 @@
              /*<<camlinternalOO.ml:505:14>>*/ caml_call1
              (obj[1][n$18 + 1], obj);
           /*<<camlinternalOO.ml:505:30>>*/ return caml_call1
-                 (caml_get_public_method(_g_, m$5, 0), _g_) /*<<camlinternalOO.ml:505:59>>*/ ;} /*<<camlinternalOO.ml:504:2>>*/ ;
+                 (caml_get_public_method(_g_, m$5), _g_) /*<<camlinternalOO.ml:505:59>>*/ ;} /*<<camlinternalOO.ml:504:2>>*/ ;
      }
      /*<<camlinternalOO.ml:595:24>>*/ return clo;
     /*<<camlinternalOO.ml:595:37>>*/ }
diff --git a/runtime/js/obj.js b/runtime/js/obj.js
diff --git a/runtime/wasm/obj.wat b/runtime/wasm/obj.wat
