summaryrefslogtreecommitdiff
path: root/otherlibs
diff options
context:
space:
mode:
Diffstat (limited to 'otherlibs')
-rw-r--r--otherlibs/dynlink/byte/dynlink.ml29
-rw-r--r--otherlibs/dynlink/dynlink_common.ml43
-rw-r--r--otherlibs/dynlink/dynlink_types.ml2
-rw-r--r--otherlibs/dynlink/native/dynlink.ml6
-rw-r--r--otherlibs/runtime_events/runtime_events_consumer.c12
-rw-r--r--otherlibs/systhreads/st_pthreads.h10
-rw-r--r--otherlibs/systhreads/st_stubs.c4
-rw-r--r--otherlibs/unix/symlink_win32.c7
-rw-r--r--otherlibs/unix/unix.mli2
-rw-r--r--otherlibs/unix/unixLabels.mli2
-rw-r--r--otherlibs/unix/unixsupport_unix.c5
-rw-r--r--otherlibs/unix/unixsupport_win32.c5
12 files changed, 67 insertions, 60 deletions
diff --git a/otherlibs/dynlink/byte/dynlink.ml b/otherlibs/dynlink/byte/dynlink.ml
index 2a520596a3..6a6ae1a907 100644
--- a/otherlibs/dynlink/byte/dynlink.ml
+++ b/otherlibs/dynlink/byte/dynlink.ml
@@ -151,10 +151,13 @@ module Bytecode = struct
(Printexc.get_raw_backtrace ())
let load ~filename:file_name ~priv:_ =
- let ic = open_in_bin file_name in
- let file_digest = Digest.channel ic (-1) in
- seek_in ic 0;
+ let ic =
+ try open_in_bin file_name
+ with exc -> raise (DT.Error (Cannot_open_dynamic_library exc))
+ in
try
+ let file_digest = Digest.channel ic (-1) in
+ seek_in ic 0;
let buffer =
try really_input_string ic (String.length Config.cmo_magic_number)
with End_of_file -> raise (DT.Error (Not_a_bytecode_file file_name))
@@ -170,19 +173,23 @@ module Bytecode = struct
let toc_pos = input_binary_int ic in (* Go to table of contents *)
seek_in ic toc_pos;
let lib = (input_value ic : Cmo_format.library) in
- begin try
- Dll.open_dlls Dll.For_execution
- (List.map Dll.extract_dll_name lib.lib_dllibs)
- with exn ->
- raise (DT.Error (Cannot_open_dynamic_library exn))
- end;
+ Dll.open_dlls Dll.For_execution
+ (List.map Dll.extract_dll_name lib.lib_dllibs);
handle, lib.lib_units
end else begin
raise (DT.Error (Not_a_bytecode_file file_name))
end
- with exc ->
- close_in ic;
+ with
+ (* Wrap all exceptions into Cannot_open_dynamic_library errors except
+ Not_a_bytecode_file ones, as they bring all the necessary information
+ already
+ Use close_in_noerr since the exception we really want to raise is exc *)
+ | DT.Error _ as exc ->
+ close_in_noerr ic;
raise exc
+ | exc ->
+ close_in_noerr ic;
+ raise (DT.Error (Cannot_open_dynamic_library exc))
let unsafe_get_global_value ~bytecode_or_asm_symbol =
let id = Ident.create_persistent bytecode_or_asm_symbol in
diff --git a/otherlibs/dynlink/dynlink_common.ml b/otherlibs/dynlink/dynlink_common.ml
index 6f4d8c0b4b..72e9e67303 100644
--- a/otherlibs/dynlink/dynlink_common.ml
+++ b/otherlibs/dynlink/dynlink_common.ml
@@ -346,30 +346,25 @@ module Make (P : Dynlink_platform_intf.S) = struct
let load priv filename =
init ();
let filename = dll_filename filename in
- match P.load ~filename ~priv with
- | exception exn -> raise (DT.Error (Cannot_open_dynamic_library exn))
- | handle, units ->
- try
- with_lock (fun ({unsafe_allowed; _ } as global) ->
- global.state <- check filename units global.state
- ~unsafe_allowed
- ~priv;
- P.run_shared_startup handle;
- );
- List.iter
- (fun unit_header ->
- (* Linked modules might call Dynlink themselves,
- we need to release the lock *)
- P.run Global.lock handle ~unit_header ~priv;
- if not priv then with_lock (fun global ->
- global.state <- set_loaded filename unit_header global.state
- )
- )
- units;
- P.finish handle
- with exn ->
- P.finish handle;
- raise exn
+ let handle, units = P.load ~filename ~priv in
+ Fun.protect ~finally:(fun () -> P.finish handle) (fun () ->
+ with_lock (fun ({unsafe_allowed; _ } as global) ->
+ global.state <- check filename units global.state
+ ~unsafe_allowed
+ ~priv;
+ P.run_shared_startup handle;
+ );
+ List.iter
+ (fun unit_header ->
+ (* Linked modules might call Dynlink themselves,
+ we need to release the lock *)
+ P.run Global.lock handle ~unit_header ~priv;
+ if not priv then with_lock (fun global ->
+ global.state <- set_loaded filename unit_header global.state
+ )
+ )
+ units
+ )
let loadfile filename = load false filename
let loadfile_private filename = load true filename
diff --git a/otherlibs/dynlink/dynlink_types.ml b/otherlibs/dynlink/dynlink_types.ml
index ebfd2d1cde..90e905dacd 100644
--- a/otherlibs/dynlink/dynlink_types.ml
+++ b/otherlibs/dynlink/dynlink_types.ml
@@ -101,7 +101,7 @@ let () =
| Corrupted_interface s ->
Printf.sprintf "Corrupted_interface %S" s
| Cannot_open_dynamic_library exn ->
- Printf.sprintf "Cannot_open_dll %S" (Printexc.to_string exn)
+ Printf.sprintf "Cannot_open_dll %s" (Printexc.to_string exn)
| Inconsistent_implementation s ->
Printf.sprintf "Inconsistent_implementation %S" s
| Library's_module_initializers_failed exn ->
diff --git a/otherlibs/dynlink/native/dynlink.ml b/otherlibs/dynlink/native/dynlink.ml
index 7a46a07ee3..39f71522fa 100644
--- a/otherlibs/dynlink/native/dynlink.ml
+++ b/otherlibs/dynlink/native/dynlink.ml
@@ -102,8 +102,10 @@ module Native = struct
"_shared_startup" ::
List.concat_map Unit_header.defined_symbols header.dynu_units
in
- ndl_register handle (Array.of_list syms);
- handle, header.dynu_units
+ try
+ ndl_register handle (Array.of_list syms);
+ handle, header.dynu_units
+ with exn -> raise (DT.Error (Cannot_open_dynamic_library exn))
let unsafe_get_global_value ~bytecode_or_asm_symbol =
match ndl_loadsym bytecode_or_asm_symbol with
diff --git a/otherlibs/runtime_events/runtime_events_consumer.c b/otherlibs/runtime_events/runtime_events_consumer.c
index 1f546f4c52..1e5f229fd1 100644
--- a/otherlibs/runtime_events/runtime_events_consumer.c
+++ b/otherlibs/runtime_events/runtime_events_consumer.c
@@ -23,6 +23,7 @@
#include "caml/misc.h"
#include "caml/mlvalues.h"
#include "caml/osdeps.h"
+#include "caml/platform.h"
#include <fcntl.h>
#include <stdatomic.h>
@@ -391,10 +392,8 @@ caml_runtime_events_read_poll(struct caml_runtime_events_cursor *cursor,
do {
uint64_t buf[RUNTIME_EVENTS_MAX_MSG_LENGTH];
uint64_t ring_mask, header, msg_length;
- ring_head = atomic_load_explicit(&runtime_events_buffer_header->ring_head,
- memory_order_acquire);
- ring_tail = atomic_load_explicit(&runtime_events_buffer_header->ring_tail,
- memory_order_acquire);
+ ring_head = atomic_load_acquire(&runtime_events_buffer_header->ring_head);
+ ring_tail = atomic_load_acquire(&runtime_events_buffer_header->ring_tail);
if (ring_head > cursor->current_positions[domain_num]) {
if (cursor->lost_events) {
@@ -427,8 +426,7 @@ caml_runtime_events_read_poll(struct caml_runtime_events_cursor *cursor,
atomic_thread_fence(memory_order_seq_cst);
- ring_head = atomic_load_explicit(&runtime_events_buffer_header->ring_head,
- memory_order_acquire);
+ ring_head = atomic_load_acquire(&runtime_events_buffer_header->ring_head);
/* Check the message we've read hasn't been overwritten by the writer */
if (ring_head > cursor->current_positions[domain_num]) {
@@ -1219,5 +1217,5 @@ CAMLprim value caml_ml_runtime_events_read_poll(value wrapper,
}
}
- CAMLreturn(Int_val(events_consumed));
+ CAMLreturn(Val_int(events_consumed));
};
diff --git a/otherlibs/systhreads/st_pthreads.h b/otherlibs/systhreads/st_pthreads.h
index 5d29df67d1..bd8839b6de 100644
--- a/otherlibs/systhreads/st_pthreads.h
+++ b/otherlibs/systhreads/st_pthreads.h
@@ -37,7 +37,7 @@ static atomic_uintnat tick_thread_stop[Max_domains];
static int st_initialize(void)
{
- atomic_store_rel(&Tick_thread_stop, 0);
+ atomic_store_release(&Tick_thread_stop, 0);
return 0;
}
@@ -112,14 +112,14 @@ static void st_masterlock_init(st_masterlock * m)
m->init = 1;
}
m->busy = 1;
- atomic_store_rel(&m->waiters, 0);
+ atomic_store_release(&m->waiters, 0);
return;
};
static uintnat st_masterlock_waiters(st_masterlock * m)
{
- return atomic_load_acq(&m->waiters);
+ return atomic_load_acquire(&m->waiters);
}
static void st_bt_lock_acquire(st_masterlock *m) {
@@ -295,10 +295,10 @@ static void * caml_thread_tick(void * arg)
caml_init_domain_self(*domain_id);
caml_domain_state *domain = Caml_state;
- while(! atomic_load_acq(&Tick_thread_stop)) {
+ while(! atomic_load_acquire(&Tick_thread_stop)) {
st_msleep(Thread_timeout);
- atomic_store_rel(&domain->requested_external_interrupt, 1);
+ atomic_store_release(&domain->requested_external_interrupt, 1);
caml_interrupt_self();
}
return NULL;
diff --git a/otherlibs/systhreads/st_stubs.c b/otherlibs/systhreads/st_stubs.c
index 389a343b2d..09d56120a7 100644
--- a/otherlibs/systhreads/st_stubs.c
+++ b/otherlibs/systhreads/st_stubs.c
@@ -488,9 +488,9 @@ CAMLprim value caml_thread_initialize(value unit)
CAMLprim value caml_thread_cleanup(value unit)
{
if (Tick_thread_running){
- atomic_store_rel(&Tick_thread_stop, 1);
+ atomic_store_release(&Tick_thread_stop, 1);
st_thread_join(Tick_thread_id);
- atomic_store_rel(&Tick_thread_stop, 0);
+ atomic_store_release(&Tick_thread_stop, 0);
Tick_thread_running = 0;
}
diff --git a/otherlibs/unix/symlink_win32.c b/otherlibs/unix/symlink_win32.c
index 3a1d6a1b8b..aac6545b31 100644
--- a/otherlibs/unix/symlink_win32.c
+++ b/otherlibs/unix/symlink_win32.c
@@ -26,6 +26,7 @@
#include <caml/fail.h>
#include <caml/signals.h>
#include <caml/osdeps.h>
+#include <caml/platform.h>
#include "unixsupport.h"
#ifndef SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE
@@ -78,13 +79,11 @@ CAMLprim value caml_unix_symlink(value to_dir, value osource, value odest)
caml_unix_check_path(osource, "symlink");
caml_unix_check_path(odest, "symlink");
- additional_flags = atomic_load_explicit(&additional_symlink_flags,
- memory_order_relaxed);
+ additional_flags = atomic_load_relaxed(&additional_symlink_flags);
if (additional_flags == -1) {
additional_flags = IsDeveloperModeEnabled() ?
SYMBOLIC_LINK_FLAG_ALLOW_UNPRIVILEGED_CREATE : 0;
- atomic_store_explicit(&additional_symlink_flags, additional_flags,
- memory_order_relaxed);
+ atomic_store_relaxed(&additional_symlink_flags, additional_flags);
}
flags =
diff --git a/otherlibs/unix/unix.mli b/otherlibs/unix/unix.mli
index 3cdb1c701a..e416d5c53b 100644
--- a/otherlibs/unix/unix.mli
+++ b/otherlibs/unix/unix.mli
@@ -921,7 +921,7 @@ val open_process_full :
val open_process_args : string -> string array -> in_channel * out_channel
(** [open_process_args prog args] runs the program [prog] with arguments
[args]. Note that the first argument is by convention the filename of
- the program being executed, just like {!Sys.argv.(0)}. The new process
+ the program being executed, just like [Sys.argv.(0)]. The new process
executes concurrently with the current process. The standard input and
output of the new process are redirected to pipes, which can be
respectively read and written via the returned channels. The input
diff --git a/otherlibs/unix/unixLabels.mli b/otherlibs/unix/unixLabels.mli
index a92ffc56e0..3ad2c778ce 100644
--- a/otherlibs/unix/unixLabels.mli
+++ b/otherlibs/unix/unixLabels.mli
@@ -921,7 +921,7 @@ val open_process_full :
val open_process_args : string -> string array -> in_channel * out_channel
(** [open_process_args prog args] runs the program [prog] with arguments
[args]. Note that the first argument is by convention the filename of
- the program being executed, just like {!Sys.argv.(0)}. The new process
+ the program being executed, just like [Sys.argv.(0)]. The new process
executes concurrently with the current process. The standard input and
output of the new process are redirected to pipes, which can be
respectively read and written via the returned channels. The input
diff --git a/otherlibs/unix/unixsupport_unix.c b/otherlibs/unix/unixsupport_unix.c
index 4a206072a0..449af8b5c2 100644
--- a/otherlibs/unix/unixsupport_unix.c
+++ b/otherlibs/unix/unixsupport_unix.c
@@ -13,11 +13,14 @@
/* */
/**************************************************************************/
+#define CAML_INTERNALS
+
#include <caml/mlvalues.h>
#include <caml/alloc.h>
#include <caml/callback.h>
#include <caml/memory.h>
#include <caml/fail.h>
+#include <caml/platform.h>
#include "unixsupport.h"
#include "cst2constr.h"
#include <errno.h>
@@ -293,7 +296,7 @@ void caml_unix_error(int errcode, const char *cmdname, value cmdarg)
value res;
const value * exn;
- exn = atomic_load_explicit(&caml_unix_error_exn, memory_order_acquire);
+ exn = atomic_load_acquire(&caml_unix_error_exn);
if (exn == NULL) {
exn = caml_named_value("Unix.Unix_error");
if (exn == NULL)
diff --git a/otherlibs/unix/unixsupport_win32.c b/otherlibs/unix/unixsupport_win32.c
index f9e85a4586..cb5eb35df7 100644
--- a/otherlibs/unix/unixsupport_win32.c
+++ b/otherlibs/unix/unixsupport_win32.c
@@ -13,6 +13,8 @@
/* */
/**************************************************************************/
+#define CAML_INTERNALS
+
#include <stddef.h>
#include <caml/mlvalues.h>
#include <caml/callback.h>
@@ -20,6 +22,7 @@
#include <caml/memory.h>
#include <caml/fail.h>
#include <caml/custom.h>
+#include <caml/platform.h>
#include "unixsupport.h"
#include "cst2constr.h"
#include <errno.h>
@@ -297,7 +300,7 @@ void caml_unix_error(int errcode, const char *cmdname, value cmdarg)
value res;
const value * exn;
- exn = atomic_load_explicit(&caml_unix_error_exn, memory_order_acquire);
+ exn = atomic_load_acquire(&caml_unix_error_exn);
if (exn == NULL) {
exn = caml_named_value("Unix.Unix_error");
if (exn == NULL)
View Lorry Controller Status