diff --git a/lib/misc/bitstring.c b/lib/misc/bitstring.c index 5fa5120..87d8e41 100644 --- a/lib/misc/bitstring.c +++ b/lib/misc/bitstring.c @@ -564,5 +564,5 @@ void elk_init_lib_bitstring() { Def_Prim(P_Bitstring_Andnot, "bitstring-andnot!", 2, 2, EVAL); Def_Prim(P_Bitstring_Xor, "bitstring-xor!", 2, 2, EVAL); Def_Prim(P_Substring_Move, "bitstring-substring-move!", 5, 5, EVAL); - P_Provide (Intern ("bitstring.so")); + P_Provide (Intern ("bitstring.la")); } diff --git a/lib/misc/gdbm.c b/lib/misc/gdbm.c index 006a66a..b0f9e7d 100644 --- a/lib/misc/gdbm.c +++ b/lib/misc/gdbm.c @@ -288,5 +288,5 @@ void elk_init_lib_gdbm () { T_Gdbm_fh = Define_Type (0, "gdbm-file", NOFUNC, sizeof (struct S_gdbm_fh), Gdbm_fh_Equal, Gdbm_fh_Equal, Gdbm_fh_Print, NOFUNC); - P_Provide (Intern ("gdbm.so")); + P_Provide (Intern ("gdbm.la")); } diff --git a/lib/misc/hack.c b/lib/misc/hack.c index 55e401f..5ec017a 100644 --- a/lib/misc/hack.c +++ b/lib/misc/hack.c @@ -42,5 +42,5 @@ static Object P_Hack_Procedure_Environment (Object p, Object e) { void elk_init_lib_hack () { Define_Primitive (P_Hack_Procedure_Environment, "hack-procedure-environment!", 2, 2, EVAL); - P_Provide (Intern ("hack.so")); + P_Provide (Intern ("hack.la")); } diff --git a/lib/misc/record.c b/lib/misc/record.c index 6a5fb86..3b2caa6 100644 --- a/lib/misc/record.c +++ b/lib/misc/record.c @@ -170,5 +170,5 @@ void elk_init_lib_record () { Def_Prim (P_Record_Type, "record-type-descriptor", 1, 1, EVAL); Def_Prim (P_Record_Values, "record-values", 1, 1, EVAL); Def_Prim (P_Make_Record, "make-record", 2, 2, EVAL); - P_Provide (Intern ("record.so")); + P_Provide (Intern ("record.la")); } diff --git a/lib/misc/regexp.c b/lib/misc/regexp.c index 7a32cd6..be6268e 100644 --- a/lib/misc/regexp.c +++ b/lib/misc/regexp.c @@ -252,5 +252,5 @@ void elk_init_lib_regexp() { Def_Prim(P_Match_End, "regexp-match-end", 2, 2, EVAL); P_Provide(Intern(":regular-expressions")); #endif - P_Provide(Intern ("regexp.so")); + P_Provide(Intern ("regexp.la")); } diff --git a/lib/misc/struct.c b/lib/misc/struct.c index 2aa013d..8255be8 100644 --- a/lib/misc/struct.c +++ b/lib/misc/struct.c @@ -140,5 +140,5 @@ void elk_init_lib_struct () { Define_Primitive (P_Structure_Ref, "structure-ref", 3, 3, EVAL); Define_Primitive (P_Structure_Set, "structure-set!", 4, 4, EVAL); Define_Primitive (P_Make_Structure, "make-structure", 2, 2, EVAL); - P_Provide (Intern ("struct.so")); + P_Provide (Intern ("struct.la")); } diff --git a/lib/unix/unix.c b/lib/unix/unix.c index 90002df..b474919 100644 --- a/lib/unix/unix.c +++ b/lib/unix/unix.c @@ -64,5 +64,5 @@ void Check_Result_Vector(Object x, unsigned int len) { } void elk_init_unix_unix() { - P_Provide(Intern("unix.so")); + P_Provide(Intern("unix.la")); } diff --git a/lib/xlib/xinit.c b/lib/xlib/xinit.c index 4a74681..1a1bd53 100644 --- a/lib/xlib/xinit.c +++ b/lib/xlib/xinit.c @@ -57,7 +57,7 @@ void elk_init_xlib_init () { "xlib-release-5-or-later?", 0, 0, EVAL); Define_Primitive (P_Xlib_Release_6_Or_Laterp, "xlib-release-6-or-later?", 0, 0, EVAL); - P_Provide (Intern ("xlib.so")); + P_Provide (Intern ("xlib.la")); } #if defined(XLIB_RELEASE_5_OR_LATER) && (defined(sun) || defined(__sun__)) &&\ diff --git a/lib/xwidgets/motif/init.c b/lib/xwidgets/motif/init.c index 6b75de6..ee29af3 100644 --- a/lib/xwidgets/motif/init.c +++ b/lib/xwidgets/motif/init.c @@ -31,5 +31,5 @@ #include "scheme.h" void elk_init_motif_init () { - P_Provide (Intern ("motif-widgets.so")); + P_Provide (Intern ("motif-widgets.la")); } diff --git a/lib/xwidgets/xaw/init.c b/lib/xwidgets/xaw/init.c index 7ec06be..7c312bb 100644 --- a/lib/xwidgets/xaw/init.c +++ b/lib/xwidgets/xaw/init.c @@ -31,5 +31,5 @@ #include "scheme.h" void elk_init_xaw_init () { - P_Provide (Intern ("xaw-widgets.so")); + P_Provide (Intern ("xaw-widgets.la")); } diff --git a/lib/xwidgets/xtinit.c b/lib/xwidgets/xtinit.c index 078dfac..bf0142a 100644 --- a/lib/xwidgets/xtinit.c +++ b/lib/xwidgets/xtinit.c @@ -73,5 +73,5 @@ void elk_init_xt_init () { Define_Primitive (P_Xt_Release_6_Or_Laterp, "xt-release-6-or-later?", 0, 0, EVAL); XtToolkitInitialize (); - P_Provide (Intern ("xt.so")); + P_Provide (Intern ("xt.la")); } diff --git a/scm/bitstring.scm b/scm/bitstring.scm index 5dc8b39..4c386dd 100644 --- a/scm/bitstring.scm +++ b/scm/bitstring.scm @@ -2,7 +2,7 @@ ;;; ;;; The Scheme layer of the bitstring extension. -(require 'bitstring.so) +(require 'bitstring.la) (define (bitstring-copy b) (let ((new (make-bitstring (bitstring-length b) #f))) diff --git a/scm/gdbmtest.scm b/scm/gdbmtest.scm index cf696fb..14b6e64 100644 --- a/scm/gdbmtest.scm +++ b/scm/gdbmtest.scm @@ -4,7 +4,7 @@ ;;; Contributed by Martin Stut. -(require 'gdbm.so) +(require 'gdbm.la) (let ((gf (gdbm-open 'test.gdbm 1024 'create)) (last "nothing")) (if (not gf) diff --git a/scm/oops.scm b/scm/oops.scm index d362ab0..33caf1a 100644 --- a/scm/oops.scm +++ b/scm/oops.scm @@ -2,7 +2,7 @@ ;;; ;;; A simple `OOPS' package -(require 'hack.so) +(require 'hack.la) (provide 'oops) diff --git a/scm/record.scm b/scm/record.scm index 5ce0208..805f7fd 100644 --- a/scm/record.scm +++ b/scm/record.scm @@ -2,7 +2,7 @@ ;;; ;;; The Scheme layer of the record extension. -(require 'record.so) +(require 'record.la) (define (record-field-index name fields) (let loop ((fields fields) (index 0)) diff --git a/scm/regexp.scm b/scm/regexp.scm index a172158..a95cc11 100644 --- a/scm/regexp.scm +++ b/scm/regexp.scm @@ -3,7 +3,7 @@ ;;; The Scheme layer of the regexp extension is (almost) empty for now. ;;; It mainly exists to enable use of "(require 'regexp)". -(require 'regexp.so) +(require 'regexp.la) (define (describe-regexp r) (format #t "a regular expression.~%") diff --git a/scm/struct.scm b/scm/struct.scm index 66277c4..31f05b5 100644 --- a/scm/struct.scm +++ b/scm/struct.scm @@ -10,7 +10,7 @@ ;;; ;;; slot = slot-name or (slot-name initial-value) -(require 'struct.so) +(require 'struct.la) (define-macro (define-structure name . slot-descr) (internal-define-structure name slot-descr #t)) diff --git a/scm/unix.scm b/scm/unix.scm index 768b161..47129b5 100644 --- a/scm/unix.scm +++ b/scm/unix.scm @@ -4,7 +4,7 @@ (require 'record) (require 'recordutil) -(require 'unix.so) +(require 'unix.la) (define-record-type stat (type mode ino dev nlink uid gid size atime mtime ctime)) diff --git a/scm/xlib.scm b/scm/xlib.scm index 8644d79..c547017 100644 --- a/scm/xlib.scm +++ b/scm/xlib.scm @@ -2,7 +2,7 @@ ;;; ;;; The Scheme part of the Xlib extension. -(require 'xlib.so) +(require 'xlib.la) (define (create-window . args) (apply-with-keywords diff --git a/scm/xwidgets.scm b/scm/xwidgets.scm index 52a87c2..cafc653 100644 --- a/scm/xwidgets.scm +++ b/scm/xwidgets.scm @@ -5,8 +5,8 @@ (define widgets (if (feature? 'motif) 'motif 'xaw)) (require 'xlib) -(require 'xt.so (string->symbol (format #f "~a-xt.so" widgets))) -(require (string->symbol (format #f "~a-widgets.so" widgets))) +(require 'xt.la (string->symbol (format #f "~a-xt.la" widgets))) +(require (string->symbol (format #f "~a-widgets.la" widgets))) (provide 'xwidgets) diff --git a/src/load.c b/src/load.c index a9a9023..e18ef38 100644 --- a/src/load.c +++ b/src/load.c @@ -97,7 +97,7 @@ void Check_Loadarg (Object x) { f = Car (tail); if (TYPE(f) != T_Symbol && TYPE(f) != T_String) Wrong_Type_Combination (f, "string or symbol"); - if (!Has_Suffix (f, ".so")) + if (!Has_Suffix (f, ".la")) Primitive_Error ("~s: not an object file", f); } } @@ -112,13 +112,13 @@ Object General_Load (Object what, Object env) { Switch_Environment (env); Check_Loadarg (what); if (TYPE(what) == T_Pair) { - if (Has_Suffix (Car (what), ".so")) + if (Has_Suffix (Car (what), ".la")) #ifdef CAN_LOAD_LIB Load_Library (what) #endif ; } - else if (Has_Suffix (what, ".so")) + else if (Has_Suffix (what, ".la")) #ifdef CAN_LOAD_LIB Load_Library (Cons (what, Null)) #endif diff --git a/src/loadlib.c b/src/loadlib.c index 583b4c6..47c50f5 100644 --- a/src/loadlib.c +++ b/src/loadlib.c @@ -37,17 +37,19 @@ #include #include -#if defined(HAVE_MACH_O_DYLD_H) +#if defined (HAVE_MACH_O_DYLD_H) # include -#elif defined(HAVE_DL_DLOPEN) -# if defined(HAVE_DLFCN_H) +#elif defined (WIN32) +# include +#elif defined (HAVE_DL_DLOPEN) +# if defined (HAVE_DLFCN_H) # include # endif -# if defined(HAVE_SYS_DL_H) +# if defined (HAVE_SYS_DL_H) # include # endif -#elif defined(HAVE_DL_SHL_LOAD) -# if defined(HAVE_DL_H) +#elif defined (HAVE_DL_SHL_LOAD) +# if defined (HAVE_DL_H) # include # endif #endif @@ -57,25 +59,25 @@ extern void Free_Symbols (SYMTAB *); extern void Call_Initializers (SYMTAB *, char *, int); -void Dlopen_File (char *fn) { +void Dlopen_File (char *obj) { SYM *sp; -#if defined(HAVE_DL_DYLD) +#if defined (HAVE_DL_DYLD) NSModule handle; NSObjectFileImage image; NSObjectFileImageReturnCode ret; if (Verb_Load) - printf ("[dyld %s]\n", fn); + printf ("[dyld %s]\n", obj); - ret = NSCreateObjectFileImageFromFile (fn, &image); + ret = NSCreateObjectFileImageFromFile (obj, &image); if (ret != NSObjectFileImageSuccess) Primitive_Error ("could not map `~%~s'", - Make_String (fn, strlen (fn))); + Make_String (obj, strlen (obj))); /* Open the dynamic module */ - handle = NSLinkModule (image, fn, NSLINKMODULE_OPTION_RETURN_ON_ERROR); + handle = NSLinkModule (image, obj, NSLINKMODULE_OPTION_RETURN_ON_ERROR); if (!handle) { NSLinkEditErrors errors; @@ -92,31 +94,31 @@ void Dlopen_File (char *fn) { /* NSUnLinkModule (handle, FALSE); */ -#elif defined(WIN32) +#elif defined (WIN32) void *handle; if (Verb_Load) - printf ("[dll %s]\n", fn); + printf ("[dll %s]\n", obj); - handle = LoadLibrary (fn); + handle = LoadLibrary (obj); if (handle == NULL) { Primitive_Error ("LoadLibrary failed on ~%~s", - Make_String (fn, strlen (fn))); + Make_String (obj, strlen (obj))); } -#elif defined(HAVE_DL_DLOPEN) +#elif defined (HAVE_DL_DLOPEN) void *handle; if (Verb_Load) - printf ("[dlopen %s]\n", fn); + printf ("[dlopen %s]\n", obj); -#if defined(RTLD_GLOBAL) - handle = dlopen (fn, RTLD_NOW | RTLD_GLOBAL); -#elif defined(DL_GLOBAL) - handle = dlopen (fn, DL_NOW | DL_GLOBAL); +#if defined (RTLD_GLOBAL) + handle = dlopen (obj, RTLD_NOW | RTLD_GLOBAL); +#elif defined (DL_GLOBAL) + handle = dlopen (obj, DL_NOW | DL_GLOBAL); #else - handle = dlopen (fn, 0); + handle = dlopen (obj, 0); #endif if (handle == NULL) { @@ -125,13 +127,13 @@ void Dlopen_File (char *fn) { Make_String (err, strlen (err))); } -#elif defined(HAVE_DL_SHL_LOAD) +#elif defined (HAVE_DL_SHL_LOAD) shl_t handle; if (Verb_Load) - printf ("[shl_load %s]\n", fn); + printf ("[shl_load %s]\n", obj); - handle = shl_load (fn, BIND_IMMEDIATE | BIND_NONFATAL, NULL); + handle = shl_load (obj, BIND_IMMEDIATE | BIND_NONFATAL, NULL); if (handle == NULL) { char *err = strerror (errno); @@ -146,22 +148,22 @@ void Dlopen_File (char *fn) { if (The_Symbols) Free_Symbols (The_Symbols); - The_Symbols = Open_File_And_Snarf_Symbols (fn); + The_Symbols = Open_File_And_Snarf_Symbols (obj); for (sp = The_Symbols->first; sp; sp = sp->next) { -#if defined(HAVE_DL_DYLD) +#if defined (HAVE_DL_DYLD) NSSymbol sym = NSLookupSymbolInModule (handle, sp->name); if (sym) sp->value = (unsigned long int)(intptr_t)NSAddressOfSymbol (sym); -#elif defined(WIN32) - sp->value = (void *)GetProcAddress (handle, (MYCHAR *)sym); +#elif defined (WIN32) + sp->value = (unsigned long int)(intptr_t)GetProcAddress (handle, sp->name); -#elif defined(HAVE_DL_DLOPEN) +#elif defined (HAVE_DL_DLOPEN) /* dlsym() may fail for symbols not exported by object file; * this can be safely ignored. */ sp->value = (unsigned long int)(intptr_t)dlsym (handle, sp->name); -#elif defined(HAVE_DL_SHL_LOAD) +#elif defined (HAVE_DL_SHL_LOAD) void *sym; shl_findsym (&handle, "share", TYPE_UNDEFINED, &sym); sp->value = (unsigned long int)(intptr_t)sym; @@ -173,6 +175,7 @@ void Dlopen_File (char *fn) { } static void Load_Lib (Object libs) { + char *lib = NULL; Object port, name; if (Nullp (libs)) @@ -183,10 +186,40 @@ static void Load_Lib (Object libs) { GC_Node2; port = name = Null; GC_Link2 (port, name); + + /* Read the libtool object to find our library's name */ port = General_Open_File (Car (libs), P_INPUT, Var_Get (V_Load_Path)); - name = PORT(port)->name; - Dlopen_File (STRING(name)->data); + while (!feof (PORT(port)->file)) { + char buffer [BUFSIZ], *dlname, *eol, *path; + if (fgets (buffer, BUFSIZ, PORT(port)->file) == NULL) + break; + buffer[BUFSIZ-1] = '\0'; + /* Our line starts with dlname='... */ + if (strncmp (buffer, "dlname", 6)) + continue; + dlname = index (buffer, '\''); + if (dlname == NULL) + continue; + dlname++; + eol = rindex (buffer, '\''); + if (eol == NULL || eol == dlname) + continue; + *eol = '\0'; + path = strdup (STRING(PORT(port)->name)->data); + eol = rindex (path, '/'); + if (eol == NULL) + eol = path; + *eol = '\0'; + lib = malloc (strlen (path) + 1 + strlen (dlname) + 1); + sprintf (lib, "%s/%s", path, dlname); + free (path); + break; + } (void)P_Close_Input_Port (port); + + if (lib) + Dlopen_File (lib); + GC_Unlink; }