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