1 (**************************************************************************)
2 (* *)
3 (* OCaml *)
4 (* *)
5 (* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
6 (* *)
7 (* Copyright 2001 Institut National de Recherche en Informatique et *)
8 (* en Automatique. *)
9 (* *)
10 (* All rights reserved. This file is distributed under the terms of *)
11 (* the GNU Lesser General Public License version 2.1, with the *)
12 (* special exception on linking described in the file LICENSE. *)
13 (* *)
14 (**************************************************************************)
15
16 (* Handling of dynamically-linked libraries *)
17
18 type dll_handle
19 type dll_address
20 type dll_mode = For_checking | For_execution
21
22 external dll_open: dll_mode -> string -> dll_handle = "caml_dynlink_open_lib"
23 external dll_close: dll_handle -> unit = "caml_dynlink_close_lib"
24 external dll_sym: dll_handle -> string -> dll_address
25 = "caml_dynlink_lookup_symbol"
26 (* returned dll_address may be Val_unit *)
27 external add_primitive: dll_address -> int = "caml_dynlink_add_primitive"
28 external get_current_dlls: unit -> dll_handle array
29 = "caml_dynlink_get_current_libs"
30
31 (* Current search path for DLLs *)
32 let search_path = ref ([] : string list)
33
34 (* DLLs currently opened *)
35 let opened_dlls = ref ([] : dll_handle list)
36
37 (* File names for those DLLs *)
38 let names_of_opened_dlls = ref ([] : string list)
39
40 (* Add the given directories to the search path for DLLs. *)
41 let add_path dirs =
42 search_path := dirs @ !search_path
43
44 let remove_path dirs =
45 search_path := List.filter (fun d -> not (List.mem d dirs)) !search_path
46
47 (* Extract the name of a DLLs from its external name (xxx.so or -lxxx) *)
48
49 let extract_dll_name file =
50 if Filename.check_suffix file Config.ext_dll then
51 Filename.chop_suffix file Config.ext_dll
52 else if String.length file >= 2 && String.sub file 0 2 = "-l" then
53 "dll" ^ String.sub file 2 (String.length file - 2)
54 else
55 file (* will cause error later *)
56
57 (* Open a list of DLLs, adding them to opened_dlls.
58 Raise [Failure msg] in case of error. *)
59
60 let open_dll mode name =
61 let name = name ^ Config.ext_dll in
62 let fullname =
63 try
64 let fullname = Misc.find_in_path !search_path name in
65 if Filename.is_implicit fullname then
66 Filename.concat Filename.current_dir_name fullname
67 else fullname
68 with Not_found -> name in
69 if not (List.mem fullname !names_of_opened_dlls) then begin
70 try
71 let dll = dll_open mode fullname in
72 names_of_opened_dlls := fullname :: !names_of_opened_dlls;
73 opened_dlls := dll :: !opened_dlls
74 with Failure msg ->
75 failwith (fullname ^ ": " ^ msg)
76 end
77
78 let open_dlls mode names =
79 List.iter (open_dll mode) names
80
81 (* Close all DLLs *)
82
83 let close_all_dlls () =
84 List.iter dll_close !opened_dlls;
85 opened_dlls := [];
86 names_of_opened_dlls := []
87
88 (* Find a primitive in the currently opened DLLs.
89 Raise [Not_found] if not found. *)
90
91 let find_primitive prim_name =
92 let rec find seen = function
93 [] ->
94 raise Not_found
95 | dll :: rem ->
96 let addr = dll_sym dll prim_name in
97 if addr == Obj.magic () then find (dll :: seen) rem else begin
98 if seen <> [] then opened_dlls := dll :: List.rev_append seen rem;
99 addr
100 end in
101 find [] !opened_dlls
102
103 (* If linking in core (dynlink or toplevel), synchronize the VM
104 table of primitive with the linker's table of primitive
105 by storing the given primitive function at the given position
106 in the VM table of primitives. *)
107
108 let linking_in_core = ref false
109
110 let synchronize_primitive num symb =
111 if !linking_in_core then begin
112 let actual_num = add_primitive symb in
113 assert (actual_num = num)
114 end
115
116 (* Read the [ld.conf] file and return the corresponding list of directories *)
117
118 let ld_conf_contents () =
119 let path = ref [] in
120 begin try
121 let ic = open_in (Filename.concat Config.standard_library "ld.conf") in
122 begin try
123 while true do
124 path := input_line ic :: !path
125 done
126 with End_of_file -> ()
127 end;
128 close_in ic
129 with Sys_error _ -> ()
130 end;
131 List.rev !path
132
133 (* Split the CAML_LD_LIBRARY_PATH environment variable and return
134 the corresponding list of directories. *)
135 let ld_library_path_contents () =
136 match Sys.getenv "CAML_LD_LIBRARY_PATH" with
137 | exception Not_found ->
138 []
139 | s ->
140 Misc.split_path_contents s
141
142 let split_dll_path path =
143 Misc.split_path_contents ~sep:'\000' path
144
145 (* Initialization for separate compilation *)
146
147 let init_compile nostdlib =
148 search_path :=
149 ld_library_path_contents() @
150 (if nostdlib then [] else ld_conf_contents())
151
152 (* Initialization for linking in core (dynlink or toplevel) *)
153
154 let init_toplevel dllpath =
155 search_path :=
156 ld_library_path_contents() @
157 split_dll_path dllpath @
158 ld_conf_contents();
159 opened_dlls := Array.to_list (get_current_dlls());
160 names_of_opened_dlls := [];
161 linking_in_core := true
162
163 let reset () =
164 search_path := [];
165 opened_dlls :=[];
166 names_of_opened_dlls := [];
167 linking_in_core := false
168