Skip to content

Commit 709e762

Browse files
tdelvecchio-jsctdelvecchio-jsc
authored
Portabilize Stdlib (ocaml-flambda#3393)
* Enable illegal mode crossing. Signed-off-by: Thomas Del Vecchio <[email protected]> * Portablize stdlib.mli Signed-off-by: Thomas Del Vecchio <[email protected]> * (simple) Either, Sys, Obj, Type Signed-off-by: Thomas Del Vecchio <[email protected]> * Make Atomic.Safe. Signed-off-by: Thomas Del Vecchio <[email protected]> * Bool, Lazy, Char, Int, List, Option, Result, Seq, Uchar Signed-off-by: Thomas Del Vecchio <[email protected]> * Bytes; requires magic for cocontended. Signed-off-by: Thomas Del Vecchio <[email protected]> * Array, Float, Ints, Lexing, Marshall, String, Unit Signed-off-by: Thomas Del Vecchio <[email protected]> * Map and Set portable Make functors Signed-off-by: Thomas Del Vecchio <[email protected]> * Buffer, camlinternalFormat, Dynarray, Printf, Queue, Stack Signed-off-by: Thomas Del Vecchio <[email protected]> * Make Printexc.Safe Signed-off-by: Thomas Del Vecchio <[email protected]> * Fun Signed-off-by: Thomas Del Vecchio <[email protected]> * Gc Signed-off-by: Thomas Del Vecchio <[email protected]> * Bigarray, Condition, Digest, In_channel, Mutex, Out_channel, Semaphore Signed-off-by: Thomas Del Vecchio <[email protected]> * Modes Signed-off-by: Thomas Del Vecchio <[email protected]> * Domain Signed-off-by: Thomas Del Vecchio <[email protected]> * Random Signed-off-by: Thomas Del Vecchio <[email protected]> * Filename Signed-off-by: Thomas Del Vecchio <[email protected]> * Hashtbl Signed-off-by: Thomas Del Vecchio <[email protected]> * Weak Signed-off-by: Thomas Del Vecchio <[email protected]> * Format Signed-off-by: Thomas Del Vecchio <[email protected]> * Scanf and also update to Typemod Signed-off-by: Thomas Del Vecchio <[email protected]> * Callback. Signed-off-by: Thomas Del Vecchio <[email protected]> * CamlinternalOO Signed-off-by: Thomas Del Vecchio <[email protected]> * CamlinternalMod Signed-off-by: Thomas Del Vecchio <[email protected]> * Ephemeron Signed-off-by: Thomas Del Vecchio <[email protected]> * Complex, camlinternalComprehension, and *Labels Signed-off-by: Thomas Del Vecchio <[email protected]> * Miscellaneous addressing of crs Signed-off-by: Thomas Del Vecchio <[email protected]> * Update some crs. Signed-off-by: Thomas Del Vecchio <[email protected]> * Additional documentation for Modes. Signed-off-by: Thomas Del Vecchio <[email protected]> * Update CR Signed-off-by: Thomas Del Vecchio <[email protected]> * Rename 'unsafe' alert to 'unsafe_multidomain' Signed-off-by: Thomas Del Vecchio <[email protected]> * Fix tests and other build failures. Signed-off-by: Thomas Del Vecchio <[email protected]> * Add modes to dune Signed-off-by: Thomas Del Vecchio <[email protected]> * Update documentation. Signed-off-by: Thomas Del Vecchio <[email protected]> * Rearrange [Domain.Safe.DLS.new_key] Signed-off-by: Thomas Del Vecchio <[email protected]> * Simplify usages of nonportable [Domain.DLS.get] Signed-off-by: Thomas Del Vecchio <[email protected]> * Explicitly denote unsafe functions in [atomic.ml] Signed-off-by: Thomas Del Vecchio <[email protected]> * Fixups during review. Signed-off-by: Thomas Del Vecchio <[email protected]> * Wrap [Domain.Safe.DLS.access] exceptions. Signed-off-by: Thomas Del Vecchio <[email protected]> * Fixups during review Signed-off-by: Thomas Del Vecchio <[email protected]> * Fixups Signed-off-by: Thomas Del Vecchio <[email protected]> * Mark Sys.signal as unsafe Signed-off-by: Thomas Del Vecchio <[email protected]> * Tests fixups Signed-off-by: Thomas Del Vecchio <[email protected]> * Switch to new illegal crossing attribute. Signed-off-by: Thomas Del Vecchio <[email protected]> * Fix sys.ml.in Signed-off-by: Thomas Del Vecchio <[email protected]> * Portabilize [Gc.get] and [Gc.set]. Signed-off-by: Thomas Del Vecchio <[email protected]> * Allow [ignore] to take [contended] values. Signed-off-by: Thomas Del Vecchio <[email protected]> * fixup Signed-off-by: Thomas Del Vecchio <[email protected]> * Undo making [ignore] accept contended ['a]; it breaks too many things Signed-off-by: Thomas Del Vecchio <[email protected]> * Add [ignore_contended] Signed-off-by: Thomas Del Vecchio <[email protected]> * Fix tests. Signed-off-by: Thomas Del Vecchio <[email protected]> * Add cr to use layout void when available Signed-off-by: Thomas Del Vecchio <[email protected]> * Make [Domain.DLS.Access.t] cross externality. Signed-off-by: Thomas Del Vecchio <[email protected]> * Inline some functions. Signed-off-by: Thomas Del Vecchio <[email protected]> * Fixup after rebase Signed-off-by: Thomas Del Vecchio <[email protected]> * Fix tests after rebase. Signed-off-by: Thomas Del Vecchio <[email protected]> * Fix tests after rebase. Signed-off-by: Thomas Del Vecchio <[email protected]> --------- Signed-off-by: Thomas Del Vecchio <[email protected]>
1 parent 9e9e914 commit 709e762

File tree

225 files changed

+4282
-1635
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

225 files changed

+4282
-1635
lines changed

‎Makefile.common-jst

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@ define dune_boot_context
2121
(name default)
2222
(profile dev)
2323
(env (_
24-
(flags (:standard -warn-error +A))
24+
(flags (:standard -warn-error +A -alert -unsafe_multidomain))
2525
(env-vars ("OCAMLPARAM" ""))))))
2626
endef
2727

@@ -34,7 +34,7 @@ define dune_runtime_stdlib_context
3434
(PATH ("$(CURDIR)/_build/_bootinstall/bin" :standard))
3535
(OCAMLLIB ("$(CURDIR)/_build/_bootinstall/lib/ocaml")))
3636
(env (_
37-
(flags (:standard -warn-error +A))
37+
(flags (:standard -warn-error +A -alert -unsafe_multidomain))
3838
(env-vars ("OCAMLPARAM" "$(BUILD_OCAMLPARAM)"))))))
3939
endef
4040

@@ -47,7 +47,7 @@ define dune_main_context
4747
(PATH ("$(CURDIR)/_build/_bootinstall/bin" :standard))
4848
(OCAMLLIB ("$(CURDIR)/_build/runtime_stdlib_install/lib/ocaml_runtime_stdlib")))
4949
(env (_
50-
(flags (:standard -warn-error +A))
50+
(flags (:standard -warn-error +A -alert -unsafe_multidomain))
5151
(env-vars ("OCAMLPARAM" "$(BUILD_OCAMLPARAM)"))))))
5252
endef
5353

‎debugger/main.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -199,7 +199,7 @@ let report report_error error =
199199
Config.version report_error error
200200

201201
let main () =
202-
Callback.register "Debugger.function_placeholder" function_placeholder;
202+
Callback.Safe.register "Debugger.function_placeholder" function_placeholder;
203203
try
204204
socket_name :=
205205
(match Sys.os_type with

‎debugger4/main.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -199,7 +199,7 @@ let report report_error error =
199199
Config.version report_error error
200200

201201
let main () =
202-
Callback.register "Debugger.function_placeholder" function_placeholder;
202+
Callback.Safe.register "Debugger.function_placeholder" function_placeholder;
203203
try
204204
socket_name :=
205205
(match Sys.os_type with

‎otherlibs/dynlink/dynlink_types.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -83,7 +83,7 @@ let error_message = function
8383
privately (make a copy of the file to load it a second time)"
8484

8585
let () =
86-
Printexc.register_printer (function
86+
Printexc.Safe.register_printer (function
8787
| Error err ->
8888
let msg = match err with
8989
| Not_a_bytecode_file s -> Printf.sprintf "Not_a_bytecode_file %S" s

‎otherlibs/dynlink/native/dynlink.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -122,7 +122,7 @@ module Native = struct
122122

123123
exception Register_dyn_global_duplicate
124124
let () =
125-
Callback.register "Register_dyn_global_duplicate"
125+
Callback.Safe.register "Register_dyn_global_duplicate"
126126
Register_dyn_global_duplicate
127127

128128
let load ~filename ~priv =

‎otherlibs/runtime_events/runtime_events.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -267,7 +267,7 @@ module User = struct
267267
maximum number of threads that requested a buffer concurrently,
268268
and we never free those buffers. *)
269269
let create_buffer () = Bytes.create 1024 in
270-
let write_buffer_cache = Domain.DLS.new_key (fun () -> ref []) in
270+
let write_buffer_cache = Domain.Safe.DLS.new_key (fun () -> ref []) in
271271
let pop_or_create buffers =
272272
(* intended to be thread-safe *)
273273
(* begin atomic *)

‎otherlibs/str/str.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -607,7 +607,7 @@ external re_search_forward: regexp -> string -> int -> int array
607607
external re_search_backward: regexp -> string -> int -> int array
608608
= "re_search_backward"
609609

610-
let last_search_result_key = Domain.DLS.new_key (fun () -> [||])
610+
let last_search_result_key = Domain.Safe.DLS.new_key (fun () -> [||])
611611

612612
let string_match re s pos =
613613
let res = re_string_match re s pos in

‎otherlibs/systhreads/thread.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@
2222
type t
2323

2424
external thread_initialize : unit -> unit = "caml_thread_initialize"
25-
external thread_cleanup : unit -> unit = "caml_thread_cleanup"
25+
external thread_cleanup : unit -> unit @@ portable = "caml_thread_cleanup"
2626
external thread_new : (unit -> unit) -> t = "caml_thread_new"
2727
external thread_uncaught_exception : exn -> unit =
2828
"caml_thread_uncaught_exception"
@@ -80,7 +80,7 @@ let exit () =
8080
let () =
8181
thread_initialize ();
8282
(* Called back in [caml_shutdown], when the last domain exits. *)
83-
Callback.register "Thread.at_shutdown" thread_cleanup
83+
Callback.Safe.register "Thread.at_shutdown" thread_cleanup
8484

8585
(* Wait functions *)
8686

‎otherlibs/systhreads4/thread.ml

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,7 @@
2121
type t
2222

2323
external thread_initialize : unit -> unit = "caml_thread_initialize"
24-
external thread_cleanup : unit -> unit = "caml_thread_cleanup"
24+
external thread_cleanup : unit -> unit @@ portable = "caml_thread_cleanup"
2525
external thread_new : (unit -> unit) -> t = "caml_thread_new"
2626
external thread_uncaught_exception : exn -> unit =
2727
"caml_thread_uncaught_exception"
@@ -95,13 +95,13 @@ let preempt_signal =
9595
let () =
9696
Sys.set_signal preempt_signal (Sys.Signal_handle preempt);
9797
thread_initialize ();
98-
Callback.register "Thread.at_shutdown" (fun () ->
98+
Callback.Safe.register "Thread.at_shutdown" (fun () ->
9999
thread_cleanup();
100100
(* In case of DLL-embedded OCaml the preempt_signal handler
101101
will point to nowhere after DLL unloading and an accidental
102102
preempt_signal will crash the main program. So restore the
103103
default handler. *)
104-
Sys.set_signal preempt_signal Sys.Signal_default
104+
Sys.Safe.set_signal preempt_signal Sys.Signal_default
105105
)
106106

107107
(* Wait functions *)

‎otherlibs/unix/unix_unix.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -93,13 +93,13 @@ type error =
9393

9494
exception Unix_error of error * string * string
9595

96-
let _ = Callback.register_exception "Unix.Unix_error"
96+
let _ = Callback.Safe.register_exception "Unix.Unix_error"
9797
(Unix_error(E2BIG, "", ""))
9898

9999
external error_message : error -> string = "caml_unix_error_message"
100100

101101
let () =
102-
Printexc.register_printer
102+
Printexc.Safe.register_printer
103103
(function
104104
| Unix_error (e, s, s') ->
105105
let msg = match e with

‎otherlibs/unix/unix_win32.ml

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -98,13 +98,13 @@ type error =
9898

9999
exception Unix_error of error * string * string
100100

101-
let _ = Callback.register_exception "Unix.Unix_error"
101+
let _ = Callback.Safe.register_exception "Unix.Unix_error"
102102
(Unix_error(E2BIG, "", ""))
103103

104104
external error_message : error -> string = "caml_unix_error_message"
105105

106106
let () =
107-
Printexc.register_printer
107+
Printexc.Safe.register_printer
108108
(function
109109
| Unix_error (e, s, s') ->
110110
let msg = match e with

‎stdlib/StdlibModules

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -81,6 +81,7 @@ STDLIB_MODULE_BASENAMES = \
8181
mutex \
8282
condition \
8383
semaphore \
84+
modes \
8485
domain \
8586
bigarray \
8687
random \

‎stdlib/array.ml

Lines changed: 19 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -23,29 +23,29 @@ type 'a t = 'a array
2323

2424
(* Array operations *)
2525

26-
external length : 'a array -> int = "%array_length"
27-
external get: 'a array -> int -> 'a = "%array_safe_get"
28-
external set: 'a array -> int -> 'a -> unit = "%array_safe_set"
29-
external unsafe_get: 'a array -> int -> 'a = "%array_unsafe_get"
30-
external unsafe_set: 'a array -> int -> 'a -> unit = "%array_unsafe_set"
31-
external make: int -> 'a -> 'a array = "caml_make_vect"
32-
external create: int -> 'a -> 'a array = "caml_make_vect"
33-
external unsafe_sub : 'a array -> int -> int -> 'a array = "caml_array_sub"
34-
external append_prim : 'a array -> 'a array -> 'a array = "caml_array_append"
35-
external concat : 'a array list -> 'a array = "caml_array_concat"
26+
external length : 'a array -> int @@ portable = "%array_length"
27+
external get: 'a array -> int -> 'a @@ portable = "%array_safe_get"
28+
external set: 'a array -> int -> 'a -> unit @@ portable = "%array_safe_set"
29+
external unsafe_get: 'a array -> int -> 'a @@ portable = "%array_unsafe_get"
30+
external unsafe_set: 'a array -> int -> 'a -> unit @@ portable = "%array_unsafe_set"
31+
external make: int -> 'a -> 'a array @@ portable = "caml_make_vect"
32+
external create: int -> 'a -> 'a array @@ portable = "caml_make_vect"
33+
external unsafe_sub : 'a array -> int -> int -> 'a array @@ portable = "caml_array_sub"
34+
external append_prim : 'a array -> 'a array -> 'a array @@ portable = "caml_array_append"
35+
external concat : 'a array list -> 'a array @@ portable = "caml_array_concat"
3636
external unsafe_blit :
37-
'a array -> int -> 'a array -> int -> int -> unit = "caml_array_blit"
37+
'a array -> int -> 'a array -> int -> int -> unit @@ portable = "caml_array_blit"
3838
external unsafe_fill :
39-
'a array -> int -> int -> 'a -> unit = "caml_array_fill"
40-
external create_float: int -> float array = "caml_make_float_vect"
39+
'a array -> int -> int -> 'a -> unit @@ portable = "caml_array_fill"
40+
external create_float: int -> float array @@ portable = "caml_make_float_vect"
4141

4242
module Floatarray = struct
43-
external create : int -> floatarray = "caml_floatarray_create"
44-
external length : floatarray -> int = "%floatarray_length"
45-
external get : floatarray -> int -> float = "%floatarray_safe_get"
46-
external set : floatarray -> int -> float -> unit = "%floatarray_safe_set"
47-
external unsafe_get : floatarray -> int -> float = "%floatarray_unsafe_get"
48-
external unsafe_set : floatarray -> int -> float -> unit
43+
external create : int -> floatarray @@ portable = "caml_floatarray_create"
44+
external length : floatarray -> int @@ portable = "%floatarray_length"
45+
external get : floatarray -> int -> float @@ portable = "%floatarray_safe_get"
46+
external set : floatarray -> int -> float -> unit @@ portable = "%floatarray_safe_set"
47+
external unsafe_get : floatarray -> int -> float @@ portable = "%floatarray_unsafe_get"
48+
external unsafe_set : floatarray -> int -> float -> unit @@ portable
4949
= "%floatarray_unsafe_set"
5050
end
5151

‎stdlib/array.mli

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,8 @@
1414
(* *)
1515
(**************************************************************************)
1616

17+
@@ portable
18+
1719
open! Stdlib
1820

1921
(* NOTE:

‎stdlib/arrayLabels.mli

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,8 @@
1414
(* *)
1515
(**************************************************************************)
1616

17+
@@ portable
18+
1719
open! Stdlib
1820

1921
(* NOTE:

‎stdlib/atomic.ml

Lines changed: 29 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -12,21 +12,36 @@
1212
(* *)
1313
(**************************************************************************)
1414

15-
type !'a t
15+
type !'a t : value mod portable uncontended
1616

17-
external make : 'a -> 'a t = "%makemutable"
18-
external make_contended : 'a -> 'a t = "caml_atomic_make_contended"
19-
external get : 'a t -> 'a = "%atomic_load"
20-
external set : 'a t -> 'a -> unit = "%atomic_set"
21-
external exchange : 'a t -> 'a -> 'a = "%atomic_exchange"
22-
external compare_and_set : 'a t -> 'a -> 'a -> bool = "%atomic_cas"
23-
external compare_exchange : 'a t -> 'a -> 'a -> 'a = "%atomic_compare_exchange"
24-
external fetch_and_add : int t -> int -> int = "%atomic_fetch_add"
25-
external add : int t -> int -> unit = "%atomic_add"
26-
external sub : int t -> int -> unit = "%atomic_sub"
27-
external logand : int t -> int -> unit = "%atomic_land"
28-
external logor : int t -> int -> unit = "%atomic_lor"
29-
external logxor : int t -> int -> unit = "%atomic_lxor"
17+
module Unsafe = struct
18+
external make : 'a -> 'a t = "%makemutable"
19+
external make_contended : 'a -> 'a t = "caml_atomic_make_contended"
20+
external get : 'a t -> 'a = "%atomic_load"
21+
external set : 'a t -> 'a -> unit = "%atomic_set"
22+
external exchange : 'a t -> 'a -> 'a = "%atomic_exchange"
23+
external compare_and_set : 'a t -> 'a -> 'a -> bool = "%atomic_cas"
24+
external compare_exchange : 'a t -> 'a -> 'a -> 'a = "%atomic_compare_exchange"
25+
end
26+
27+
external fetch_and_add : int t -> int -> int @@ portable = "%atomic_fetch_add"
28+
external add : int t -> int -> unit @@ portable = "%atomic_add"
29+
external sub : int t -> int -> unit @@ portable = "%atomic_sub"
30+
external logand : int t -> int -> unit @@ portable = "%atomic_land"
31+
external logor : int t -> int -> unit @@ portable = "%atomic_lor"
32+
external logxor : int t -> int -> unit @@ portable = "%atomic_lxor"
3033

3134
let incr r = add r 1
3235
let decr r = sub r 1
36+
37+
module Safe = struct
38+
external make : 'a @ portable contended -> 'a t @@ portable = "%makemutable"
39+
external make_contended : 'a @ portable contended -> 'a t @@ portable = "caml_atomic_make_contended"
40+
external get : 'a t -> 'a @ portable contended @@ portable = "%atomic_load"
41+
external set : 'a t -> 'a @ portable contended -> unit @@ portable = "%atomic_set"
42+
external exchange : 'a t -> 'a @ portable contended -> 'a @ portable contended @@ portable = "%atomic_exchange"
43+
external compare_and_set : 'a t -> 'a @ portable contended -> 'a @ portable contended -> bool @@ portable = "%atomic_cas"
44+
external compare_exchange : 'a t -> 'a @ portable contended -> 'a @ portable contended -> 'a @ portable contended @@ portable = "%atomic_compare_exchange"
45+
end
46+
47+
include Unsafe

0 commit comments

Comments
 (0)