blob: 7814e1a04ab18389a414dd3f8712883b2efbb3b8 (
plain)
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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 2001 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the Q Public License version 1.0. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Handling of dynamically-linked libraries *)
type dll_handle
type dll_address
external dll_open: string -> dll_handle = "dynlink_open_lib"
external dll_close: dll_handle -> unit = "dynlink_close_lib"
external dll_sym: dll_handle -> string -> dll_address = "dynlink_lookup_symbol"
external add_primitive: dll_address -> int = "dynlink_add_primitive"
external get_current_dlls: unit -> dll_handle array
= "dynlink_get_current_libs"
(* Current search path for DLLs *)
let search_path = ref ([] : string list)
(* DLLs currently opened *)
let opened_dlls = ref ([] : dll_handle list)
(* File names for those DLLs *)
let names_of_opened_dlls = ref ([] : string list)
(* Add the given directories to the search path for DLLs. *)
let add_path dirs =
search_path := dirs @ !search_path
(* Read the [ld.conf] file and return the corresponding list of directories *)
let ld_conf_contents () =
let path = ref [] in
begin try
let ic = open_in (Filename.concat Config.standard_library "ld.conf") in
begin try
while true do
path := input_line ic :: !path
done
with End_of_file -> ()
end;
close_in ic
with Sys_error _ -> ()
end;
List.rev !path
(* Split the CAML_LD_LIBRARY_PATH environment variable and return
the corresponding list of directories. *)
let split str sep =
let rec split_rec pos =
if pos >= String.length str then [] else begin
try
let newpos = String.index_from str pos sep in
String.sub str pos (newpos - pos) ::
split_rec (newpos + 1)
with Not_found ->
[String.sub str pos (String.length str - pos)]
end in
split_rec 0
let ld_library_path_contents () =
let path_separator =
match Sys.os_type with
"Unix" | "Cygwin" -> ':' | "Win32" -> ';' | _ -> assert false in
try
split (Sys.getenv "CAML_LD_LIBRARY_PATH") path_separator
with Not_found ->
[]
(* Extract names of DLLs from a list of C object files and libraries *)
let extract_dll_names files =
List.fold_right
(fun file res ->
if Filename.check_suffix file Config.ext_dll then
Filename.chop_suffix file Config.ext_dll :: res
else if String.length file >= 2 && String.sub file 0 2 = "-l" then
("lib" ^ String.sub file 2 (String.length file - 2)) :: res
else
res)
files []
(* Open a list of DLLs, adding them to opened_dlls.
Raise [Failure msg] in case of error. *)
let open_dll name =
let name = name ^ Config.ext_dll in
let fullname =
try Misc.find_in_path !search_path name with Not_found -> name in
if not (List.mem fullname !names_of_opened_dlls) then begin
let dll = dll_open fullname in
names_of_opened_dlls := fullname :: !names_of_opened_dlls;
opened_dlls := dll :: !opened_dlls
end
let open_dlls names =
List.iter open_dll (List.rev names)
(* Close all DLLs *)
let close_all_dlls () =
List.iter dll_close !opened_dlls;
opened_dlls := [];
names_of_opened_dlls := []
(* Find a primitive in the currently opened DLLs.
Raise [Not_found] if not found. *)
let find_primitive prim_name =
let rec find = function
[] ->
raise Not_found
| dll :: rem ->
try dll_sym dll prim_name with Failure _ -> find rem in
find !opened_dlls
(* If linking in core (dynlink or toplevel), synchronize the VM
table of primitive with the linker's table of primitive
by storing the given primitive function at the given position
in the VM table of primitives. *)
let linking_in_core = ref false
let synchronize_primitive num symb =
if !linking_in_core then begin
let actual_num = add_primitive symb in
assert (actual_num = num)
end
(* Initialization for linking in core (dynlink or toplevel) *)
let init_toplevel dllpath =
search_path :=
ld_library_path_contents() @ split dllpath '\000' @ ld_conf_contents();
opened_dlls := Array.to_list (get_current_dlls());
names_of_opened_dlls := [];
linking_in_core := true
|
