aboutsummaryrefslogtreecommitdiffhomepage
path: root/kernel/nativelib.ml
diff options
context:
space:
mode:
authorGravatar Pierre Boutillier <pierre.boutillier@ens-lyon.org>2015-06-22 11:49:58 +0200
committerGravatar Pierre Boutillier <pierre.boutillier@ens-lyon.org>2015-06-22 11:49:58 +0200
commit6bec099f8487b9d3ec5c44079cf69d3474c73b91 (patch)
treeb23d8983fa887cc7e7255df455c64d5d54130787 /kernel/nativelib.ml
parent07e8eede6670a256a81d9d70133ebbeb64f45fe3 (diff)
parent949d027ce8fa94b5c62f938b58c3f85d015b177b (diff)
Merge remote-tracking branch 'forge/v8.5'
Diffstat (limited to 'kernel/nativelib.ml')
-rw-r--r--kernel/nativelib.ml21
1 files changed, 11 insertions, 10 deletions
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 4be8ced54..ce9e4e2b0 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -102,22 +102,23 @@ let compile_library dir code fn =
r
(* call_linker links dynamically the code for constants in environment or a *)
-(* conversion test. Silently fails if the file does not exist in bytecode *)
-(* mode, since the standard library is not compiled to bytecode with default *)
-(* settings. *)
+(* conversion test. *)
let call_linker ?(fatal=true) prefix f upds =
rt1 := dummy_value ();
rt2 := dummy_value ();
- if Dynlink.is_native || Sys.file_exists f then
+ if not (Sys.file_exists f) then
+ let msg = "Cannot find native compiler file " ^ f in
+ if fatal then Errors.error msg
+ else Pp.msg_warning (Pp.str msg)
+ else
(try
if Dynlink.is_native then Dynlink.loadfile f else !load_obj f;
register_native_file prefix
- with | Dynlink.Error e ->
- let msg = "Dynlink error, " ^ Dynlink.error_message e in
- if fatal then anomaly (Pp.str msg) else Pp.msg_warning (Pp.str msg)
- | e when Errors.noncritical e ->
- if fatal then anomaly (Errors.print e)
- else Pp.msg_warning (Errors.print_no_report e));
+ with Dynlink.Error e as exn ->
+ let exn = Errors.push exn in
+ let msg = "Dynlink error, " ^ Dynlink.error_message e in
+ if fatal then (Pp.msg_error (Pp.str msg); iraise exn)
+ else Pp.msg_warning (Pp.str msg));
match upds with Some upds -> update_locations upds | _ -> ()
let link_library ~prefix ~dirname ~basename =