X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/145300db11eed3a0b02367f3a3f14c7ca3361a8c..3d36c5d66c327143ac12c3c2222352618da3123c:/tools/asdf-extensions.lisp?ds=inline diff --git a/tools/asdf-extensions.lisp b/tools/asdf-extensions.lisp index 76a180b..617b4b3 100644 --- a/tools/asdf-extensions.lisp +++ b/tools/asdf-extensions.lisp @@ -12,7 +12,7 @@ (defun concatenate-strings (strings &optional delimiter) (concatenate-strings (rest strings) delimiter)))) ;;; The following code is more or less copied frm sb-bsd-sockets.asd, -;;; but extended to allow flags set in a general way +;;; but extended to allow flags to be set in a general way (defclass unix-dso (module) ()) (defun unix-name (pathname) @@ -51,25 +51,10 @@ (defmethod perform :after ((operation compile-op) (dso unix-dso)) (module-components dso))))) (error 'operation-error :operation operation :component dso)))) -;; 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))))) + +(defun load-dso (filename) + #+sbcl(sb-alien:load-shared-object filename) + #+cmu(system::load-object-file filename)) (defmethod perform ((o load-op) (c unix-dso)) @@ -87,9 +72,7 @@ (definitions :initform nil :initarg :definitions) (defmethod output-files ((op compile-op) (c c-source-file)) - (list - (make-pathname :type "o" :defaults - (component-pathname c)))) + (list (make-pathname :type "o" :defaults (component-pathname c)))) (defmethod perform ((op compile-op) (c c-source-file))