Effects: introduce primitive caml_cps_trampoline

This is a better name for the primitive that sets up a trampoline to
switch to CPS.

Author: vouillon

compiler/lib-wasm/generate.ml

@@ -1196,11 +1196,7 @@ module Generate (Target : Target_sig.S) = struct
 end
 
 let init () =
-  let l =
-    [ "caml_callback", "caml_trampoline"
-    ; "caml_make_array", "caml_array_of_uniform_array"
-    ]
-  in
+  let l = [ "caml_make_array", "caml_array_of_uniform_array" ] in
   Primitive.register "caml_array_of_uniform_array" `Mutable None None;
   List.iter ~f:(fun (nm, nm') -> Primitive.alias nm nm') l
 

compiler/lib/effects.ml

@@ -847,7 +847,7 @@ let cps_transform ~live_vars ~flow_info ~cps_needed p =
               (* Toplevel code: if we double-translate, no need to handle it
                  specially: CPS calls in it are like all other CPS calls from
                  direct code. Otherwise, it needs to wrapped within a
-                 [caml_callback], but only if it performs CPS calls. *)
+                 [caml_cps_trampoline], but only if it performs CPS calls. *)
               not (double_translate () || Addr.Set.is_empty blocks_to_transform)
         in
         if debug ()
@@ -957,7 +957,7 @@ let cps_transform ~live_vars ~flow_info ~cps_needed p =
       match Hashtbl.find_opt closure_info p.start with
       | None -> p
       | Some (cps_params, cps_cont) ->
-          (* Call [caml_callback] to set up the execution context. *)
+          (* Call [caml_cps_trampoline] to set up the execution context. *)
           let new_start = p.free_pc in
           let blocks =
             let main = Var.fresh () in
@@ -969,7 +969,7 @@ let cps_transform ~live_vars ~flow_info ~cps_needed p =
               ; body =
                   [ Let (main, Closure (cps_params, cps_cont))
                   ; Let (args, Prim (Extern "%js_array", []))
-                  ; Let (res, Prim (Extern "caml_callback", [ Pv main; Pv args ]))
+                  ; Let (res, Prim (Extern "caml_cps_trampoline", [ Pv main; Pv args ]))
                   ]
               ; branch = Return res
               }
@@ -994,7 +994,7 @@ let wrap_call ~cps_needed p x f args accu =
   ( p
   , Var.Set.remove x cps_needed
   , [ Let (arg_array, Prim (Extern "%js_array", List.map ~f:(fun y -> Pv y) args))
-    ; Let (x, Prim (Extern "caml_callback", [ Pv f; Pv arg_array ]))
+    ; Let (x, Prim (Extern "caml_cps_trampoline", [ Pv f; Pv arg_array ]))
     ]
     :: accu )
 
@@ -1014,7 +1014,7 @@ let wrap_primitive ~cps_needed (p : program) x e accu =
   , let args = Var.fresh () in
     [ Let (f, Closure ([], (closure_pc, [])))
     ; Let (args, Prim (Extern "%js_array", []))
-    ; Let (x, Prim (Extern "caml_callback", [ Pv f; Pv args ]))
+    ; Let (x, Prim (Extern "caml_cps_trampoline", [ Pv f; Pv args ]))
     ]
     :: accu )
 
@@ -1026,9 +1026,9 @@ let rewrite_toplevel_instr (p, cps_needed, accu) instr =
       wrap_primitive ~cps_needed p x e accu
   | _ -> p, cps_needed, [ instr ] :: accu
 
-(* Wrap function calls inside [caml_callback] at toplevel to avoid
+(* Wrap function calls inside [caml_cps_trampoline] at toplevel to avoid
    unncessary function nestings. This is not done inside loops since
-   using repeatedly [caml_callback] can be costly. *)
+   using repeatedly [caml_cps_trampoline] can be costly. *)
 let rewrite_toplevel ~cps_needed p =
   let { start; blocks; _ } = p in
   let cfg = build_graph blocks start in

runtime/js/jslib.js

@@ -86,6 +86,7 @@ var caml_callback = caml_call_gen;
 //If: !doubletranslate
 //Requires: caml_stack_depth, caml_call_gen, caml_wrap_exception
 //Requires: caml_current_stack
+//Alias: caml_cps_trampoline
 function caml_callback(f, args) {
   var saved_stack_depth = caml_stack_depth;
   var saved_current_stack = caml_current_stack;

runtime/wasm/effect.wat

@@ -565,7 +565,7 @@
       (param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
       (unreachable))
 
-   (func (export "caml_trampoline")
+   (func $caml_trampoline (export "caml_cps_trampoline")
       (param $f (ref eq)) (param $vargs (ref eq)) (result (ref eq))
       (local $args (ref $block))
       (local $i i32) (local $res (ref eq))

runtime/wasm/obj.wat

@@ -25,8 +25,8 @@
       (func $caml_is_continuation (param (ref eq)) (result i32)))
 (@if (= effects "cps")
 (@then
-   (import "effect" "caml_trampoline"
-      (func $caml_trampoline (param (ref eq) (ref eq)) (result (ref eq))))
+   (import "effect" "caml_cps_trampoline"
+      (func $caml_cps_trampoline (param (ref eq) (ref eq)) (result (ref eq))))
 ))
 
 
@@ -460,14 +460,14 @@
 (@then
    (func $caml_callback_1 (export "caml_callback_1")
       (param $f (ref eq)) (param $x (ref eq)) (result (ref eq))
-      (return_call $caml_trampoline
+      (return_call $caml_cps_trampoline
          (local.get $f)
          (array.new_fixed $block 2 (ref.i31 (i32.const 0)) (local.get $x))))
 
    (func (export "caml_callback_2")
       (param $f (ref eq)) (param $x (ref eq)) (param $y (ref eq))
       (result (ref eq))
-      (return_call $caml_trampoline
+      (return_call $caml_cps_trampoline
          (local.get $f)
          (array.new_fixed $block 3 (ref.i31 (i32.const 0))
            (local.get $x) (local.get $y))))