diff --git a/CHANGES.md b/CHANGES.md index d4ebaea628..840507ab06 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -7,6 +7,7 @@ * Compiler/wasm: make the type of some Wasm primitives more precise (#2100) * Compiler: reference unboxing (#1958) * Runtime: improved handling of NaNs (#2110) +* Lib: allow to reference values from the runtime (#2086) ## Bug fixes * Compiler: fix purity of comparison functions (again) (#2092) diff --git a/compiler/lib-wasm/gc_target.ml b/compiler/lib-wasm/gc_target.ml index eaaa6b6498..111e21d9c0 100644 --- a/compiler/lib-wasm/gc_target.ml +++ b/compiler/lib-wasm/gc_target.ml @@ -1932,6 +1932,22 @@ let internal_primitives = in let l = List.map ~f:transl_prim_arg vl in JavaScript.invoke_fragment name l); + register "caml_jsoo_runtime_value" (fun _ l -> + match l with + | [ Pc (String name) ] when J.is_ident name -> + let* x = + register_import + ~import_module:"js" + ~name + (Global { mut = false; typ = JavaScript.anyref }) + in + let* wrap = + register_import + ~name:"wrap" + (Fun { params = [ JavaScript.anyref ]; result = [ Type.value ] }) + in + return (W.Call (wrap, [ GlobalGet x ])) + | _ -> failwith "Jsoo_runtime.Js.runtime_value expects a string literal."); !l let externref = W.Ref { nullable = true; typ = Extern } diff --git a/compiler/lib/generate.ml b/compiler/lib/generate.ml index 30eb8198c2..b682a88af0 100644 --- a/compiler/lib/generate.ml +++ b/compiler/lib/generate.ml @@ -1547,6 +1547,17 @@ let rec translate_expr ctx loc x e level : (_ * J.statement_list) Expr_builder.t | Some s -> Printf.sprintf ", file %S" s) pi.Parse_info.line pi.Parse_info.col)) + | Extern "caml_jsoo_runtime_value", [ Pc (String nm) ] when J.is_ident nm -> + let prim = Share.get_prim (runtime_fun ctx) nm ctx.Ctx.share in + return prim + | Extern "caml_jsoo_runtime_value", [ (Pc _ | Pv _) ] -> + failwith + (Printf.sprintf + "%sJsoo_runtime.Js.runtime_value expects a string literal." + (match (loc : J.location) with + | Pi { name = Some name; col; line; _ } -> + Printf.sprintf "%s:%d:%d: " name line col + | Pi _ | N | U -> "")) | Extern "%js_array", l -> let* args = list_map (fun x -> access' ~ctx x) l in return (J.array args) diff --git a/compiler/lib/specialize_js.ml b/compiler/lib/specialize_js.ml index dda64b1063..15b94ecca4 100644 --- a/compiler/lib/specialize_js.ml +++ b/compiler/lib/specialize_js.ml @@ -188,6 +188,11 @@ let specialize_instr opt_count ~target info i = incr opt_count; Let (x, Prim (Extern "%direct_int_mod", [ y; z ])) | _ -> i) + | Let (x, Prim (Extern "caml_jsoo_runtime_value", [ nm ])), _ -> ( + match the_string_of info nm with + | Some nm when Javascript.is_ident nm -> + Let (x, Prim (Extern "caml_jsoo_runtime_value", [ Pc (String nm) ])) + | _ -> i) | _, _ -> i let skip_event cont (Event _ :: l | l) = cont l diff --git a/compiler/tests-check-prim/main.4.14.output b/compiler/tests-check-prim/main.4.14.output index 22874e2666..64f257e4b7 100644 --- a/compiler/tests-check-prim/main.4.14.output +++ b/compiler/tests-check-prim/main.4.14.output @@ -14,6 +14,7 @@ caml_int64_or_native caml_int64_sub_native caml_int64_xor_native caml_int_as_pointer +caml_jsoo_runtime_value caml_reset_afl_instrumentation debugger diff --git a/compiler/tests-check-prim/main.5.4.output b/compiler/tests-check-prim/main.5.4.output index db911809bf..a74354fef3 100644 --- a/compiler/tests-check-prim/main.5.4.output +++ b/compiler/tests-check-prim/main.5.4.output @@ -5,6 +5,7 @@ From main.bc: caml_assume_no_perform caml_continuation_use caml_int_as_pointer +caml_jsoo_runtime_value caml_reset_afl_instrumentation debugger diff --git a/compiler/tests-check-prim/unix-Unix.4.14.output b/compiler/tests-check-prim/unix-Unix.4.14.output index e69cd8d7c6..7223441fb8 100644 --- a/compiler/tests-check-prim/unix-Unix.4.14.output +++ b/compiler/tests-check-prim/unix-Unix.4.14.output @@ -14,6 +14,7 @@ caml_int64_or_native caml_int64_sub_native caml_int64_xor_native caml_int_as_pointer +caml_jsoo_runtime_value caml_reset_afl_instrumentation caml_unix_map_file_bytecode debugger diff --git a/compiler/tests-check-prim/unix-Unix.5.4.output b/compiler/tests-check-prim/unix-Unix.5.4.output index 6a1bf3dbd4..6b3b655dc2 100644 --- a/compiler/tests-check-prim/unix-Unix.5.4.output +++ b/compiler/tests-check-prim/unix-Unix.5.4.output @@ -5,6 +5,7 @@ From unix.bc: caml_assume_no_perform caml_continuation_use caml_int_as_pointer +caml_jsoo_runtime_value caml_reset_afl_instrumentation caml_unix_accept caml_unix_alarm diff --git a/compiler/tests-check-prim/unix-Win32.4.14.output b/compiler/tests-check-prim/unix-Win32.4.14.output index 947b6d951a..54ae31ca2d 100644 --- a/compiler/tests-check-prim/unix-Win32.4.14.output +++ b/compiler/tests-check-prim/unix-Win32.4.14.output @@ -14,6 +14,7 @@ caml_int64_or_native caml_int64_sub_native caml_int64_xor_native caml_int_as_pointer +caml_jsoo_runtime_value caml_reset_afl_instrumentation caml_unix_map_file_bytecode debugger diff --git a/compiler/tests-check-prim/unix-Win32.5.4.output b/compiler/tests-check-prim/unix-Win32.5.4.output new file mode 100644 index 0000000000..51bf5cce32 --- /dev/null +++ b/compiler/tests-check-prim/unix-Win32.5.4.output @@ -0,0 +1,194 @@ +Missing +------- + +From unix.bc: +caml_assume_no_perform +caml_continuation_use +caml_int_as_pointer +caml_jsoo_runtime_value +caml_reset_afl_instrumentation +caml_unix_accept +caml_unix_bind +caml_unix_clear_close_on_exec +caml_unix_clear_nonblock +caml_unix_connect +caml_unix_create_process +caml_unix_dup +caml_unix_dup2 +caml_unix_environment +caml_unix_execv +caml_unix_execve +caml_unix_execvp +caml_unix_execvpe +caml_unix_filedescr_of_channel +caml_unix_getaddrinfo +caml_unix_gethostbyaddr +caml_unix_gethostbyname +caml_unix_gethostname +caml_unix_getnameinfo +caml_unix_getpeername +caml_unix_getpid +caml_unix_getprotobyname +caml_unix_getprotobynumber +caml_unix_getservbyname +caml_unix_getservbyport +caml_unix_getsockname +caml_unix_getsockopt +caml_unix_listen +caml_unix_lockf +caml_unix_map_file_bytecode +caml_unix_pipe +caml_unix_putenv +caml_unix_realpath +caml_unix_recv +caml_unix_recvfrom +caml_unix_select +caml_unix_send +caml_unix_sendto +caml_unix_set_close_on_exec +caml_unix_set_nonblock +caml_unix_setsockopt +caml_unix_shutdown +caml_unix_sleep +caml_unix_socket +caml_unix_socketpair +caml_unix_string_of_inet_addr +caml_unix_system +caml_unix_terminate_process +caml_unix_waitpid +debugger + +Unused +------- + +From +array.js: +caml_check_bound + +From +bigarray.js: +caml_ba_create_from (deprecated) +caml_ba_init + +From +bigstring.js: +caml_bigstring_blit_ba_to_ba +caml_bigstring_blit_ba_to_bytes +caml_bigstring_blit_bytes_to_ba +caml_bigstring_blit_string_to_ba +caml_bigstring_memcmp +caml_hash_mix_bigstring + +From +effect.js: +jsoo_effect_not_supported + +From +fs.js: +caml_ba_map_file +caml_ba_map_file_bytecode +caml_fs_init +jsoo_create_file +jsoo_create_file_extern + +From +graphics.js: +caml_gr_arc_aux +caml_gr_blit_image +caml_gr_clear_graph +caml_gr_close_graph +caml_gr_close_subwindow +caml_gr_create_image +caml_gr_current_x +caml_gr_current_y +caml_gr_display_mode +caml_gr_doc_of_state +caml_gr_draw_arc +caml_gr_draw_char +caml_gr_draw_image +caml_gr_draw_rect +caml_gr_draw_str +caml_gr_draw_string +caml_gr_dump_image +caml_gr_fill_arc +caml_gr_fill_poly +caml_gr_fill_rect +caml_gr_lineto +caml_gr_make_image +caml_gr_moveto +caml_gr_open_graph +caml_gr_open_subwindow +caml_gr_plot +caml_gr_point_color +caml_gr_remember_mode +caml_gr_resize_window +caml_gr_set_color +caml_gr_set_font +caml_gr_set_line_width +caml_gr_set_text_size +caml_gr_set_window_title +caml_gr_sigio_handler +caml_gr_sigio_signal +caml_gr_size_x +caml_gr_size_y +caml_gr_state +caml_gr_state_create +caml_gr_state_get +caml_gr_state_init +caml_gr_state_set +caml_gr_synchronize +caml_gr_text_size +caml_gr_wait_event +caml_gr_window_id + +From +hash.js: +caml_hash_mix_int64 + +From +ints.js: +caml_div +caml_mod + +From +jslib.js: +caml_is_js +caml_trampoline +caml_trampoline_return +caml_wrap_exception + +From +marshal.js: +caml_marshal_constants + +From +mlBytes.js: +caml_array_of_bytes (deprecated) +caml_array_of_string (deprecated) +caml_bytes_of_utf16_jsstring +caml_new_string (deprecated) +caml_string_concat +caml_to_js_string (deprecated) + +From +runtime_events.js: +caml_runtime_events_create_cursor +caml_runtime_events_free_cursor +caml_runtime_events_read_poll +caml_runtime_events_user_resolve + +From +stdlib.js: +caml_is_printable +caml_maybe_print_stats + +From +sys.js: +caml_fatal_uncaught_exception +caml_format_exception +caml_is_special_exception +caml_set_static_env +caml_sys_const_naked_pointers_checked + +From +toplevel.js: +jsoo_get_runtime_aliases +jsoo_toplevel_init_compile +jsoo_toplevel_init_reloc + +From +unix.js: +caml_strerror +caml_unix_fchmod +caml_unix_getegid +caml_unix_geteuid +caml_unix_getgid +caml_unix_getpwnam +caml_unix_getuid +caml_unix_rewinddir +unix_error_message + diff --git a/compiler/tests-jsoo/custom.js b/compiler/tests-jsoo/custom.js new file mode 100644 index 0000000000..f3caeb9a97 --- /dev/null +++ b/compiler/tests-jsoo/custom.js @@ -0,0 +1,5 @@ +//Provides: process +var process = "process"; + +//Provides: obj +var obj = { process: 42 }; diff --git a/compiler/tests-jsoo/custom.wat b/compiler/tests-jsoo/custom.wat new file mode 100644 index 0000000000..790b3abf36 --- /dev/null +++ b/compiler/tests-jsoo/custom.wat @@ -0,0 +1,7 @@ +;; This ensures that the referenced JavaScript values are linked in the +;; runtime with separate compilation and is optimized away in case of +;; whole program compilation. + +(global (export "_caml_js_delete") (import "js" "caml_js_delete") anyref) +(global (export "_process") (import "js" "process") anyref) +(global (export "_obj") (import "js" "obj") anyref) diff --git a/compiler/tests-jsoo/dune b/compiler/tests-jsoo/dune index 60c7a46832..66ba857404 100644 --- a/compiler/tests-jsoo/dune +++ b/compiler/tests-jsoo/dune @@ -48,6 +48,7 @@ test_bigarray test_marshal_compressed test_parsing + test_custom calc_parser calc_lexer)) (libraries unix compiler-libs.common js_of_ocaml-compiler) @@ -66,6 +67,16 @@ (modules test_float16 test_bigarray) (modes js wasm native)) +(test + (name test_custom) + (modules test_custom) + (libraries js_of_ocaml) + (js_of_ocaml + (javascript_files custom.js)) + (wasm_of_ocaml + (javascript_files custom.js custom.wat)) + (modes js wasm)) + (ocamlyacc calc_parser) (ocamllex calc_lexer) diff --git a/compiler/tests-jsoo/test_custom.ml b/compiler/tests-jsoo/test_custom.ml new file mode 100644 index 0000000000..f2347d9d5f --- /dev/null +++ b/compiler/tests-jsoo/test_custom.ml @@ -0,0 +1,8 @@ +open Js_of_ocaml + +let () = + let p : Js.js_string Js.t = Jsoo_runtime.Js.runtime_value "process" in + let o : _ Js.t = Jsoo_runtime.Js.runtime_value "obj" in + let del = Jsoo_runtime.Js.runtime_value "caml_js_delete" in + ignore (Js.Unsafe.fun_call del [| o; Js.Unsafe.coerce (Js.string "process") |]); + print_endline (Js.to_string p) diff --git a/lib/runtime/js_of_ocaml_runtime_stubs.c b/lib/runtime/js_of_ocaml_runtime_stubs.c index 44ea7ecb8a..eed5c11ee3 100644 --- a/lib/runtime/js_of_ocaml_runtime_stubs.c +++ b/lib/runtime/js_of_ocaml_runtime_stubs.c @@ -208,6 +208,10 @@ void caml_jsoo_flags_use_js_string () { caml_fatal_error("Unimplemented Javascript primitive caml_jsoo_flags_use_js_string!"); } +void caml_jsoo_runtime_value () { + caml_fatal_error("Unimplemented Javascript primitive caml_jsoo_runtime_value!"); +} + void caml_jsstring_of_string () { caml_fatal_error("Unimplemented Javascript primitive caml_jsstring_of_string!"); } diff --git a/lib/runtime/jsoo_runtime.ml b/lib/runtime/jsoo_runtime.ml index 4dee5f64a9..45e304d890 100644 --- a/lib/runtime/jsoo_runtime.ml +++ b/lib/runtime/jsoo_runtime.ml @@ -94,6 +94,8 @@ module Js = struct external wrap_meth_callback : ('a -> 'b) -> ('a, 'b) meth_callback = "caml_js_wrap_meth_callback" + + external runtime_value : string -> 'a = "caml_jsoo_runtime_value" end module Sys = struct