From ce9c7aab9b883a7130ce1b350583c79365e82423 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Fran=C3=A7ois=20Bobot?= Date: Tue, 3 Mar 2015 23:50:00 +0100 Subject: [PATCH 1/2] [Dynlink] add utilities for dynamic linking packages --- src/findlib/META.in | 10 ++++++++++ src/findlib/Makefile | 19 ++++++++++++++++--- src/findlib/findlib.ml | 4 ++++ src/findlib/findlib.mli | 7 +++++++ src/findlib/fl_dynlink.ml | 25 +++++++++++++++++++++++++ src/findlib/fl_dynlink.mli | 9 +++++++++ src/findlib/frontend.ml | 13 ++++++++----- 7 files changed, 79 insertions(+), 8 deletions(-) create mode 100644 src/findlib/fl_dynlink.ml create mode 100644 src/findlib/fl_dynlink.mli diff --git a/src/findlib/META.in b/src/findlib/META.in index e19bcad..859bcc7 100644 --- a/src/findlib/META.in +++ b/src/findlib/META.in @@ -6,3 +6,13 @@ archive(byte) = "findlib.cma" archive(byte,toploop) = "findlib.cma findlib_top.cma" archive(byte,create_toploop) = "findlib.cma findlib_top.cma" archive(native) = "findlib.cmxa" + +package "dynlink" ( + description = "Package manager dynamic linker" + requires = "findlib dynlink" + archive(byte) = "findlib_dynlink.cma" + archive(native) = "findlib_dynlink.cmxa" +#Even if it strange and discouraged to dynlink this package + archive(byte,plugin) = "findlib_dynlink.cma" + archive(native,plugin) = "findlib_dynlink.cmxs" +) \ No newline at end of file diff --git a/src/findlib/Makefile b/src/findlib/Makefile index bdd7f14..cbfec7b 100644 --- a/src/findlib/Makefile +++ b/src/findlib/Makefile @@ -28,14 +28,18 @@ TOBJECTS = topfind.cmo XOBJECTS = $(OBJECTS:.cmo=.cmx) +OBJECTS_DYNLINK = fl_dynlink.cmo +XOBJECTS_DYNLINK = $(OBJECTS_DYNLINK:.cmo=.cmx) + OCAMLFIND_OBJECTS = ocaml_args.cmo frontend.cmo OCAMLFIND_XOBJECTS = ocaml_args.cmx frontend.cmx NUMTOP_OBJECTS = num_top_printers.cmo num_top.cmo -all: ocamlfind$(EXEC_SUFFIX) findlib.cma findlib_top.cma topfind num_top.cma +all: ocamlfind$(EXEC_SUFFIX) findlib.cma findlib_top.cma topfind num_top.cma \ + findlib_dynlink.cma -opt: ocamlfind_opt$(EXEC_SUFFIX) findlib.cmxa topfind +opt: ocamlfind_opt$(EXEC_SUFFIX) findlib.cmxa findlib_dynlink.cmxa topfind ocamlfind$(EXEC_SUFFIX): findlib.cma $(OCAMLFIND_OBJECTS) $(OCAMLC) $(CUSTOM) -o ocamlfind$(EXEC_SUFFIX) -g findlib.cma unix.cma \ @@ -60,6 +64,15 @@ findlib.cmxa: $(XOBJECTS) $(OCAMLOPT) -shared -o findlib.cmxs $(XOBJECTS); \ fi +findlib_dynlink.cma: $(OBJECTS_DYNLINK) + $(OCAMLC) -a -o $@ $(OBJECTS_DYNLINK) + +findlib_dynlink.cmxa: $(XOBJECTS_DYNLINK) + $(OCAMLOPT) -a -o $@ $(XOBJECTS_DYNLINK) + if [ $(HAVE_NATDYNLINK) -gt 0 ]; then \ + $(OCAMLOPT) -shared -o findlib_dynlink.cmxs $(XOBJECTS_DYNLINK); \ + fi + findlib_config.ml: findlib_config.mlp $(TOP)/Makefile.config USE_CYGPATH="$(USE_CYGPATH)"; \ export USE_CYGPATH; \ @@ -100,7 +113,7 @@ install: all mkdir -p "$(prefix)$(OCAML_SITELIB)/$(NAME)" mkdir -p "$(prefix)$(OCAMLFIND_BIN)" test $(INSTALL_TOPFIND) -eq 0 || cp topfind "$(prefix)$(OCAML_CORE_STDLIB)" - files=`$(TOP)/tools/collect_files $(TOP)/Makefile.config findlib.cmi findlib.mli findlib.cma topfind.cmi topfind.mli fl_package_base.mli fl_package_base.cmi fl_metascanner.mli fl_metascanner.cmi fl_metatoken.cmi findlib_top.cma findlib.cmxa findlib.a findlib.cmxs META` && \ + files=`$(TOP)/tools/collect_files $(TOP)/Makefile.config findlib.cmi findlib.mli findlib.cma topfind.cmi topfind.mli fl_package_base.mli fl_package_base.cmi fl_metascanner.mli fl_metascanner.cmi fl_metatoken.cmi findlib_top.cma findlib.cmxa findlib.a findlib.cmxs findlib_dynlink.cma findlib_dynlink.cmxa findlib_dynlink.a findlib_dynlink.cmxs fl_dynlink.mli fl_dynlink.cmi META` && \ cp $$files "$(prefix)$(OCAML_SITELIB)/$(NAME)" f="ocamlfind$(EXEC_SUFFIX)"; { test -f ocamlfind_opt$(EXEC_SUFFIX) && f="ocamlfind_opt$(EXEC_SUFFIX)"; }; \ cp $$f "$(prefix)$(OCAMLFIND_BIN)/ocamlfind$(EXEC_SUFFIX)" diff --git a/src/findlib/findlib.ml b/src/findlib/findlib.ml index 2b1aa2c..75e2ae1 100644 --- a/src/findlib/findlib.ml +++ b/src/findlib/findlib.ml @@ -427,3 +427,7 @@ let list_packages ?(tab = 20) ?(descr = false) ch = ) packages_sorted ;; + + +let linked_packages = ref [] +let linked_predicates = ref [] diff --git a/src/findlib/findlib.mli b/src/findlib/findlib.mli index d435a84..6ef5cc9 100644 --- a/src/findlib/findlib.mli +++ b/src/findlib/findlib.mli @@ -193,3 +193,10 @@ val list_packages : ?tab:int -> ?descr:bool -> out_channel -> unit * @param tab The tabulator width, by default 20 * @param descr Whether package descriptions are printed. Default: false *) + +val linked_packages : string list ref + (** The list of currently linked packages. + The packages can be absent of the database *) + +val linked_predicates : string list ref +(** The list of predicates used during linking (eg. native, byte, mt, ...) *) diff --git a/src/findlib/fl_dynlink.ml b/src/findlib/fl_dynlink.ml new file mode 100644 index 0000000..b64b617 --- /dev/null +++ b/src/findlib/fl_dynlink.ml @@ -0,0 +1,25 @@ + +(** Utilities for loading dynamically packages *) + +let load_pkg pkg = + if not (List.mem pkg !Findlib.linked_packages) then + (* Determine the package directory: *) + let d = Findlib.package_directory pkg in + (* Determine the 'archive(plugin,...)' property: *) + let archive = + try + Findlib.package_property ("plugin"::!Findlib.linked_predicates) pkg "archive" + with Not_found -> "" in + (* Split the 'archive' property and resolve the files: *) + let files = Fl_split.in_words archive in + List.iter (fun file -> + let file = Findlib.resolve_path ~base:d file in + Dynlink.loadfile file + ) files; + Findlib.linked_packages := pkg::!Findlib.linked_packages + +let load_packages pkgs = + let eff_pkglist = + Findlib.package_deep_ancestors !Findlib.linked_predicates pkgs in + List.iter load_pkg eff_pkglist + diff --git a/src/findlib/fl_dynlink.mli b/src/findlib/fl_dynlink.mli new file mode 100644 index 0000000..1109442 --- /dev/null +++ b/src/findlib/fl_dynlink.mli @@ -0,0 +1,9 @@ +(* $Id$ + * ---------------------------------------------------------------------- + * + *) + +(** Utilities for loading dynamically packages *) + +val load_packages : string list -> unit +(** Dynlink the given packages and all their dependencies *) diff --git a/src/findlib/frontend.ml b/src/findlib/frontend.ml index 2e00ccd..82b95b6 100644 --- a/src/findlib/frontend.ml +++ b/src/findlib/frontend.ml @@ -1148,8 +1148,11 @@ let ocamlc which () = let threads_dir = Filename.concat stdlibdir "threads" in let vmthreads_dir = Filename.concat stdlibdir "vmthreads" in - let initl_file_needed = + let create_toploop = List.mem "create_toploop" !predicates && List.mem "findlib" eff_link in + let initl_file_needed = + create_toploop || List.mem "findlib.dynlink" eff_link + in let initl_file_name = if initl_file_needed then @@ -1170,19 +1173,19 @@ let ocamlc which () = initl_file_name in try output_string initl - ("Topfind.don't_load [" ^ + ("Findlib.linked_packages := [" ^ String.concat ";" (List.map (fun pkg -> "\"" ^ String.escaped pkg ^ "\"") eff_link) ^ "];;\n"); + let predicates = List.filter (fun p -> p <> "create_toploop") !predicates in output_string initl - ("Topfind.predicates := [" ^ + ("Findlib.linked_predicates := [" ^ String.concat ";" (List.map (fun pred -> "\"" ^ String.escaped pred ^ "\"") - ("toploop" :: - (List.filter (fun p -> p <> "create_toploop") !predicates))) ^ + (if create_toploop then "toploop" :: predicates else predicates)) ^ "];;\n"); close_out initl; with -- 2.1.4