-;; Taken from foreign.lisp in the CMUCL tree, but modified to delay
-;; resolving of symbols until they are used
-(defun load-dso (file)
- (system::ensure-lisp-table-opened)
- ; rtld global: so it can find all the symbols previously loaded
- ; rtld lazy: that way dlopen will not fail if not all symbols are defined.
- (let ((filename (namestring file)))
- (format t ";;; Loading shared library ~A ...~%" filename)
- (let ((sap (system::dlopen filename (logior system::rtld-lazy system::rtld-global))))
- (cond ((zerop (system:sap-int sap))
- (let ((err-string (system::dlerror)))
-
- ;; For some reason dlerror always seems to return NIL,
- ;; which isn't very informative.
- (error "Can't open object ~S: ~S" file err-string)))
- ((null (assoc sap system::*global-table* :test #'system:sap=))
- (setf system::*global-table* (acons sap file system::*global-table*))
- t)
- (t nil)))))
-
-
-(defmethod perform ((o load-op) (c unix-dso))
+#+clisp
+(defvar *loaded-libraries* ())
+
+(defun load-shared-object (pathname &optional (absolute-p t))
+ (let* ((namestring (ensure-namestring pathname))
+ (directory (namestring (pathname-sans-name+type namestring)))
+ (name+type (subseq namestring (length directory))))
+ #+sbcl
+ (progn
+ (sb-alien:load-shared-object namestring)
+ (unless absolute-p
+ (let ((shared-object (find namestring sb-alien::*shared-objects*
+ :key #'sb-alien::shared-object-file
+ :test #'equal)))
+ (setf (sb-alien::shared-object-file shared-object) name+type))))
+ #+cmu
+ (progn
+ (ext:load-foreign namestring)
+ (unless absolute-p
+ (let ((shared-object (rassoc namestring system::*global-table*
+ :test #'equal)))
+ (setf (cdr shared-object) name+type))))
+ #+clisp
+ (progn
+ (ffi::foreign-library namestring)
+ (pushnew
+ (if absolute-p namestring name+type)
+ *loaded-libraries* :test #'string=))))
+
+
+(defmethod perform ((o load-op) (dso shared-object))