3 (export '*dso-extension*)
5 (defparameter *dso-extension*
6 #-(or darwin win32)"so" #+darwin"dylib" #+win32"dll")
9 ;;; The following code is more or less copied frm sb-bsd-sockets.asd,
10 ;;; but extended to allow flags to be set in a general way
12 (defclass unix-dso (module)
13 ((ldflags :initform nil :initarg :ldflags)))
15 (defun unix-name (pathname)
18 (logical-pathname (translate-logical-pathname pathname))
21 (defmethod input-files ((operation compile-op) (dso unix-dso))
22 (mapcar #'component-pathname (module-components dso)))
24 (defmethod output-files ((operation compile-op) (dso unix-dso))
25 (let ((dir (component-pathname dso)))
27 (make-pathname :type *dso-extension*
28 :name (car (last (pathname-directory dir)))
29 :directory (butlast (pathname-directory dir))
32 (defmethod perform :after ((operation compile-op) (dso unix-dso))
33 (let ((output (first (output-files operation dso)))
34 (inputs (mapcar #'unix-name
36 (output-files operation c))
37 (module-components dso)))))
39 (run-shell-command "gcc ~A -o ~S ~{~S~^ ~} ~{~A~^ ~}"
40 #-(or darwin win32)"-shared"
43 (format nil "-shared -Wl,--out-implib,~S"
47 :name (format nil "lib~Adll" (pathname-name output))
51 (slot-value dso 'ldflags)))
52 (error 'operation-error :operation operation :component dso))))
55 (defvar *loaded-libraries* ())
57 (defun load-dso (filename)
58 #+sbcl(sb-alien:load-shared-object filename)
59 #+cmu(ext:load-foreign filename)
61 (unless (find filename *loaded-libraries* :test #'equal)
62 (ffi::foreign-library (namestring filename))
63 (push filename *loaded-libraries*)))
66 (defmethod perform ((o load-op) (c unix-dso))
67 (let ((co (make-instance 'compile-op)))
68 (let ((filename (car (output-files co c))))
69 (load-dso filename))))
73 (defclass c-source-file (source-file)
74 ((cflags :initform nil :initarg :cflags)
75 (optimization :initform 2 :initarg :optimization)
76 (definitions :initform nil :initarg :definitions)
77 (include-paths :initform nil :initarg :include-paths)))
80 (defmethod output-files ((op compile-op) (c c-source-file))
81 (list (make-pathname :type "o" :defaults (component-pathname c))))
84 (defmethod perform ((op compile-op) (c c-source-file))
86 (= 0 (run-shell-command "gcc ~A~{ ~A~} -o ~S -c ~S"
90 (when (slot-value c 'optimization)
91 (list (format nil "-O~A" (slot-value c 'optimization))))
93 for symbol in (slot-value c 'definitions)
94 collect (format nil "-D~A" symbol))
96 for path in (slot-value c 'include-paths)
97 collect (format nil "-I~A" path))
98 (slot-value c 'cflags))
99 (unix-name (first (output-files op c)))
100 (unix-name (component-pathname c))))
101 (error 'operation-error :operation op :component c)))
104 (defmethod perform ((operation load-op) (c c-source-file))
110 (defclass library (component)
111 ((libdir :initarg :libdir)
112 (libname :initarg :libname :initform nil)))
115 (defun split-path (path)
116 (labels ((split (path)
117 (unless (zerop (length path))
118 (let ((slash (position #\/ path)))
120 (cons (subseq path 0 slash) (split (subseq path (1+ slash))))
122 (if (and (not (zerop (length path))) (char= (char path 0) #\/))
123 (cons :absolute (split (subseq path 1)))
124 (cons :relative (split path)))))
127 (defmethod component-pathname ((lib library))
128 (make-pathname :type *dso-extension*
129 :name (or (slot-value lib 'libname) (component-name lib))
130 :directory (split-path (slot-value lib 'libdir))))
132 ;; --fix: is UNIX-NAME really necessary for win32? i know it will bomb
133 ;; without using it while doing (ASDF:OOS 'ASDF:LOAD-OP :GLIB) but
134 ;; loading the complete pathname for libglib-2.0-0.dll with
135 ;; SB-ALIEN:LOAD-SHARED-OBJECT by hand won't explode. weird.
137 (defmethod perform ((o load-op) (c library))
138 (load-dso #-win32 (component-pathname c)
139 #+win32 (unix-name (component-pathname c))))
141 (defmethod perform ((operation operation) (c library))
144 (defmethod operation-done-p ((o load-op) (c library))
145 #+sbcl(find (sb-ext::unix-namestring (component-pathname c)) sb-alien::*shared-objects* :key #'sb-alien::shared-object-file :test #'equal)
146 #+cmu(rassoc (unix::unix-namestring (component-pathname c))
147 system::*global-table*
148 :key #'(lambda (pathname)
149 (when pathname (unix::unix-namestring pathname)))
151 #+clisp(find (component-pathname c) *loaded-libraries* :test #'equal))
153 (defmethod operation-done-p ((o operation) (c library))