From 798600baf5ada5900c56d722a63bef9d25f1f470 Mon Sep 17 00:00:00 2001 From: Xavier Leroy Date: Tue, 7 Nov 1995 10:01:45 +0000 Subject: [PATCH] MAJ doc git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@418 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02 --- otherlibs/dynlink/Makefile | 6 +++ otherlibs/dynlink/dynlink.ml | 17 ++++++++- otherlibs/dynlink/dynlink.mli | 64 +++++++++++++++++++++++++++++--- otherlibs/dynlink/extract_crc.ml | 17 ++++++++- 4 files changed, 94 insertions(+), 10 deletions(-) diff --git a/otherlibs/dynlink/Makefile b/otherlibs/dynlink/Makefile index ad4885f25..66c70f8b2 100644 --- a/otherlibs/dynlink/Makefile +++ b/otherlibs/dynlink/Makefile @@ -12,6 +12,8 @@ COMPILEROBJS=misc.cmo tbl.cmo clflags.cmo config.cmo ident.cmo \ all: dynlink.cma extract_crc +allopt: + dynlink.cma: $(OBJS) $(CAMLC) $(COMPFLAGS) -a -o dynlink.cma $(COMPILEROBJS) $(OBJS) @@ -21,9 +23,13 @@ extract_crc: dynlink.cma extract_crc.cmo install: cp dynlink.cmi dynlink.cma extract_crc $(LIBDIR) +installopt: + clean: rm -f extract_crc *.cm[ioa] +realclean: + .SUFFIXES: .ml .mli .cmo .cmi .mli.cmi: diff --git a/otherlibs/dynlink/dynlink.ml b/otherlibs/dynlink/dynlink.ml index c88dfc5e7..1e6f781a1 100644 --- a/otherlibs/dynlink/dynlink.ml +++ b/otherlibs/dynlink/dynlink.ml @@ -1,3 +1,16 @@ +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + (* Dynamic loading of .cmo files *) open Emitcode @@ -47,7 +60,7 @@ let add_available_units units = (* Read the CRC of an interface from its .cmi file *) -let crc_interface unit loadpath = +let digest_interface unit loadpath = let filename = Misc.find_in_path loadpath (Misc.lowercase unit ^ ".cmi") in let ic = open_in_bin filename in try @@ -70,7 +83,7 @@ let crc_interface unit loadpath = let add_interfaces units loadpath = add_available_units - (List.map (fun unit -> (unit, crc_interface unit loadpath)) units) + (List.map (fun unit -> (unit, digest_interface unit loadpath)) units) (* Check whether the object file being loaded was compiled in unsafe mode *) diff --git a/otherlibs/dynlink/dynlink.mli b/otherlibs/dynlink/dynlink.mli index a51246f6b..464b174e0 100644 --- a/otherlibs/dynlink/dynlink.mli +++ b/otherlibs/dynlink/dynlink.mli @@ -1,12 +1,59 @@ -(* Dynamic loading of .cmo files *) +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Module [Dynlink]: dynamic loading of bytecode object files *) + +(* This library supports type-safe dynamic loading and linking of bytecode + object files ([.cmo] files) in a running bytecode program. + Type safety is ensured by limiting the set of modules from the running + program that the loaded object file can access, and checking that the + running program and the loaded object file have been compiled against + the same interfaces for these modules. *) val init : unit -> unit + (* Initialize the library. Must be called before [loadfile]. *) val loadfile : string -> unit -val clear_available_units : unit -> unit -val add_available_units : (string * Digest.t) list -> unit -val crc_interface : string -> string list -> Digest.t + (* Load the given bytecode object file and link it. + All toplevel expressions in the loaded compilation unit + are evaluated. No facilities are provided to + access value names defined by the unit. Therefore, the unit + must register itself its entry points with the main program, + e.g. by modifying tables of functions. *) val add_interfaces : string list -> string list -> unit + (* [add_interfaces units path] grants dynamically-linked object + files access to the compilation units named in list [units]. + The interfaces ([.cmi] files) for these units are searched in + [path] (a list of directory names). Initially, dynamically-linked + object files do not have access to any of the compilation + units composing the running program, not even the standard library. + [add_interfaces] or [add_available_units] (see below) must be + called to grant access to some of the units. *) +val add_available_units : (string * Digest.t) list -> unit + (* Same as [add_interfaces], but instead of searching [.cmi] files + to find the unit interfaces, uses the interface digests given + for each unit. This way, the [.cmi] interface files need not be + available at run-time. The digests can be extracted from [.cmi] + files using the [extract_crc] program installed in the + Caml Special Light standard library directory. *) +val clear_available_units : unit -> unit + (* Clear the list of compilation units accessible to dynamically-linked + programs. *) val allow_unsafe_modules : bool -> unit + (* Govern whether unsafe object files are allowed to be + dynamically linked. A compilation unit is ``unsafe'' if it contains + declarations of external functions, which can break type safety. + By default, dynamic linking of unsafe object files is + not allowed. *) type error = Not_a_bytecode_file of string @@ -15,7 +62,12 @@ type error = | Unsafe_file | Linking_error of string | Corrupted_interface of string - exception Error of error - + (* Errors in dynamic linking are reported by raising the [Error] + exception with a description of the error. *) val error_message: error -> string + (* Convert an error description to a printable message. *) + +(*--*) + +val digest_interface : string -> string list -> Digest.t diff --git a/otherlibs/dynlink/extract_crc.ml b/otherlibs/dynlink/extract_crc.ml index 7a1694f25..3d6e53736 100644 --- a/otherlibs/dynlink/extract_crc.ml +++ b/otherlibs/dynlink/extract_crc.ml @@ -1,11 +1,24 @@ -(* Read the CRC of the interfaces of the units *) +(***********************************************************************) +(* *) +(* Caml Special Light *) +(* *) +(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) +(* *) +(* Copyright 1995 Institut National de Recherche en Informatique et *) +(* Automatique. Distributed only by permission. *) +(* *) +(***********************************************************************) + +(* $Id$ *) + +(* Print the digests of unit interfaces *) let load_path = ref ["."] let first = ref true let print_crc unit = try - let crc = Dynlink.crc_interface unit !load_path in + let crc = Dynlink.digest_interface unit !load_path in if !first then first := false else print_string ";\n"; print_string " \""; print_string unit; print_string "\",\n \""; for i = 0 to String.length crc - 1 do