1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
|
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* Mark Shinwell and Leo White, Jane Street Europe *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. *)
(* Copyright 2017--2018 Jane Street Group LLC *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)
(** Types shared amongst the various parts of the dynlink code. *)
type implem_state =
| Loaded
| Not_initialized
| Check_inited of int
type filename = string
type linking_error =
| Undefined_global of string
| Unavailable_primitive of string
| Uninitialized_global of string
type error =
| Not_a_bytecode_file of string
| Inconsistent_import of string
| Unavailable_unit of string
| Unsafe_file
| Linking_error of string * linking_error
| Corrupted_interface of string
| Cannot_open_dynamic_library of exn
| Library's_module_initializers_failed of exn
| Inconsistent_implementation of string
| Module_already_loaded of string
| Private_library_cannot_implement_interface of string
exception Error of error
let error_message = function
| Not_a_bytecode_file name ->
name ^ " is not an object file"
| Inconsistent_import name ->
"interface mismatch on " ^ name
| Unavailable_unit name ->
"no implementation available for " ^ name
| Unsafe_file ->
"this object file uses unsafe features"
| Linking_error (name, Undefined_global s) ->
"error while linking " ^ name ^ ".\n" ^
"Reference to undefined global `" ^ s ^ "'"
| Linking_error (name, Unavailable_primitive s) ->
"error while linking " ^ name ^ ".\n" ^
"The external function `" ^ s ^ "' is not available"
| Linking_error (name, Uninitialized_global s) ->
"error while linking " ^ name ^ ".\n" ^
"The module `" ^ s ^ "' is not yet initialized"
| Corrupted_interface name ->
"corrupted interface file " ^ name
| Cannot_open_dynamic_library exn ->
"error loading shared library: " ^ (Printexc.to_string exn)
| Inconsistent_implementation name ->
"implementation mismatch on " ^ name
| Library's_module_initializers_failed exn ->
"execution of module initializers in the shared library failed: "
^ (Printexc.to_string exn)
| Module_already_loaded name ->
"The module `" ^ name ^ "' is already loaded \
(either by the main program or a previously-dynlinked library)"
| Private_library_cannot_implement_interface name ->
"The interface `" ^ name ^ "' cannot be implemented by a \
library loaded privately"
let () =
Printexc.register_printer (function
| Error err ->
let msg = match err with
| Not_a_bytecode_file s -> Printf.sprintf "Not_a_bytecode_file %S" s
| Inconsistent_import s -> Printf.sprintf "Inconsistent_import %S" s
| Unavailable_unit s -> Printf.sprintf "Unavailable_unit %S" s
| Unsafe_file -> "Unsafe_file"
| Linking_error (s, Undefined_global s') ->
Printf.sprintf "Linking_error (%S, Dynlink.Undefined_global %S)"
s s'
| Linking_error (s, Unavailable_primitive s') ->
Printf.sprintf "Linking_error (%S, Dynlink.Unavailable_primitive %S)"
s s'
| Linking_error (s, Uninitialized_global s') ->
Printf.sprintf "Linking_error (%S, Dynlink.Uninitialized_global %S)"
s s'
| Corrupted_interface s ->
Printf.sprintf "Corrupted_interface %S" s
| Cannot_open_dynamic_library 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 ->
Printf.sprintf "Library's_module_initializers_failed %S"
(Printexc.to_string exn)
| Module_already_loaded name ->
Printf.sprintf "Module_already_loaded %S" name
| Private_library_cannot_implement_interface name ->
Printf.sprintf "Private_library_cannot_implement_interface %S" name
in
Some (Printf.sprintf "Dynlink.Error (Dynlink.%s)" msg)
| _ -> None)
|
