/* - Wed Oct 17 16:43:30 2001 by Malcy - started */ /* Slightly modified to accept the entryname_v in ml_natdynload */ /* $Id: ndl.c,v 1.3 2005/09/18 21:58:00 oleg Exp $ */ #include #include #include #include #include #include #include #include /* for debugging */ #include #if defined(DYN_DEBUG) && DYN_DEBUG #define DBGPRINT fprintf #else #define DBGPRINT (void) #endif /* in new roots.c */ extern long ** caml_dyn_frametable; void init_frame_descriptors(void); /* Operations on DYNlimits This code is to operate on data/code limits in a dynamically loaded code. This code generalizes the simplistic handling of data/code limits in ../asmrun/startup.c We put the code here for convenience. */ struct DYNlimits caml_static_data_limits = {0,0,(struct DYNlimit *)0}; struct DYNlimits caml_code_area_limits = /* not dealt with yet */ {0,0,(struct DYNlimit *)0}; /* Allocate that many entries, initially */ #define DYNlimits_init_alloc 10 static void debug_print_DYNlimits(const struct DYNlimits * dynlimits, const char * title) { #if defined(DYN_DEBUG) && DYN_DEBUG const struct DYNlimit * const dl_end = dynlimits->limit + dynlimits->used; const struct DYNlimit * dl = dynlimits->limit; DBGPRINT (stderr,"\n%s: Dynlimits %p; size %d used %d limits %p\n", title,dynlimits,dynlimits->size,dynlimits->used,dynlimits->limit); for(;dl != dl_end; dl++) DBGPRINT (stderr," [%p,%p]\n",dl->begin,dl->end); #endif } /* check to see if the address is within limits */ int within_DYNlimitsP(const char * addr, const struct DYNlimits * dynlimits) { const struct DYNlimit * const dl_end = dynlimits->limit + dynlimits->used; const struct DYNlimit * dl = dynlimits->limit; debug_print_DYNlimits(dynlimits,"within_DYNlimitsP"); DBGPRINT (stderr,"addr %p\n",addr); for(;dl != dl_end; dl++) if( addr >= dl->begin && addr < dl->end ) return 1; DBGPRINT (stderr,"not found addr %p\n",addr); return 0; } static void add_to_dynlimits(struct DYNlimits * dynlimits, const void * begin, const void * end) { if( dynlimits->size == 0 ) { /* Initial allocation */ dynlimits->limit = caml_stat_alloc(sizeof(struct DYNlimit) * DYNlimits_init_alloc); dynlimits->used = 0; dynlimits->size = DYNlimits_init_alloc; } else if( dynlimits->size == dynlimits->used ) { /* Reallocate */ const int new_size = 2 * dynlimits->size; dynlimits->limit = caml_stat_resize(dynlimits->limit, sizeof(struct DYNlimit) * new_size); dynlimits->size = new_size; } { struct DYNlimit * dl = dynlimits->limit + dynlimits->used; dynlimits->used++; dl->begin = begin; dl->end = end; } debug_print_DYNlimits(dynlimits,"add_to_dynlimits"); } /* handle is the DL handle entryname is the name of the entry, a string like "camlTest_dyn1__entry" We locate in the shared object represented by [handle] the symbol whose name is [entryname] with "entry" suffix replaced by [new_suffix] */ static void * locate_suffixed_symbol(void * handle, const char * entryname, const char * new_suffix) { const char entry_suffix [] = "entry"; char new_name[256]; char *p; if ( strlen(entryname) + strlen(new_suffix) >= sizeof(new_name)-2 ) caml_fatal_error_arg("ndl.c: entryname `%s' is too long\n",entryname); strncpy(new_name,entryname,sizeof(new_name)-2); new_name[sizeof(new_name)-1] = '\0'; p = new_name + strlen(new_name) - (sizeof(entry_suffix)-1); if( strcmp(p,entry_suffix) != 0 ) caml_fatal_error_arg( "ndl.c: wrong entryname `%s', should end in `entry'\n", entryname); strcpy(p,new_suffix); return dlsym (handle, new_name); } static struct custom_operations dso_handle_ops = { "dsohandle", NULL, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default }; value dso_handle_new (void *handle) { value wrapper = alloc_custom (&dso_handle_ops, sizeof (void *), 0, 1); *((void **)Data_custom_val (wrapper)) = handle; return wrapper; } extern void shared_dyn_post_process (void); static value * natdynlink_exn = NULL; #define Link_error_Tag 0 #define Init_entry_not_found_Tag 1 #define Caml_entry_not_found_Tag 2 #define Fini_entry_not_found_Tag 3 #define Success_Tag 0 #define Entry_Exn_Tag 1 static void fail (const char *err, int tag) Noreturn; static void fail (const char *err, int tag) { value res = alloc_small (1, tag); Store_field (res, 0, copy_string (err)); if (NULL == natdynlink_exn) natdynlink_exn = caml_named_value ("Natdynlink.Error"); raise_with_arg (*natdynlink_exn, res); } static void * check_null(void * handle, void * addr) { if (NULL == addr) { const char *err = dlerror (); dlclose (handle); fail (err, Caml_entry_not_found_Tag); } return addr; } value ml_natdynload (value private, value filename_v, value entryname_v) /* ML */ { CAMLparam3 (private, filename_v, entryname_v); CAMLlocal3 (result, err, tup); value (*caml_shared_entry) (void); void (*caml_shared_fini) (void); void (*caml_shared_init) (void); void * frametable; char *filename = String_val (filename_v); char *entryname = String_val (entryname_v); void *handle; handle = (private == Val_true) ? dlopen (filename, RTLD_NOW) : dlopen (filename, RTLD_NOW | RTLD_GLOBAL); if (NULL == handle) fail (dlerror (), Link_error_Tag); caml_shared_entry = check_null(handle, dlsym (handle, entryname)); DBGPRINT (stderr,"\nentry name %s: %p\n",entryname,caml_shared_entry); frametable = check_null(handle, locate_suffixed_symbol(handle,entryname,"frametable")); /* TODO: checks for duplicates: check frametable against existing entries in caml_dyn_frametable. This is not too critical though... */ if( caml_dyn_frametable == NULL ) { /* Allocate a new caml_dyn_frametable */ caml_dyn_frametable = caml_stat_alloc(2 * sizeof(caml_dyn_frametable[0])); caml_dyn_frametable[0] = frametable; caml_dyn_frametable[1] = NULL; } else { /* reallocate the caml_dyn_frametable */ int count = 0; for (count = 0; caml_dyn_frametable[count] != 0; count++) ; caml_dyn_frametable = caml_stat_resize(caml_dyn_frametable, (count+1+1) * sizeof(caml_dyn_frametable[0])); caml_dyn_frametable[count] = frametable; caml_dyn_frametable[count+1] = NULL; } init_frame_descriptors(); add_to_dynlimits(&caml_static_data_limits, check_null(handle, locate_suffixed_symbol(handle,entryname, "data_begin")), check_null(handle, locate_suffixed_symbol(handle,entryname, "data_end"))); #if 0 caml_shared_fini = check_null(handle, dlsym (handle, "fini_shared")); caml_shared_init = check_null(handle, dlsym (handle, "init_shared")); caml_shared_init (); shared_dyn_post_process (); #endif /* I cannot call caml_shared_entry directly, as in err = caml_shared_entry (); Becasue the shared entry is a CAML program and needs a properly set up frame. So, I need to invoke it as a call-back into OCaml from C. So, I need to use caml_callback_exn. However, the latter needs a closure as its first argument. But all I have is the code pointer. The examination of asmrun/i386.S shows however that a mere reference cell suffices. The second argument to caml_callback_exn is an argument to the closure. We use 0 -- no argument is needed. That doesn't affect the stack, see again asmrun/i386.S */ err = caml_callback_exn((value)(&caml_shared_entry), 0); /* TODO: change the of natdynlink so I could return the value of the plusgin directly. It woulbe be unit anyway A better invocation: make a tail call to caml_shared_entry. In that case, there will be no need to mess with setting up a frame */ if (Is_exception_result (err)) { tup = alloc_tuple (2); Store_field (tup, 0, dso_handle_new (handle)); Store_field (tup, 1, Extract_exception (err)); result = alloc_small (1, Entry_Exn_Tag); Field (result, 0) = tup; } else { result = alloc_small (1, Success_Tag); Store_field (result, 0, err); #if 0 Store_field (result, 0, dso_handle_new (handle)); #endif } CAMLreturn (result); }