/* A very simple dynaloader without error messages Copyright (C) 2000 Free Software Foundation, Inc. Principal Author: Steve Kemp Ports and stylistic changes by Reini Urban Time-stamp: "2000-02-29 21:05:20 rurban" This file is (not yet) part of GNU Emacs and similar to XEmacs dll.c GNU Emacs is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2, or (at your option) any later version. GNU Emacs is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. Reini: Just detected dll.c in xemacs. (from 98) This is easier and the system dependant stuff is FSF copyrighted and already accepted by RMS. */ #include #ifdef HAVE_UNISTD_H #include #endif #include "lisp.h" #ifndef NULL #define NULL (void *)0 #endif typedef int (*GET_N_EXTS)(void); typedef struct Lisp_Subr* (*GET_EXT)(int); /* Use the various native sun style dlopen() calls for every platform, otherwise fall back to the GNU Dld library. Error handling is missing for now, we just return nil. On some platforms we ignore dlclose for simplicity. Define all platform calls with this simple dlopen signature: void *dlopen (const char *file, int mode); void *dlsym (void *handle, const char *name); int dlclose (void *handle); Natively supported dlopen platforms: Solaris2, various BSD's, VM/ESA, HP-UX */ ^L #if defined(SOLARIS2) || defined(BSD_SYSTEM) #include /* ?? */ #define DLOPEN_MODE RTLD_LAZY #endif ^L #if defined(VMESA) /* VM/ESA is dlopen compatible */ #include #define DLOPEN_MODE #define dlopen (path, mode) dlopen (path) #define dlclose (handle) #endif ^L /* Version check according to Jeff Okamoto . Thanks. */ #if defined(HPUX) && (HPUX >= 11) #include #define DLOPEN_MODE RTLD_LAZY #endif ^L #if defined(WINDOWSNT) || defined(CYGWIN) /* don't know yet if for Win95/98 also */ #include #define DLOPEN_MODE LOAD_WITH_ALTERED_SEARCH_PATH #define dlopen (path, mode) (void *)LoadLibraryExA (path, NULL, DLOPEN_MODE) #define dlsym (handle, name) (void *)GetProcAddressA ((HINSTANCE)handle, name) #define dlclose (handle) FreeLibraryA (handle) #endif #if defined(BEOS) #define DLOPEN_MODE #include #include #include #include #define dlopen (path, mode) (void *)load_add_on(path) void * dlsym (void *handle, char *name) { void *obj = 0; #ifdef DLSYM_NEEDS_UNDERSCORE name = form("_%s", name); #endif get_image_symbol((image_id) handle,name,B_SYMBOL_TYPE_TEXT, (void **) &obj); return obj; } #define dlclose (handle) #endif /* BEOS */ ^L #if defined (HPUX) && (HPUX < 11) #include #define DLOPEN_MODE BIND_DEFERRED /* BIND_IMMEDIATE|BIND_VERBOSE */ /* DCE is said to makes problems deferred */ char *dl_prepend_underscore (char *s); char * dl_prepend_underscore (char *s) { int len = strlen (s); s = (char *) realloc (len+2); memmove (&s[1], &s[0], l+1); return s; } void * dlopen (char *path, int mode) { obj = shl_load(filename, DLOPEN_MODE, 0L); if ( obj ) return (void *)obj; else return NULL; } void * dlsym (void *handle, char *name) { shl_t obj = (shl_t) libhandle; void *addr = 0; int status, errno; #ifdef __hp9000s300 /* only the series 300 needed underscores */ name = dl_prepend_underscore (name); #endif errno = 0; status = shl_findsym(&obj, name, TYPE_PROCEDURE, &addr); if (status == -1 && errno == 0) { status = shl_findsym(&obj, name, TYPE_DATA, &addr); } if (status == -1) return NULL; else return addr; } int dlclose (handle) void *handle; { return 0; } #endif /* old HP-UX */ ^L #if defined(RHAPSODY) || ( defined(NEXT) && (NS_TARGET_MAJOR >= 4) ) #define DLOPEN_MODE #if !defined(RHAPSODY) #undef environ #endif #import #endif void * dlopen (char *path, int mode /* is ignored */) { int result; NSObjectFileImage file; NSModule handle = NULL; result = NSCreateObjectFileImageFromFile (path, &file); if (result != NSObjectFileImageSuccess) return NULL; else handle = NSLinkModule (file, path, TRUE); return (void *) handle; } void * dlsym (handle, name) void *handle; char *name; { void *addr; if (NSIsSymbolNameDefined (name)) addr = NSAddressOfSymbol (NSLookupAndBindSymbol (name)); else addr = NULL; return addr; } int dlclose (handle) void *handle; { return 0; } #endif /* Rhapsody, new Next */ #if defined(NEXT) && (NS_TARGET_MAJOR <= 3) #include #define DLOPEN_MODE #define DLSYM_NEEDS_UNDERSCORE char *dl_prepend_underscore (char *s); char * dl_prepend_underscore (char *s) { int len = strlen (s); s = (char *) realloc (len+2); memmove (&s[1], &s[0], l+1); return s; } /* do we really need error handling on next? */ #ifdef DLD_ERROR #include NXStream * OpenError (void) { return NXOpenMemory ((char *) 0, 0, NX_WRITEONLY); } void TransferError (NXStream *s) { char *buffer; int len, maxlen; if ( dl_last_error ) free (dl_last_error); NXGetMemoryBuffer (s, &buffer, &len, &maxlen); dl_last_error = (char *) malloc (len); strcpy (dl_last_error, buffer); } void CloseError (NXStream *s) { if ( s ) NXCloseMemory (s, NX_FREEBUFFER); } #endif /* DLD_ERROR */ static void * dlopen (char *path, int mode /* mode is ignored */) { int rld_success; void *result; #ifdef DLD_ERROR NXStream *nxerr; nxerr = OpenError(); #else void *nxerr = NULL; #endif /* what if we pass a NULL error stream to rld_load? */ rld_success = rld_load (nxerr, (struct mach_header **)0, path, /* ?? */ (const char *) 0); if (rld_success) { result = path; } else { #ifdef DLD_ERROR Transfererror (nxerr); #endif result = NULL; } #ifdef DLD_ERROR CloseError (nxerr); #endif return result; } void * dlsym (handle, name) void *handle; char *name; { #ifdef DLD_ERROR NXStream *nxerr = OpenError(); #else void *nxerr = NULL; #endif unsigned long addr = 0; #ifdef DLSYM_NEEDS_UNDERSCORE name = dl_prepend_underscore (name); #endif if ( !rld_lookup (nxerr,name,&addr) ) #ifdef DLD_ERROR TransferError (nxerr); CloseError (nxerr); #endif return (void*) addr; } #endif /* old Next <= 3 */ ^L /* Last chance. If no native dlopen() is available use Dld: GNU dld-3.3 is available for VAX, Sun 3, SPARCstation, Sequent Symmetry, Atari ST, and Linux. */ /* this could go somewhere else as well */ #if !defined(DLOPEN_MODE) && ( defined(HAVE_GNUDLD) || defined(linux) || defined(AMIGOS) || defined(Sparc) ) #include void * dlopen (char *path, int mode) { if ( dld_link (path) ) return (void *)path; else return NULL; } #define dlsym (handle, name) (void *)dld_get_func (name) /* handle is really a string */ #define dlclose (handle) dld_unlink_by_file ((char *) handle, 0) #endif /* HAVE_GNUDLD */ ^L #ifdef AIX /* gnu-dld seems to appropriate also. */ /* AIX FAQ 2.26: Where can I find dlopen, dlclose, and dlsym for AIX? An implementation of these dynamic code loading functions was written by Jens-Uwe Mager and can be found at From: Gary R. Hook Starting with AIX 4.2 a dlopen et. al. are included in the base OS in the libdl.a library. Under AIX 4.1 this is available as SLHS (Shared Library Hookable Symbols) as APAR IX IX71849 for the runtime package and APAR IX IX72973 for the development tools. */ error ("(load-dynamic-library) not yet defined for AIX"); #endif /* AIX */ /*******************************************************************************/ DEFUN("load-dynamic-library", Fload_dynamic_library, Sload_dynamic_library, 1, 1, 0, "Returns t if the dynamic library of LIBRARY succeeded.\n\ This function allows the C core API of Emacs to be extended,\n\ dynamically at runtime.") (library) Lisp_Object library; { GET_N_EXTS nFunctions; GET_EXT getFunction; Lisp_Object sym; struct Lisp_Subr *sub; struct Lisp_Subr *copySub; int i; int count = 0; void *libhandle; char *filename; #if defined(HAVE_DLD) static int dld_initialized = 0; #endif CHECK_STRING (library, 0); filename = XSTRING(library)->data; last_fname = filename; #if defined(HAVE_DLD) if ( !dld_initialized ) { /* dld need the emacs path */ dld_init (argv[0]); /* is this know here or somewhere globally stored away */ dld_initialized = 1; } #endif libhandle = dlopen (filename, DLOPEN_MODE); if ( !libhandle ) { error ("Couldn't load library: %s", filename); return (Qnil); } nFunctions = (GET_N_EXTS) dlsym (libhandle, "GetNFunctions"); if ( !nFunctions ) { dlclose (libhandle); error ("Couldn't find function \"GetNFunctions\""); return Qnil; } /* Find the number of exported functions. */ count = nFunctions (); /* Get the address of the procedure to return a particular defun. */ getFunction = (GET_EXTS) dlsym (libhandle, "GetNthFunction"); if ( !getFunction ) { dlclose (libhandle); error ("Couldn't find function \"GetNthFunction\""); return Qnil; } /* Register each function. */ for( i = 0; i < count; i++ ) { sub = (struct Lisp_Subr *) getFunction (i); copySub = (struct Lisp_Subr *) malloc (sizeof ( struct Lisp_Subr ) ); copySub->size = sub->size; copySub->function = sub->function; copySub->min_args = sub->min_args; copySub->max_args = sub->max_args; copySub->prompt = sub->prompt; copySub->doc = sub->doc; copySub->symbol_name = sub->symbol_name; defsubr( copySub ); } /* Better return the number of found functions or nil. */ return Qt; } DEFUN("unload-dynamic-library", Funload_dynamic_library, Sunload_dynamic_library, 1, 1, 0, "Returns t if the dynamic library was successfully unloaded, otherwise nil") (library) Lisp_Object library; { void* libhandle; CHECK_STRING (library, 0); /* hmm? */ libhandle = dlopen (XSTRING(library)->data, DLOPEN_MODE); dlclose (libhandle); } void syms_of_dynaload () { defsubr (&Sload_dynamic_library); defsubr (&Sunload_dynamic_library); }