diff options
| -rw-r--r-- | asmrun/natdynlink.c | 43 | ||||
| -rw-r--r-- | byterun/caml/mlvalues.h | 1 | ||||
| -rw-r--r-- | otherlibs/dynlink/natdynlink.ml | 27 |
3 files changed, 45 insertions, 26 deletions
diff --git a/asmrun/natdynlink.c b/asmrun/natdynlink.c index ae22cbeea9..e2599e65fb 100644 --- a/asmrun/natdynlink.c +++ b/asmrun/natdynlink.c @@ -35,6 +35,14 @@ CAMLexport void (*caml_natdynlink_hook)(void* handle, char* unit) = NULL; #include <stdio.h> #include <string.h> +#include <limits.h> + +#define Handle_val(v) (*((void **) Data_abstract_val(v))) +static value Val_handle(void* handle) { + value res = caml_alloc_small(1, Abstract_tag); + Handle_val(res) = handle; + return res; +} static void *getsym(void *handle, char *module, char *name){ char *fullname = caml_strconcat(3, "caml", module, name); @@ -47,7 +55,7 @@ static void *getsym(void *handle, char *module, char *name){ CAMLprim value caml_natdynlink_getmap(value unit) { - return (value)caml_globals_map; + return caml_input_value_from_block(caml_globals_map, INT_MAX); } CAMLprim value caml_natdynlink_globals_inited(value unit) @@ -57,37 +65,41 @@ CAMLprim value caml_natdynlink_globals_inited(value unit) CAMLprim value caml_natdynlink_open(value filename, value global) { - CAMLparam1 (filename); - CAMLlocal1 (res); + CAMLparam2 (filename, global); + CAMLlocal3 (res, handle, header); void *sym; - void *handle; + void *dlhandle; char *p; /* TODO: dlclose in case of error... */ p = caml_strdup(String_val(filename)); caml_enter_blocking_section(); - handle = caml_dlopen(p, 1, Int_val(global)); + dlhandle = caml_dlopen(p, 1, Int_val(global)); caml_leave_blocking_section(); caml_stat_free(p); - if (NULL == handle) - CAMLreturn(caml_copy_string(caml_dlerror())); + if (NULL == dlhandle) + caml_failwith(caml_dlerror()); - sym = caml_dlsym(handle, "caml_plugin_header"); + sym = caml_dlsym(dlhandle, "caml_plugin_header"); if (NULL == sym) - CAMLreturn(caml_copy_string("not an OCaml plugin")); + caml_failwith("not an OCaml plugin"); + + handle = Val_handle(dlhandle); + header = caml_input_value_from_block(sym, INT_MAX); res = caml_alloc_tuple(2); - Field(res, 0) = (value) handle; - Field(res, 1) = (value) (sym); + Field(res, 0) = handle; + Field(res, 1) = header; CAMLreturn(res); } -CAMLprim value caml_natdynlink_run(void *handle, value symbol) { - CAMLparam1 (symbol); +CAMLprim value caml_natdynlink_run(value handle_v, value symbol) { + CAMLparam2 (handle_v, symbol); CAMLlocal1 (result); void *sym,*sym2; + void* handle = Handle_val(handle_v); struct code_fragment * cf; #define optsym(n) getsym(handle,unit,n) @@ -137,7 +149,7 @@ CAMLprim value caml_natdynlink_run(void *handle, value symbol) { CAMLprim value caml_natdynlink_run_toplevel(value filename, value symbol) { CAMLparam2 (filename, symbol); - CAMLlocal2 (res, v); + CAMLlocal3 (res, v, handle_v); void *handle; char *p; @@ -154,8 +166,9 @@ CAMLprim value caml_natdynlink_run_toplevel(value filename, value symbol) v = caml_copy_string(caml_dlerror()); Store_field(res, 0, v); } else { + handle_v = Val_handle(handle); res = caml_alloc(1,0); - v = caml_natdynlink_run(handle, symbol); + v = caml_natdynlink_run(handle_v, symbol); Store_field(res, 0, v); } CAMLreturn(res); diff --git a/byterun/caml/mlvalues.h b/byterun/caml/mlvalues.h index 3e736e7319..04ff65a485 100644 --- a/byterun/caml/mlvalues.h +++ b/byterun/caml/mlvalues.h @@ -248,6 +248,7 @@ CAMLextern value caml_hash_variant(char const * tag); this tag cannot be mistaken for pointers (see caml_obj_truncate). */ #define Abstract_tag 251 +#define Data_abstract_val(v) ((void*) Op_val(v)) /* Strings. */ #define String_tag 252 diff --git a/otherlibs/dynlink/natdynlink.ml b/otherlibs/dynlink/natdynlink.ml index 685b306b8f..de237728b0 100644 --- a/otherlibs/dynlink/natdynlink.ml +++ b/otherlibs/dynlink/natdynlink.ml @@ -16,11 +16,20 @@ (* Dynamic loading of .cmx files *) +open Cmx_format + type handle -external ndl_open: string -> bool -> handle * bytes = "caml_natdynlink_open" +type global_map = { + name : string; + crc_intf : Digest.t; + crc_impl : Digest.t; + syms : string list +} + +external ndl_open: string -> bool -> handle * dynheader = "caml_natdynlink_open" external ndl_run: handle -> string -> unit = "caml_natdynlink_run" -external ndl_getmap: unit -> bytes = "caml_natdynlink_getmap" +external ndl_getmap: unit -> global_map list = "caml_natdynlink_getmap" external ndl_globals_inited: unit -> int = "caml_natdynlink_globals_inited" type linking_error = @@ -41,8 +50,6 @@ type error = exception Error of error -open Cmx_format - (* Copied from config.ml to avoid dependencies *) let cmxs_magic_number = "Caml2007D002" @@ -54,11 +61,10 @@ let read_file filename priv = let dll = dll_filename filename in if not (Sys.file_exists dll) then raise (Error (File_not_found dll)); - let (handle,data) as res = ndl_open dll (not priv) in - if Obj.tag (Obj.repr res) = Obj.string_tag - then raise (Error (Cannot_open_dll (Obj.magic res))); + let (handle,header) = try + ndl_open dll (not priv) + with Failure s -> raise (Error (Cannot_open_dll s)) in - let header : dynheader = Marshal.from_bytes data 0 in if header.dynu_magic <> cmxs_magic_number then raise(Error(Not_a_bytecode_file dll)); (dll, handle, header.dynu_units) @@ -90,13 +96,12 @@ let allow_extension = ref true let inited = ref false let default_available_units () = - let map : (string*Digest.t*Digest.t*string list) list = - Marshal.from_bytes (ndl_getmap ()) 0 in + let map = ndl_getmap () in let exe = Sys.executable_name in let rank = ref 0 in global_state := List.fold_left - (fun st (name,crc_intf,crc_impl,syms) -> + (fun st {name;crc_intf;crc_impl;syms} -> rank := !rank + List.length syms; { ifaces = StrMap.add name (crc_intf,exe) st.ifaces; |