Revised DLL loading: distinguish between loading for execution

(ocamlrun, dynlink, toplevel) and loading for checking the existence
of symbols (ocamlc).  This is needed for Windows with manifests and
not a bad idea for other platforms.


git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@7656 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

bytecomp/bytelink.ml

@@ -296,7 +296,7 @@ let link_bytecode tolink exec_name standalone =
       (* Initialize the DLL machinery *)
       Dll.init_compile !Clflags.no_std_include;
       Dll.add_path !load_path;
-      try Dll.open_dlls sharedobjs
+      try Dll.open_dlls Dll.For_checking sharedobjs
       with Failure reason -> raise(Error(Cannot_open_dll reason))
     end;
     let output_fun = output_string outchan

bytecomp/dll.ml

@@ -16,8 +16,9 @@
 
 type dll_handle
 type dll_address
+type dll_mode = For_checking | For_execution
 
-external dll_open: string -> dll_handle = "caml_dynlink_open_lib"
+external dll_open: dll_mode -> string -> dll_handle = "caml_dynlink_open_lib"
 external dll_close: dll_handle -> unit = "caml_dynlink_close_lib"
 external dll_sym: dll_handle -> string -> dll_address
                 = "caml_dynlink_lookup_symbol"
@@ -52,7 +53,7 @@ let extract_dll_name file =
 (* Open a list of DLLs, adding them to opened_dlls.
    Raise [Failure msg] in case of error. *)
 
-let open_dll name =
+let open_dll mode name =
   let name = name ^ Config.ext_dll in
   let fullname =
     try
@@ -62,13 +63,16 @@ let open_dll name =
       else fullname
     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
+    try
+      let dll = dll_open mode fullname in
+      names_of_opened_dlls := fullname :: !names_of_opened_dlls;
+      opened_dlls := dll :: !opened_dlls
+    with Failure msg ->
+      failwith (fullname ^ ": " ^ msg)
   end
 
-let open_dlls names =
-  List.iter open_dll names
+let open_dlls mode names =
+  List.iter (open_dll mode) names
 
 (* Close all DLLs *)
 

bytecomp/dll.mli

@@ -17,9 +17,15 @@
 (* Extract the name of a DLLs from its external name (xxx.so or -lxxx) *)
 val extract_dll_name: string -> string
 
-(* Open a list of DLLs, adding them to opened_dlls.
-   Raise [Failure msg] in case of error. *)
-val open_dlls: string list -> unit
+type dll_mode =
+  | For_checking     (* will just check existence of symbols;
+                        no need to do full symbol resolution *)
+  | For_execution    (* will call functions from this DLL;
+                        must resolve symbols completely *)
+
+(* Open a list of DLLs.  First argument indicates whether to perform
+   full symbol resolution.  Raise [Failure msg] in case of error. *)
+val open_dlls: dll_mode -> string list -> unit
 
 (* Close all DLLs *)
 val close_all_dlls: unit -> unit

byterun/dynlink.c

@@ -123,7 +123,7 @@ static void open_shared_lib(char * name)
   realname = caml_search_dll_in_path(&caml_shared_libs_path, name);
   caml_gc_message(0x100, "Loading shared library %s\n",
                   (uintnat) realname);
-  handle = caml_dlopen(realname);
+  handle = caml_dlopen(realname, 1);
   if (handle == NULL)
     caml_fatal_error_arg2("Fatal error: cannot load shared library %s\n", name,
                           "Reason: %s\n", caml_dlerror());
@@ -194,12 +194,12 @@ void caml_build_primitive_table_builtin(void)
 
 #define Handle_val(v) (*((void **) (v)))
 
-CAMLprim value caml_dynlink_open_lib(value filename)
+CAMLprim value caml_dynlink_open_lib(value mode, value filename)
 {
   void * handle;
   value result;
 
-  handle = caml_dlopen(String_val(filename));
+  handle = caml_dlopen(String_val(filename), Int_val(mode));
   if (handle == NULL) caml_failwith(caml_dlerror());
   result = caml_alloc_small(1, Abstract_tag);
   Handle_val(result) = handle;

byterun/osdeps.h

@@ -36,8 +36,13 @@ CAMLextern char * caml_search_exe_in_path(char * name);
 extern char * caml_search_dll_in_path(struct ext_table * path, char * name);
 
 /* Open a shared library and return a handle on it.
+   If [for_execution] is true, perform full symbol resolution and
+   execute initialization code so that functions from the shared library
+   can be called.  If [for_execution] is false, functions from this
+   shared library will not be called, but just checked for presence,
+   so symbol resolution can be skipped.
    Return [NULL] on error. */
-extern void * caml_dlopen(char * libname);
+extern void * caml_dlopen(char * libname, int for_execution);
 
 /* Close a shared library handle */
 extern void caml_dlclose(void * handle);

byterun/unix.c

@@ -199,7 +199,7 @@ entry_t *caml_lookup_bundle(const char *name)
   return current;
 }
 
-void * caml_dlopen(char * libname)
+void * caml_dlopen(char * libname, int for_execution)
 {
   NSObjectFileImage image;
   entry_t *bentry = caml_lookup_bundle(libname);
@@ -283,9 +283,12 @@ char * caml_dlerror(void)
 #define RTLD_NODELETE 0
 #endif
 
-void * caml_dlopen(char * libname)
+void * caml_dlopen(char * libname, int for_execution)
 {
-  return dlopen(libname, RTLD_NOW|RTLD_GLOBAL|RTLD_NODELETE);
+  return dlopen(libname, 
+                for_execution
+                ? RTLD_NOW | RTLD_GLOBAL | RTLD_NODELETE
+                : RTLD_LAZY);
 }
 
 void caml_dlclose(void * handle)

byterun/win32.c

@@ -120,9 +120,15 @@ char * caml_search_dll_in_path(struct ext_table * path, char * name)
   return res;
 }
 
-void * caml_dlopen(char * libname)
+void * caml_dlopen(char * libname, int for_execution)
 {
-  return (void *) LoadLibrary(libname);
+  HMODULE m;
+  m = LoadLibraryEx(libname, NULL,
+                    for_execution ? 0 : DONT_RESOLVE_DLL_REFERENCES);
+  /* LoadLibraryEx can fail under Win 95/98/ME in cases where LoadLibrary
+     would succeed.  Just try again with LoadLibrary for good measure. */
+  if (m == NULL) m = LoadLibrary(libname);
+  return (void *) m;
 }
 
 void caml_dlclose(void * handle)

debugger/dynlink.ml

@@ -200,7 +200,8 @@ let loadfile file_name =
       seek_in ic toc_pos;
       let lib = (input_value ic : library) in
       begin try 
-        Dll.open_dlls (List.map Dll.extract_dll_name lib.lib_dllibs)
+        Dll.open_dlls Dll.For_execution
+                      (List.map Dll.extract_dll_name lib.lib_dllibs)
       with Failure reason ->
         raise(Error(Cannot_open_dll reason))
       end;

otherlibs/dynlink/dynlink.ml

@@ -198,7 +198,8 @@ let loadfile file_name =
       seek_in ic toc_pos;
       let lib = (input_value ic : library) in
       begin try 
-        Dll.open_dlls (List.map Dll.extract_dll_name lib.lib_dllibs)
+        Dll.open_dlls Dll.For_execution
+                      (List.map Dll.extract_dll_name lib.lib_dllibs)
       with Failure reason ->
         raise(Error(Cannot_open_dll reason))
       end;

toplevel/topdirs.ml

@@ -105,7 +105,7 @@ let load_file ppf name =
         List.iter
           (fun dllib ->
             let name = Dll.extract_dll_name dllib in
-            try Dll.open_dlls [name]
+            try Dll.open_dlls Dll.For_execution [name]
             with Failure reason ->
               fprintf ppf
                 "Cannot load required shared library %s.@.Reason: %s.@."