conservatory
/
elk
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

* Do not open .so files, but look for the libtool .la library instead and 

get the shared object's filename from it.


git-svn-id: svn://svn.zoy.org/elk/trunk@161 55e467fa-43c5-0310-a8a2-de718669efc6
This commit is contained in:
sam 2003-09-17 12:01:49 +00:00
parent d640876b57
commit 809443fb06
22 changed files with 91 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lib/misc/bitstring.c
View File

@ -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"));
}

2
lib/misc/gdbm.c
View File

@ -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"));
}

2
lib/misc/hack.c
View File

@ -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"));
}

2
lib/misc/record.c
View File

@ -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"));
}

2
lib/misc/regexp.c
View File

@ -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"));
}

2
lib/misc/struct.c
View File

@ -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"));
}

2
lib/unix/unix.c
View File

@ -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"));
}

2
lib/xlib/xinit.c
View File

@ -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__)) &&\

2
lib/xwidgets/motif/init.c
View File

@ -31,5 +31,5 @@
#include "scheme.h"
void elk_init_motif_init () {
P_Provide (Intern ("motif-widgets.so"));
P_Provide (Intern ("motif-widgets.la"));
}

2
lib/xwidgets/xaw/init.c
View File

@ -31,5 +31,5 @@
#include "scheme.h"
void elk_init_xaw_init () {
P_Provide (Intern ("xaw-widgets.so"));
P_Provide (Intern ("xaw-widgets.la"));
}

2
lib/xwidgets/xtinit.c
View File

@ -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"));
}

2
scm/bitstring.scm
View File

@ -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)))

2
scm/gdbmtest.scm
View File

@ -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)

2
scm/oops.scm
View File

@ -2,7 +2,7 @@
;;;
;;; A simple `OOPS' package
(require 'hack.so)
(require 'hack.la)
(provide 'oops)

2
scm/record.scm
View File

@ -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))

2
scm/regexp.scm
View File

@ -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.~%")

2
scm/struct.scm
View File

@ -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))

2
scm/unix.scm
View File

@ -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))

2
scm/xlib.scm
View File

@ -2,7 +2,7 @@
;;;
;;; The Scheme part of the Xlib extension.
(require 'xlib.so)
(require 'xlib.la)
(define (create-window . args)
(apply-with-keywords

4
scm/xwidgets.scm
View File

@ -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)

6
src/load.c
View File

@ -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

101
src/loadlib.c
View File

@ -37,17 +37,19 @@
#include <string.h>
#include <unistd.h>
#if defined(HAVE_MACH_O_DYLD_H)
#if defined (HAVE_MACH_O_DYLD_H)
# include <mach-o/dyld.h>
#elif defined(HAVE_DL_DLOPEN)
# if defined(HAVE_DLFCN_H)
#elif defined (WIN32)
# include <windows.h>
#elif defined (HAVE_DL_DLOPEN)
# if defined (HAVE_DLFCN_H)
# include <dlfcn.h>
# endif
# if defined(HAVE_SYS_DL_H)
# if defined (HAVE_SYS_DL_H)
# include <sys/dl.h>
# endif
#elif defined(HAVE_DL_SHL_LOAD)
# if defined(HAVE_DL_H)
#elif defined (HAVE_DL_SHL_LOAD)
# if defined (HAVE_DL_H)
# include <dl.h>
# 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;
}