removes the old unit tracking module, fixes the modern one (#1310)

The old unit tracking module, which is used what compilation units are
loaded to the core program, is no longer used since we phased out
compilers that required it. However, the modern unit that relies on
OCaml runtime to track the units was also broken (in all versions of
OCaml since the introduction of this facility in 4.08.0 till the
latest 4.12.0) as it wasn't properly initialized. This PR adds a
kludge that ensures proper initialization.

Note, the bug didn't manifest in BAP as we have several layers of
protection, but it is still better to have it working properly.

Author: ivg

lib/bap_plugins/bap_plugins_units.ml

@@ -1,26 +1,39 @@
 open Core_kernel
 
-open Bap_plugins_units_intf
-
-[%%if ocaml_version < (4,08,0)]
-include Bap_plugins_units_fallback
-[%%else]
 let name = "dynlink"
 
+type reason = [
+  | `In_core
+  | `Provided_by of string
+  | `Requested_by of string
+]
+
 let units : reason String.Table.t = String.Table.create ()
 
+(* see https://github.com/ocaml/ocaml/issues/9338
+   this ugly clutch could only be removed after we phase out
+   OCaml 4.11, as the fix (https://github.com/ocaml/ocaml/pull/9790)
+   was only merged in 4.12 *)
+let init_dynlink () =
+  try Dynlink.loadfile "" with _ -> ()
+
 let copy_units_from_dynlink () =
+  init_dynlink ();
   Dynlink.all_units () |>
   List.iter ~f:(fun unit -> Hashtbl.add_exn units unit `In_core)
 
 let init () = copy_units_from_dynlink ()
 let list () = Hashtbl.keys units
-let record name reason = Hashtbl.add_exn units name reason
+let record name reason = match Hashtbl.add units name reason with
+  | `Ok -> ()
+  | `Duplicate ->
+    failwithf "bap-plugins: internal error - \
+               the unit %s is already loaded" name ()
+
 let lookup = Hashtbl.find units
 let handle_error name reason = function
   | Dynlink.Module_already_loaded _ ->
     Hashtbl.set units name reason;
     Ok ()
   | other ->
     Or_error.error_string (Dynlink.error_message other)
-[%%endif]

lib/bap_plugins/bap_plugins_units.mli

@@ -1 +1,46 @@
-include Bap_plugins_units_intf.S
+(** Internal module.  *)
+
+open Core_kernel
+
+type reason = [
+  | `In_core
+  | `Provided_by of string
+  | `Requested_by of string
+]
+
+
+
+(** the name of the selected backend.
+
+    Currently, it should be [findlib] or [dynlink], and is
+    selected at configuration time via `./configure --plugins-backend`.
+*)
+val name : string
+
+(** initializes the unit system.
+
+    May fail if the selected backend is unable to provide safe
+    operation.
+
+    Could be only called once per program run.
+*)
+val init : unit -> unit
+
+
+(** [list ()] enumerates all currently linked modules.    *)
+val list : unit -> string list
+
+
+(** [record name reason] records unit [name] as well as the
+    reason, why it is linked.
+
+    pre: a unit with such name is not linked.
+*)
+val record : string -> reason -> unit
+
+
+(** [lookup name] checks if a unit with the given [name] is linked,
+    and returns a reason why it was linked. *)
+val lookup : string -> reason option
+
+val handle_error : string -> reason -> Dynlink.error -> unit Or_error.t

lib/bap_plugins/bap_plugins_units_fallback.ml

@@ -8,8 +8,6 @@ Library bap_plugins
   FindLibName:     bap-plugins
   Modules:         Bap_plugins
   InternalModules: Bap_plugins_config,
-                   Bap_plugins_units,
-                   Bap_plugins_units_fallback,
-                   Bap_plugins_units_intf
+                   Bap_plugins_units
   BuildDepends:    core_kernel, dynlink, fileutils, findlib, bap-bundle, bap-future,
                    uri, ppx_bap