Skip to content

Commit

Permalink
Handle primitives that depend on the OCaml version
Browse files Browse the repository at this point in the history
  • Loading branch information
OlivierNicole committed Sep 13, 2024
1 parent 60a1203 commit 0ea7916
Show file tree
Hide file tree
Showing 5 changed files with 197 additions and 25 deletions.
22 changes: 3 additions & 19 deletions runtime/wasm/domain.wat
Original file line number Diff line number Diff line change
Expand Up @@ -19,11 +19,6 @@
(type $block (array (mut (ref eq))))
(type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
(type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
(import "sync" "caml_ml_mutex_unlock"
(func $caml_ml_mutex_unlock (param (ref eq)) (result (ref eq))))
(import "obj" "caml_callback_1"
(func $caml_callback_1
(param (ref eq)) (param (ref eq)) (result (ref eq))))

(func (export "caml_atomic_cas")
(param $ref (ref eq)) (param $o (ref eq)) (param $n (ref eq))
Expand Down Expand Up @@ -96,20 +91,9 @@
(param (ref eq)) (result (ref eq))
(ref.i31 (i32.const 1)))

(global $caml_domain_id (mut i32) (i32.const 0))
(global $caml_domain_latest_id (mut i32) (i32.const 1))

(func (export "caml_domain_spawn")
(param $f (ref eq)) (param $mutex (ref eq)) (result (ref eq))
(local $id i32) (local $old i32)
(local.set $id (global.get $caml_domain_latest_id))
(global.set $caml_domain_latest_id
(i32.add (local.get $id) (i32.const 1)))
(local.set $old (global.get $caml_domain_id))
(drop (call $caml_callback_1 (local.get $f) (ref.i31 (i32.const 0))))
(global.set $caml_domain_id (local.get $old))
(drop (call $caml_ml_mutex_unlock (local.get $mutex)))
(ref.i31 (local.get $id)))
(global $caml_domain_id (export "caml_domain_id") (mut i32) (i32.const 0))
(global $caml_domain_latest_id (export "caml_domain_latest_id") (mut i32)
(i32.const 1))

(func (export "caml_ml_domain_id") (param (ref eq)) (result (ref eq))
(ref.i31 (global.get $caml_domain_id)))
Expand Down
96 changes: 94 additions & 2 deletions runtime/wasm/dune
Original file line number Diff line number Diff line change
Expand Up @@ -3,11 +3,64 @@
(package wasm_of_ocaml-compiler)
(files runtime.wasm runtime.js))

(rule
(target version-dependent.wat)
(deps post-5.2.wat)
(enabled_if (>= %{ocaml_version} 5.2.0))
(action
(copy %{deps} %{target})))

(rule
(target version-dependent.wat)
(deps pre-5.2.wat)
(enabled_if (< %{ocaml_version} 5.2.0))
(action
(copy %{deps} %{target})))

(rule
(target runtime.wasm)
(deps
args
(glob_files *.wat))
array.wat
backtrace.wat
bigarray.wat
bigstring.wat
compare.wat
custom.wat
domain.wat
dynlink.wat
effect.wat
fail.wat
float.wat
fs.wat
gc.wat
hash.wat
int32.wat
int64.wat
ints.wat
io.wat
jslib.wat
jslib_js_of_ocaml.wat
jsstring.wat
lexing.wat
marshal.wat
md5.wat
nat.wat
obj.wat
parsing.wat
printexc.wat
prng.wat
runtime_events.wat
stdlib.wat
str.wat
string.wat
sync.wat
sys.wat
toplevel.wat
unix.wat
version-dependent.wat
weak.wat
zstd.wat)
(action
(progn
(system
Expand Down Expand Up @@ -47,7 +100,46 @@
(target args)
(deps
args.ml
(glob_files *.wat))
array.wat
backtrace.wat
bigarray.wat
bigstring.wat
compare.wat
custom.wat
domain.wat
dynlink.wat
effect.wat
fail.wat
float.wat
fs.wat
gc.wat
hash.wat
int32.wat
int64.wat
ints.wat
io.wat
jslib.wat
jslib_js_of_ocaml.wat
jsstring.wat
lexing.wat
marshal.wat
md5.wat
nat.wat
obj.wat
parsing.wat
printexc.wat
prng.wat
runtime_events.wat
stdlib.wat
str.wat
string.wat
sync.wat
sys.wat
toplevel.wat
unix.wat
version-dependent.wat
weak.wat
zstd.wat)
(action
(with-stdout-to
%{target}
Expand Down
57 changes: 57 additions & 0 deletions runtime/wasm/post-5.2.wat
Original file line number Diff line number Diff line change
@@ -0,0 +1,57 @@
;; Wasm_of_ocaml runtime support
;; http://www.ocsigen.org/js_of_ocaml/
;;
;; 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.

(module
(type $block (array (mut (ref eq))))
(import "obj" "caml_callback_1"
(func $caml_callback_1
(param (ref eq)) (param (ref eq)) (result (ref eq))))
(import "sync" "caml_ml_mutex_unlock"
(func $caml_ml_mutex_unlock (param (ref eq)) (result (ref eq))))
(import "domain" "caml_domain_latest_id"
(global $caml_domain_latest_id (mut i32)))
(import "domain" "caml_domain_id"
(global $caml_domain_id (mut i32)))

(func (export "caml_runtime_events_user_write")
(param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
(ref.i31 (i32.const 0)))

(func (export "caml_domain_spawn")
(param $f (ref eq)) (param $term_sync_v (ref eq)) (result (ref eq))
(local $id i32) (local $old i32) (local $ts (ref $block)) (local $res (ref eq))
(local.set $id (global.get $caml_domain_latest_id))
(global.set $caml_domain_latest_id
(i32.add (local.get $id) (i32.const 1)))
(local.set $old (global.get $caml_domain_id))
(local.set $res
(call $caml_callback_1 (local.get $f) (ref.i31 (i32.const 0))))
(global.set $caml_domain_id (local.get $old))
(local.set $ts (ref.cast (ref $block) (local.get $term_sync_v)))
(drop (call $caml_ml_mutex_unlock (array.get $block (local.get $ts) (i32.const 2))))
;; TODO: fix exn case
(array.set
$block
(local.get $ts)
(i32.const 1)
(array.new_fixed
$block
2
(ref.i31 (i32.const 0))
(array.new_fixed $block 2 (ref.i31 (i32.const 0)) (local.get $res))))
(ref.i31 (local.get $id)))
)
43 changes: 43 additions & 0 deletions runtime/wasm/pre-5.2.wat
Original file line number Diff line number Diff line change
@@ -0,0 +1,43 @@
;; Wasm_of_ocaml runtime support
;; http://www.ocsigen.org/js_of_ocaml/
;;
;; 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.

(module
(import "obj" "caml_callback_1"
(func $caml_callback_1
(param (ref eq)) (param (ref eq)) (result (ref eq))))
(import "sync" "caml_ml_mutex_unlock"
(func $caml_ml_mutex_unlock (param (ref eq)) (result (ref eq))))
(import "domain" "caml_domain_latest_id"
(global $caml_domain_latest_id (mut i32)))

;; XXX wrong, adapt for 5.2
(func (export "caml_runtime_events_user_write")
(param (ref eq)) (param (ref eq)) (result (ref eq))
(ref.i31 (i32.const 0)))

(func (export "caml_domain_spawn")
(param $f (ref eq)) (param $mutex (ref eq)) (result (ref eq))
(local $id i32) (local $old i32)
(local.set $id (global.get $caml_domain_latest_id))
(global.set $caml_domain_latest_id
(i32.add (local.get $id) (i32.const 1)))
(local.set $old (global.get $caml_domain_id))
(drop (call $caml_callback_1 (local.get $f) (ref.i31 (i32.const 0))))
(global.set $caml_domain_id (local.get $old))
(drop (call $caml_ml_mutex_unlock (local.get $mutex)))
(ref.i31 (local.get $id)))
)
4 changes: 0 additions & 4 deletions runtime/wasm/runtime_events.wat
Original file line number Diff line number Diff line change
Expand Up @@ -33,10 +33,6 @@
(local.get $evtag)
(local.get $evtype)))

(func (export "caml_runtime_events_user_write")
(param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
(ref.i31 (i32.const 0)))

(func (export "caml_runtime_events_user_resolve")
(param (ref eq)) (param (ref eq)) (param (ref eq)) (result (ref eq))
(ref.i31 (i32.const 0)))
Expand Down

0 comments on commit 0ea7916

Please sign in to comment.