X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/73572c12ccd49c661d06287903bfa725f5fd93a5..27053df512c8670ded0b926ff8a5b374178ba503:/tools/asdf-extensions.lisp diff --git a/tools/asdf-extensions.lisp b/tools/asdf-extensions.lisp index 617b4b3..b48dd08 100644 --- a/tools/asdf-extensions.lisp +++ b/tools/asdf-extensions.lisp @@ -1,20 +1,17 @@ (in-package :asdf) -(export 'load-dso) +(export '*dso-extension*) + +(defparameter *dso-extension* + #-(or darwin win32)"so" #+darwin"dylib" #+win32"dll") -(defun concatenate-strings (strings &optional delimiter) - (if (not (rest strings)) - (first strings) - (concatenate - 'string - (first strings) - (if delimiter (string delimiter) "") - (concatenate-strings (rest strings) delimiter)))) ;;; The following code is more or less copied frm sb-bsd-sockets.asd, ;;; but extended to allow flags to be set in a general way -(defclass unix-dso (module) ()) +(defclass unix-dso (module) + ((ldflags :initform nil :initarg :ldflags))) + (defun unix-name (pathname) (namestring (typecase pathname @@ -27,34 +24,43 @@ (defmethod output-files ((operation compile-op) (dso unix-dso)) (let ((dir (component-pathname dso))) (list - (make-pathname :type "so" + (make-pathname :type *dso-extension* :name (car (last (pathname-directory dir))) :directory (butlast (pathname-directory dir)) :defaults dir)))) - (defmethod perform :after ((operation compile-op) (dso unix-dso)) - (let ((dso-name (unix-name (car (output-files operation dso))))) + (let ((output (first (output-files operation dso))) + (inputs (mapcar #'unix-name + (mapcan #'(lambda (c) + (output-files operation c)) + (module-components dso))))) (unless (zerop - (run-shell-command - "gcc ~A -o ~S ~{~S ~}" - (concatenate 'string -;; (sb-ext:posix-getenv "EXTRA_LDFLAGS") -;; " " - #+sunos "-shared -lresolv -lsocket -lnsl" - #+darwin "-bundle" - #-(or darwin sunos) "-shared") - dso-name - (mapcar #'unix-name - (mapcan (lambda (c) - (output-files operation c)) - (module-components dso))))) + (run-shell-command "gcc ~A -o ~S ~{~S~^ ~} ~{~A~^ ~}" + #-(or darwin win32)"-shared" + #+darwin "-bundle" + #+win32 + (format nil "-shared -Wl,--out-implib,~S" + (unix-name + (make-pathname + :type "a" + :name (format nil "lib~Adll" (pathname-name output)) + :defaults output))) + (unix-name output) + inputs + (slot-value dso 'ldflags))) (error 'operation-error :operation operation :component dso)))) +#+clisp +(defvar *loaded-libraries* ()) (defun load-dso (filename) #+sbcl(sb-alien:load-shared-object filename) - #+cmu(system::load-object-file filename)) + #+cmu(ext:load-foreign filename) + #+clisp + (unless (find filename *loaded-libraries* :test #'equal) + (ffi::foreign-library (namestring filename)) + (push filename *loaded-libraries*))) (defmethod perform ((o load-op) (c unix-dso)) @@ -77,21 +83,20 @@ (defmethod perform ((op compile-op) (c c-source-file)) (unless - (= 0 (run-shell-command "gcc ~A -o ~S -c ~S" - (concatenate-strings - (append - (list "-fPIC") - (when (slot-value c 'optimization) - (list (format nil "-O~A" (slot-value c 'optimization)))) - (loop - for symbol in (slot-value c 'definitions) - collect (format nil "-D~A" symbol)) - (loop - for path in (slot-value c 'include-paths) - collect (format nil "-I~A" path)) - (slot-value c 'cflags)) - #\sp) - (unix-name (car (output-files op c))) + (= 0 (run-shell-command "gcc ~A~{ ~A~} -o ~S -c ~S" + #-win32 "-fPIC" + #+win32 "-DBUILD_DLL" + (nconc + (when (slot-value c 'optimization) + (list (format nil "-O~A" (slot-value c 'optimization)))) + (loop + for symbol in (slot-value c 'definitions) + collect (format nil "-D~A" symbol)) + (loop + for path in (slot-value c 'include-paths) + collect (format nil "-I~A" path)) + (slot-value c 'cflags)) + (unix-name (first (output-files op c))) (unix-name (component-pathname c)))) (error 'operation-error :operation op :component c))) @@ -100,22 +105,50 @@ t) +;;; Shared libraries -(defclass library (static-file) - ((libdir :initarg :libdir))) +(defclass library (component) + ((libdir :initarg :libdir) + (libname :initarg :libname :initform nil))) -(defun relative-pathname (path) - (etypecase path - (cons path) - (string (if (char= #\/ (char path 0)) - (subseq path 1) - path)))) +(defun split-path (path) + (labels ((split (path) + (unless (zerop (length path)) + (let ((slash (position #\/ path))) + (if slash + (cons (subseq path 0 slash) (split (subseq path (1+ slash)))) + (list path)))))) + (if (and (not (zerop (length path))) (char= (char path 0) #\/)) + (cons :absolute (split (subseq path 1))) + (cons :relative (split path))))) -(defmethod component-pathname ((lib library)) - (make-pathname :type "so" - :name (component-name lib) - :directory (relative-pathname (slot-value lib 'libdir)))) +(defmethod component-pathname ((lib library)) + (make-pathname :type *dso-extension* + :name (or (slot-value lib 'libname) (component-name lib)) + :directory (split-path (slot-value lib 'libdir)))) + +;; --fix: is UNIX-NAME really necessary for win32? i know it will bomb +;; without using it while doing (ASDF:OOS 'ASDF:LOAD-OP :GLIB) but +;; loading the complete pathname for libglib-2.0-0.dll with +;; SB-ALIEN:LOAD-SHARED-OBJECT by hand won't explode. weird. +;; - cph 18-May-2007 (defmethod perform ((o load-op) (c library)) - (load-dso (component-pathname c))) + (load-dso #-win32 (component-pathname c) + #+win32 (unix-name (component-pathname c)))) + +(defmethod perform ((operation operation) (c library)) + nil) + +(defmethod operation-done-p ((o load-op) (c library)) + #+sbcl(find (sb-ext::unix-namestring (component-pathname c)) sb-alien::*shared-objects* :key #'sb-alien::shared-object-file :test #'equal) + #+cmu(rassoc (unix::unix-namestring (component-pathname c)) + system::*global-table* + :key #'(lambda (pathname) + (when pathname (unix::unix-namestring pathname))) + :test #'equal) + #+clisp(find (component-pathname c) *loaded-libraries* :test #'equal)) + +(defmethod operation-done-p ((o operation) (c library)) + t)