Merge pull request #9551 from nojb/microbfd

Implement (in utils/binutils.ml) a simple parser for ELF, Mach-O and PE shared object files.  Use it to get rid of libbfd in ocamlobjinfo and to improve the checking of external primitives during linking in ocamlc.

.depend

@@ -3,6 +3,11 @@ utils/arg_helper.cmo : \
 utils/arg_helper.cmx : \
     utils/arg_helper.cmi
 utils/arg_helper.cmi :
+utils/binutils.cmo : \
+    utils/binutils.cmi
+utils/binutils.cmx : \
+    utils/binutils.cmi
+utils/binutils.cmi :
 utils/build_path_prefix_map.cmo : \
     utils/build_path_prefix_map.cmi
 utils/build_path_prefix_map.cmx : \
@@ -1857,10 +1862,12 @@ bytecomp/bytesections.cmi :
 bytecomp/dll.cmo : \
     utils/misc.cmi \
     utils/config.cmi \
+    utils/binutils.cmi \
     bytecomp/dll.cmi
 bytecomp/dll.cmx : \
     utils/misc.cmx \
     utils/config.cmx \
+    utils/binutils.cmx \
     bytecomp/dll.cmi
 bytecomp/dll.cmi :
 bytecomp/emitcode.cmo : \

.gitignore

@@ -246,7 +246,6 @@ _build
 /tools/ocamlmklib
 /tools/ocamlmklib.opt
 /tools/ocamlmklibconfig.ml
-/tools/objinfo_helper
 /tools/ocamlcmt
 /tools/ocamlcmt.opt
 /tools/cmpbyt

Changes

@@ -90,6 +90,12 @@ Working version
 
 ### Code generation and optimizations:
 
+- #9551: ocamlc no longer loads DLLs at link time to check that
+  external functions referenced from OCaml code are defined.
+  Instead, .so/.dll files are parsed directly by pure OCaml code.
+  (Nicolás Ojeda Bär, review by Daniel Bünzli, Gabriel Scherer,
+   Anil Madhavapeddy, and Xavier Leroy)
+
 - #9620: Limit the number of parameters for an uncurried or untupled
    function.  Functions with more parameters than that are left
    partially curried or tupled.
@@ -157,6 +163,11 @@ Working version
 
 ### Tools:
 
+- #9551: ocamlobjinfo is now able to display information on .cmxs shared
+  libraries natively; it no longer requires libbfd to do so
+  (Nicolás Ojeda Bär, review by Daniel Bünzli, Gabriel Scherer,
+   Anil Madhavapeddy, and Xavier Leroy)
+
 - #9606, #9635, #9637: fix performance regression in the debugger
   (behaviors quadratic in the size of the debugged program)
   (Xavier Leroy, report by Jacques Garrigue and Virgile Prevosto,

INSTALL.adoc

@@ -15,9 +15,7 @@
 
 * Under Cygwin, the `gcc-core` and `make` packages are required.  `flexdll` is
   necessary for shared library support.  `libX11-devel` is necessary for graph
-  library support and `libintl-devel` is necessary for the `ocamlobjinfo` tool
-  to be able to process `.cmxs` files.  `diffutils` is necessary to run the test
-  suite.
+  library support.  `diffutils` is necessary to run the test suite.
 
 == Configuration
 

Makefile.config.in

@@ -176,9 +176,6 @@ PTHREAD_CAML_LINK=$(addprefix -cclib ,$(PTHREAD_LINK))
 
 UNIX_OR_WIN32=@unix_or_win32@
 UNIXLIB=@unixlib@
-BFD_CPPFLAGS=@bfd_cppflags@
-BFD_LDFLAGS=@bfd_ldflags@
-BFD_LDLIBS=@bfd_ldlibs@
 INSTALL_SOURCE_ARTIFACTS=@install_source_artifacts@
 
 OC_CFLAGS=@oc_cflags@

bytecomp/dll.ml

@@ -31,8 +31,16 @@ external get_current_dlls: unit -> dll_handle array
 (* Current search path for DLLs *)
 let search_path = ref ([] : string list)
 
+type opened_dll =
+  | Checking of Binutils.t
+  | Execution of dll_handle
+
+let dll_close = function
+  | Checking _ -> ()
+  | Execution dll -> dll_close dll
+
 (* DLLs currently opened *)
-let opened_dlls = ref ([] : dll_handle list)
+let opened_dlls = ref ([] : opened_dll list)
 
 (* File names for those DLLs *)
 let names_of_opened_dlls = ref ([] : string list)
@@ -67,12 +75,24 @@ let open_dll mode name =
       else fullname
     with Not_found -> name in
   if not (List.mem fullname !names_of_opened_dlls) then begin
-    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)
+    let dll =
+      match mode with
+      | For_checking ->
+          begin match Binutils.read fullname with
+          | Ok t -> Checking t
+          | Error err ->
+              failwith (fullname ^ ": " ^ Binutils.error_to_string err)
+          end
+      | For_execution ->
+          begin match dll_open mode fullname with
+          | dll ->
+              Execution dll
+          | exception Failure msg ->
+              failwith (fullname ^ ": " ^ msg)
+          end
+    in
+    names_of_opened_dlls := fullname :: !names_of_opened_dlls;
+    opened_dlls := dll :: !opened_dlls
   end
 
 let open_dlls mode names =
@@ -85,19 +105,28 @@ let close_all_dlls () =
   opened_dlls := [];
   names_of_opened_dlls := []
 
-(* Find a primitive in the currently opened DLLs.
-   Raise [Not_found] if not found. *)
+(* Find a primitive in the currently opened DLLs. *)
+
+type primitive_address =
+  | Prim_loaded of dll_address
+  | Prim_exists
 
 let find_primitive prim_name =
   let rec find seen = function
     [] ->
-      raise Not_found
-  | dll :: rem ->
+      None
+  | Execution dll as curr :: rem ->
       let addr = dll_sym dll prim_name in
-      if addr == Obj.magic () then find (dll :: seen) rem else begin
-        if seen <> [] then opened_dlls := dll :: List.rev_append seen rem;
-        addr
-      end in
+      if addr == Obj.magic () then find (curr :: seen) rem else begin
+        if seen <> [] then opened_dlls := curr :: List.rev_append seen rem;
+        Some (Prim_loaded addr)
+      end
+  | Checking t as curr :: rem ->
+      if Binutils.defines_symbol t prim_name then
+        Some Prim_exists
+      else
+        find (curr :: seen) rem
+  in
   find [] !opened_dlls
 
 (* If linking in core (dynlink or toplevel), synchronize the VM
@@ -156,7 +185,9 @@ let init_toplevel dllpath =
     ld_library_path_contents() @
     split_dll_path dllpath @
     ld_conf_contents();
-  opened_dlls := Array.to_list (get_current_dlls());
+  opened_dlls :=
+    List.map (fun dll -> Execution dll)
+      (Array.to_list (get_current_dlls()));
   names_of_opened_dlls := [];
   linking_in_core := true
 

bytecomp/dll.mli

@@ -34,9 +34,14 @@ val close_all_dlls: unit -> unit
 (* The abstract type representing C function pointers *)
 type dll_address
 
+type primitive_address =
+  | Prim_loaded of dll_address (* Primitive found in a DLL opened
+                                  "for execution" *)
+  | Prim_exists (* Primitive found in a DLL opened "for checking" *)
+
 (* Find a primitive in the currently opened DLLs and return its address.
-   Raise [Not_found] if not found. *)
-val find_primitive: string -> dll_address
+   Return [None] if the primitive is not found. *)
+val find_primitive: string -> primitive_address option
 
 (* If linking in core (dynlink or toplevel), synchronize the VM
    table of primitive with the linker's table of primitive

bytecomp/symtable.ml

@@ -98,12 +98,14 @@ let of_prim name =
     then
       PrimMap.enter c_prim_table name
     else begin
-      let symb =
-        try Dll.find_primitive name
-        with Not_found -> raise(Error(Unavailable_primitive name)) in
-      let num = PrimMap.enter c_prim_table name in
-      Dll.synchronize_primitive num symb;
-      num
+      match Dll.find_primitive name with
+      | None -> raise(Error(Unavailable_primitive name))
+      | Some Prim_exists ->
+          PrimMap.enter c_prim_table name
+      | Some (Prim_loaded symb) ->
+          let num = PrimMap.enter c_prim_table name in
+          Dll.synchronize_primitive num symb;
+          num
     end
 
 let require_primitive name =

compilerlibs/Makefile.compilerlibs

@@ -30,7 +30,7 @@ UTILS=utils/config.cmo utils/build_path_prefix_map.cmo utils/misc.cmo \
 	utils/terminfo.cmo utils/ccomp.cmo utils/warnings.cmo \
 	utils/consistbl.cmo utils/strongly_connected_components.cmo \
 	utils/targetint.cmo utils/int_replace_polymorphic_compare.cmo \
-	utils/domainstate.cmo
+	utils/domainstate.cmo utils/binutils.cmo
 UTILS_CMI=
 
 PARSING=parsing/location.cmo parsing/longident.cmo \