* 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:
		
							parent
							
								
									d640876b57
								
							
						
					
					
						commit
						809443fb06
					
				| 
						 | 
					@ -564,5 +564,5 @@ void elk_init_lib_bitstring() {
 | 
				
			||||||
    Def_Prim(P_Bitstring_Andnot, "bitstring-andnot!",           2, 2, EVAL);
 | 
					    Def_Prim(P_Bitstring_Andnot, "bitstring-andnot!",           2, 2, EVAL);
 | 
				
			||||||
    Def_Prim(P_Bitstring_Xor,    "bitstring-xor!",              2, 2, EVAL);
 | 
					    Def_Prim(P_Bitstring_Xor,    "bitstring-xor!",              2, 2, EVAL);
 | 
				
			||||||
    Def_Prim(P_Substring_Move,   "bitstring-substring-move!",   5, 5, EVAL);
 | 
					    Def_Prim(P_Substring_Move,   "bitstring-substring-move!",   5, 5, EVAL);
 | 
				
			||||||
    P_Provide (Intern ("bitstring.so"));
 | 
					    P_Provide (Intern ("bitstring.la"));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -288,5 +288,5 @@ void elk_init_lib_gdbm () {
 | 
				
			||||||
    T_Gdbm_fh = Define_Type (0, "gdbm-file", NOFUNC,
 | 
					    T_Gdbm_fh = Define_Type (0, "gdbm-file", NOFUNC,
 | 
				
			||||||
        sizeof (struct S_gdbm_fh), Gdbm_fh_Equal, Gdbm_fh_Equal,
 | 
					        sizeof (struct S_gdbm_fh), Gdbm_fh_Equal, Gdbm_fh_Equal,
 | 
				
			||||||
        Gdbm_fh_Print, NOFUNC);
 | 
					        Gdbm_fh_Print, NOFUNC);
 | 
				
			||||||
    P_Provide (Intern ("gdbm.so"));
 | 
					    P_Provide (Intern ("gdbm.la"));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -42,5 +42,5 @@ static Object P_Hack_Procedure_Environment (Object p, Object e) {
 | 
				
			||||||
void elk_init_lib_hack () {
 | 
					void elk_init_lib_hack () {
 | 
				
			||||||
    Define_Primitive (P_Hack_Procedure_Environment,
 | 
					    Define_Primitive (P_Hack_Procedure_Environment,
 | 
				
			||||||
        "hack-procedure-environment!", 2, 2, EVAL);
 | 
					        "hack-procedure-environment!", 2, 2, EVAL);
 | 
				
			||||||
    P_Provide (Intern ("hack.so"));
 | 
					    P_Provide (Intern ("hack.la"));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -170,5 +170,5 @@ void elk_init_lib_record () {
 | 
				
			||||||
    Def_Prim (P_Record_Type,      "record-type-descriptor",   1, 1, EVAL);
 | 
					    Def_Prim (P_Record_Type,      "record-type-descriptor",   1, 1, EVAL);
 | 
				
			||||||
    Def_Prim (P_Record_Values,    "record-values",            1, 1, EVAL);
 | 
					    Def_Prim (P_Record_Values,    "record-values",            1, 1, EVAL);
 | 
				
			||||||
    Def_Prim (P_Make_Record,      "make-record",              2, 2, EVAL);
 | 
					    Def_Prim (P_Make_Record,      "make-record",              2, 2, EVAL);
 | 
				
			||||||
    P_Provide (Intern ("record.so"));
 | 
					    P_Provide (Intern ("record.la"));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -252,5 +252,5 @@ void elk_init_lib_regexp() {
 | 
				
			||||||
    Def_Prim(P_Match_End,     "regexp-match-end",         2, 2, EVAL);
 | 
					    Def_Prim(P_Match_End,     "regexp-match-end",         2, 2, EVAL);
 | 
				
			||||||
    P_Provide(Intern(":regular-expressions"));
 | 
					    P_Provide(Intern(":regular-expressions"));
 | 
				
			||||||
#endif
 | 
					#endif
 | 
				
			||||||
    P_Provide(Intern ("regexp.so"));
 | 
					    P_Provide(Intern ("regexp.la"));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -140,5 +140,5 @@ void elk_init_lib_struct () {
 | 
				
			||||||
    Define_Primitive (P_Structure_Ref,    "structure-ref",    3, 3, EVAL);
 | 
					    Define_Primitive (P_Structure_Ref,    "structure-ref",    3, 3, EVAL);
 | 
				
			||||||
    Define_Primitive (P_Structure_Set,    "structure-set!",   4, 4, EVAL);
 | 
					    Define_Primitive (P_Structure_Set,    "structure-set!",   4, 4, EVAL);
 | 
				
			||||||
    Define_Primitive (P_Make_Structure,   "make-structure",   2, 2, EVAL);
 | 
					    Define_Primitive (P_Make_Structure,   "make-structure",   2, 2, EVAL);
 | 
				
			||||||
    P_Provide (Intern ("struct.so"));
 | 
					    P_Provide (Intern ("struct.la"));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -64,5 +64,5 @@ void Check_Result_Vector(Object x, unsigned int len) {
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
void elk_init_unix_unix() {
 | 
					void elk_init_unix_unix() {
 | 
				
			||||||
    P_Provide(Intern("unix.so"));
 | 
					    P_Provide(Intern("unix.la"));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -57,7 +57,7 @@ void elk_init_xlib_init () {
 | 
				
			||||||
                        "xlib-release-5-or-later?",               0, 0, EVAL);
 | 
					                        "xlib-release-5-or-later?",               0, 0, EVAL);
 | 
				
			||||||
    Define_Primitive (P_Xlib_Release_6_Or_Laterp,
 | 
					    Define_Primitive (P_Xlib_Release_6_Or_Laterp,
 | 
				
			||||||
                        "xlib-release-6-or-later?",               0, 0, EVAL);
 | 
					                        "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__)) &&\
 | 
					#if defined(XLIB_RELEASE_5_OR_LATER) && (defined(sun) || defined(__sun__)) &&\
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -31,5 +31,5 @@
 | 
				
			||||||
#include "scheme.h"
 | 
					#include "scheme.h"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
void elk_init_motif_init () {
 | 
					void elk_init_motif_init () {
 | 
				
			||||||
    P_Provide (Intern ("motif-widgets.so"));
 | 
					    P_Provide (Intern ("motif-widgets.la"));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -31,5 +31,5 @@
 | 
				
			||||||
#include "scheme.h"
 | 
					#include "scheme.h"
 | 
				
			||||||
 | 
					
 | 
				
			||||||
void elk_init_xaw_init () {
 | 
					void elk_init_xaw_init () {
 | 
				
			||||||
    P_Provide (Intern ("xaw-widgets.so"));
 | 
					    P_Provide (Intern ("xaw-widgets.la"));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -73,5 +73,5 @@ void elk_init_xt_init () {
 | 
				
			||||||
    Define_Primitive (P_Xt_Release_6_Or_Laterp, "xt-release-6-or-later?",
 | 
					    Define_Primitive (P_Xt_Release_6_Or_Laterp, "xt-release-6-or-later?",
 | 
				
			||||||
        0, 0, EVAL);
 | 
					        0, 0, EVAL);
 | 
				
			||||||
    XtToolkitInitialize ();
 | 
					    XtToolkitInitialize ();
 | 
				
			||||||
    P_Provide (Intern ("xt.so"));
 | 
					    P_Provide (Intern ("xt.la"));
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -2,7 +2,7 @@
 | 
				
			||||||
;;;
 | 
					;;;
 | 
				
			||||||
;;; The Scheme layer of the bitstring extension.
 | 
					;;; The Scheme layer of the bitstring extension.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(require 'bitstring.so)
 | 
					(require 'bitstring.la)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (bitstring-copy b)
 | 
					(define (bitstring-copy b)
 | 
				
			||||||
  (let ((new (make-bitstring (bitstring-length b) #f)))
 | 
					  (let ((new (make-bitstring (bitstring-length b) #f)))
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -4,7 +4,7 @@
 | 
				
			||||||
;;; Contributed by Martin Stut.
 | 
					;;; Contributed by Martin Stut.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(require 'gdbm.so)
 | 
					(require 'gdbm.la)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(let ((gf (gdbm-open 'test.gdbm 1024 'create)) (last "nothing"))
 | 
					(let ((gf (gdbm-open 'test.gdbm 1024 'create)) (last "nothing"))
 | 
				
			||||||
     (if (not gf)
 | 
					     (if (not gf)
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -2,7 +2,7 @@
 | 
				
			||||||
;;;
 | 
					;;;
 | 
				
			||||||
;;; A simple `OOPS' package
 | 
					;;; A simple `OOPS' package
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(require 'hack.so)
 | 
					(require 'hack.la)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(provide 'oops)
 | 
					(provide 'oops)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -2,7 +2,7 @@
 | 
				
			||||||
;;;
 | 
					;;;
 | 
				
			||||||
;;; The Scheme layer of the record extension.
 | 
					;;; The Scheme layer of the record extension.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(require 'record.so)
 | 
					(require 'record.la)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (record-field-index name fields)
 | 
					(define (record-field-index name fields)
 | 
				
			||||||
  (let loop ((fields fields) (index 0))
 | 
					  (let loop ((fields fields) (index 0))
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -3,7 +3,7 @@
 | 
				
			||||||
;;; The Scheme layer of the regexp extension is (almost) empty for now.
 | 
					;;; The Scheme layer of the regexp extension is (almost) empty for now.
 | 
				
			||||||
;;; It mainly exists to enable use of "(require 'regexp)".
 | 
					;;; It mainly exists to enable use of "(require 'regexp)".
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(require 'regexp.so)
 | 
					(require 'regexp.la)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (describe-regexp r)
 | 
					(define (describe-regexp r)
 | 
				
			||||||
  (format #t "a regular expression.~%")
 | 
					  (format #t "a regular expression.~%")
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -10,7 +10,7 @@
 | 
				
			||||||
;;;
 | 
					;;;
 | 
				
			||||||
;;; slot  =  slot-name  or  (slot-name initial-value)
 | 
					;;; slot  =  slot-name  or  (slot-name initial-value)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(require 'struct.so)
 | 
					(require 'struct.la)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define-macro (define-structure name . slot-descr)
 | 
					(define-macro (define-structure name . slot-descr)
 | 
				
			||||||
  (internal-define-structure name slot-descr #t))
 | 
					  (internal-define-structure name slot-descr #t))
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -4,7 +4,7 @@
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(require 'record)
 | 
					(require 'record)
 | 
				
			||||||
(require 'recordutil)
 | 
					(require 'recordutil)
 | 
				
			||||||
(require 'unix.so)
 | 
					(require 'unix.la)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define-record-type stat (type mode ino dev nlink uid gid size
 | 
					(define-record-type stat (type mode ino dev nlink uid gid size
 | 
				
			||||||
			  atime mtime ctime))
 | 
								  atime mtime ctime))
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -2,7 +2,7 @@
 | 
				
			||||||
;;;
 | 
					;;;
 | 
				
			||||||
;;; The Scheme part of the Xlib extension.
 | 
					;;; The Scheme part of the Xlib extension.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(require 'xlib.so)
 | 
					(require 'xlib.la)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (create-window . args)
 | 
					(define (create-window . args)
 | 
				
			||||||
  (apply-with-keywords
 | 
					  (apply-with-keywords
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -5,8 +5,8 @@
 | 
				
			||||||
(define widgets (if (feature? 'motif) 'motif 'xaw))
 | 
					(define widgets (if (feature? 'motif) 'motif 'xaw))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(require 'xlib)
 | 
					(require 'xlib)
 | 
				
			||||||
(require 'xt.so (string->symbol (format #f "~a-xt.so" widgets)))
 | 
					(require 'xt.la (string->symbol (format #f "~a-xt.la" widgets)))
 | 
				
			||||||
(require (string->symbol (format #f "~a-widgets.so" widgets)))
 | 
					(require (string->symbol (format #f "~a-widgets.la" widgets)))
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(provide 'xwidgets)
 | 
					(provide 'xwidgets)
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -97,7 +97,7 @@ void Check_Loadarg (Object x) {
 | 
				
			||||||
        f = Car (tail);
 | 
					        f = Car (tail);
 | 
				
			||||||
        if (TYPE(f) != T_Symbol && TYPE(f) != T_String)
 | 
					        if (TYPE(f) != T_Symbol && TYPE(f) != T_String)
 | 
				
			||||||
            Wrong_Type_Combination (f, "string or symbol");
 | 
					            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);
 | 
					            Primitive_Error ("~s: not an object file", f);
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
| 
						 | 
					@ -112,13 +112,13 @@ Object General_Load (Object what, Object env) {
 | 
				
			||||||
    Switch_Environment (env);
 | 
					    Switch_Environment (env);
 | 
				
			||||||
    Check_Loadarg (what);
 | 
					    Check_Loadarg (what);
 | 
				
			||||||
    if (TYPE(what) == T_Pair) {
 | 
					    if (TYPE(what) == T_Pair) {
 | 
				
			||||||
        if (Has_Suffix (Car (what), ".so"))
 | 
					        if (Has_Suffix (Car (what), ".la"))
 | 
				
			||||||
#ifdef CAN_LOAD_LIB
 | 
					#ifdef CAN_LOAD_LIB
 | 
				
			||||||
            Load_Library (what)
 | 
					            Load_Library (what)
 | 
				
			||||||
#endif
 | 
					#endif
 | 
				
			||||||
            ;
 | 
					            ;
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
    else if (Has_Suffix (what, ".so"))
 | 
					    else if (Has_Suffix (what, ".la"))
 | 
				
			||||||
#ifdef CAN_LOAD_LIB
 | 
					#ifdef CAN_LOAD_LIB
 | 
				
			||||||
        Load_Library (Cons (what, Null))
 | 
					        Load_Library (Cons (what, Null))
 | 
				
			||||||
#endif
 | 
					#endif
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										101
									
								
								src/loadlib.c
								
								
								
								
							
							
						
						
									
										101
									
								
								src/loadlib.c
								
								
								
								
							| 
						 | 
					@ -37,17 +37,19 @@
 | 
				
			||||||
#include <string.h>
 | 
					#include <string.h>
 | 
				
			||||||
#include <unistd.h>
 | 
					#include <unistd.h>
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#if defined(HAVE_MACH_O_DYLD_H)
 | 
					#if defined (HAVE_MACH_O_DYLD_H)
 | 
				
			||||||
#   include <mach-o/dyld.h>
 | 
					#   include <mach-o/dyld.h>
 | 
				
			||||||
#elif defined(HAVE_DL_DLOPEN)
 | 
					#elif defined (WIN32)
 | 
				
			||||||
#   if defined(HAVE_DLFCN_H)
 | 
					#   include <windows.h>
 | 
				
			||||||
 | 
					#elif defined (HAVE_DL_DLOPEN)
 | 
				
			||||||
 | 
					#   if defined (HAVE_DLFCN_H)
 | 
				
			||||||
#       include <dlfcn.h>
 | 
					#       include <dlfcn.h>
 | 
				
			||||||
#   endif
 | 
					#   endif
 | 
				
			||||||
#   if defined(HAVE_SYS_DL_H)
 | 
					#   if defined (HAVE_SYS_DL_H)
 | 
				
			||||||
#       include <sys/dl.h>
 | 
					#       include <sys/dl.h>
 | 
				
			||||||
#   endif
 | 
					#   endif
 | 
				
			||||||
#elif defined(HAVE_DL_SHL_LOAD)
 | 
					#elif defined (HAVE_DL_SHL_LOAD)
 | 
				
			||||||
#   if defined(HAVE_DL_H)
 | 
					#   if defined (HAVE_DL_H)
 | 
				
			||||||
#       include <dl.h>
 | 
					#       include <dl.h>
 | 
				
			||||||
#   endif
 | 
					#   endif
 | 
				
			||||||
#endif
 | 
					#endif
 | 
				
			||||||
| 
						 | 
					@ -57,25 +59,25 @@
 | 
				
			||||||
extern void Free_Symbols (SYMTAB *);
 | 
					extern void Free_Symbols (SYMTAB *);
 | 
				
			||||||
extern void Call_Initializers (SYMTAB *, char *, int);
 | 
					extern void Call_Initializers (SYMTAB *, char *, int);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
void Dlopen_File (char *fn) {
 | 
					void Dlopen_File (char *obj) {
 | 
				
			||||||
    SYM *sp;
 | 
					    SYM *sp;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#if defined(HAVE_DL_DYLD)
 | 
					#if defined (HAVE_DL_DYLD)
 | 
				
			||||||
    NSModule handle;
 | 
					    NSModule handle;
 | 
				
			||||||
    NSObjectFileImage image;
 | 
					    NSObjectFileImage image;
 | 
				
			||||||
    NSObjectFileImageReturnCode ret;
 | 
					    NSObjectFileImageReturnCode ret;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    if (Verb_Load)
 | 
					    if (Verb_Load)
 | 
				
			||||||
        printf ("[dyld %s]\n", fn);
 | 
					        printf ("[dyld %s]\n", obj);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    ret = NSCreateObjectFileImageFromFile (fn, &image);
 | 
					    ret = NSCreateObjectFileImageFromFile (obj, &image);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    if (ret != NSObjectFileImageSuccess)
 | 
					    if (ret != NSObjectFileImageSuccess)
 | 
				
			||||||
        Primitive_Error ("could not map `~%~s'",
 | 
					        Primitive_Error ("could not map `~%~s'",
 | 
				
			||||||
                         Make_String (fn, strlen (fn)));
 | 
					                         Make_String (obj, strlen (obj)));
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    /* Open the dynamic module */
 | 
					    /* Open the dynamic module */
 | 
				
			||||||
    handle = NSLinkModule (image, fn, NSLINKMODULE_OPTION_RETURN_ON_ERROR);
 | 
					    handle = NSLinkModule (image, obj, NSLINKMODULE_OPTION_RETURN_ON_ERROR);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    if (!handle) {
 | 
					    if (!handle) {
 | 
				
			||||||
        NSLinkEditErrors errors;
 | 
					        NSLinkEditErrors errors;
 | 
				
			||||||
| 
						 | 
					@ -92,31 +94,31 @@ void Dlopen_File (char *fn) {
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    /* NSUnLinkModule (handle, FALSE); */
 | 
					    /* NSUnLinkModule (handle, FALSE); */
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#elif defined(WIN32)
 | 
					#elif defined (WIN32)
 | 
				
			||||||
    void *handle;
 | 
					    void *handle;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    if (Verb_Load)
 | 
					    if (Verb_Load)
 | 
				
			||||||
        printf ("[dll %s]\n", fn);
 | 
					        printf ("[dll %s]\n", obj);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    handle = LoadLibrary (fn);
 | 
					    handle = LoadLibrary (obj);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    if (handle == NULL) {
 | 
					    if (handle == NULL) {
 | 
				
			||||||
        Primitive_Error ("LoadLibrary failed on ~%~s",
 | 
					        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;
 | 
					    void *handle;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    if (Verb_Load)
 | 
					    if (Verb_Load)
 | 
				
			||||||
        printf ("[dlopen %s]\n", fn);
 | 
					        printf ("[dlopen %s]\n", obj);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#if defined(RTLD_GLOBAL)
 | 
					#if defined (RTLD_GLOBAL)
 | 
				
			||||||
    handle = dlopen (fn, RTLD_NOW | RTLD_GLOBAL);
 | 
					    handle = dlopen (obj, RTLD_NOW | RTLD_GLOBAL);
 | 
				
			||||||
#elif defined(DL_GLOBAL)
 | 
					#elif defined (DL_GLOBAL)
 | 
				
			||||||
    handle = dlopen (fn, DL_NOW | DL_GLOBAL);
 | 
					    handle = dlopen (obj, DL_NOW | DL_GLOBAL);
 | 
				
			||||||
#else
 | 
					#else
 | 
				
			||||||
    handle = dlopen (fn, 0);
 | 
					    handle = dlopen (obj, 0);
 | 
				
			||||||
#endif
 | 
					#endif
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    if (handle == NULL) {
 | 
					    if (handle == NULL) {
 | 
				
			||||||
| 
						 | 
					@ -125,13 +127,13 @@ void Dlopen_File (char *fn) {
 | 
				
			||||||
                         Make_String (err, strlen (err)));
 | 
					                         Make_String (err, strlen (err)));
 | 
				
			||||||
    }
 | 
					    }
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#elif defined(HAVE_DL_SHL_LOAD)
 | 
					#elif defined (HAVE_DL_SHL_LOAD)
 | 
				
			||||||
    shl_t handle;
 | 
					    shl_t handle;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    if (Verb_Load)
 | 
					    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) {
 | 
					    if (handle == NULL) {
 | 
				
			||||||
        char *err = strerror (errno);
 | 
					        char *err = strerror (errno);
 | 
				
			||||||
| 
						 | 
					@ -146,22 +148,22 @@ void Dlopen_File (char *fn) {
 | 
				
			||||||
    if (The_Symbols)
 | 
					    if (The_Symbols)
 | 
				
			||||||
        Free_Symbols (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) {
 | 
					    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);
 | 
					        NSSymbol sym = NSLookupSymbolInModule (handle, sp->name);
 | 
				
			||||||
        if (sym)
 | 
					        if (sym)
 | 
				
			||||||
            sp->value = (unsigned long int)(intptr_t)NSAddressOfSymbol (sym);
 | 
					            sp->value = (unsigned long int)(intptr_t)NSAddressOfSymbol (sym);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
#elif defined(WIN32)
 | 
					#elif defined (WIN32)
 | 
				
			||||||
        sp->value = (void *)GetProcAddress (handle, (MYCHAR *)sym);
 | 
					        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;
 | 
					        /* dlsym() may fail for symbols not exported by object file;
 | 
				
			||||||
         * this can be safely ignored. */
 | 
					         * this can be safely ignored. */
 | 
				
			||||||
        sp->value = (unsigned long int)(intptr_t)dlsym (handle, sp->name);
 | 
					        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;
 | 
					        void *sym;
 | 
				
			||||||
        shl_findsym (&handle, "share", TYPE_UNDEFINED, &sym);
 | 
					        shl_findsym (&handle, "share", TYPE_UNDEFINED, &sym);
 | 
				
			||||||
        sp->value = (unsigned long int)(intptr_t)sym;
 | 
					        sp->value = (unsigned long int)(intptr_t)sym;
 | 
				
			||||||
| 
						 | 
					@ -173,6 +175,7 @@ void Dlopen_File (char *fn) {
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
static void Load_Lib (Object libs) {
 | 
					static void Load_Lib (Object libs) {
 | 
				
			||||||
 | 
					    char *lib = NULL;
 | 
				
			||||||
    Object port, name;
 | 
					    Object port, name;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    if (Nullp (libs))
 | 
					    if (Nullp (libs))
 | 
				
			||||||
| 
						 | 
					@ -183,10 +186,40 @@ static void Load_Lib (Object libs) {
 | 
				
			||||||
    GC_Node2;
 | 
					    GC_Node2;
 | 
				
			||||||
    port = name = Null;
 | 
					    port = name = Null;
 | 
				
			||||||
    GC_Link2 (port, name);
 | 
					    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));
 | 
					    port = General_Open_File (Car (libs), P_INPUT, Var_Get (V_Load_Path));
 | 
				
			||||||
    name = PORT(port)->name;
 | 
					    while (!feof (PORT(port)->file)) {
 | 
				
			||||||
    Dlopen_File (STRING(name)->data);
 | 
					        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);
 | 
					    (void)P_Close_Input_Port (port);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					    if (lib)
 | 
				
			||||||
 | 
					        Dlopen_File (lib);
 | 
				
			||||||
 | 
					
 | 
				
			||||||
    GC_Unlink;
 | 
					    GC_Unlink;
 | 
				
			||||||
}
 | 
					}
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue