5 (defun concatenate-strings (strings &optional delimiter)
6 (if (not (rest strings))
11 (if delimiter (string delimiter) "")
12 (concatenate-strings (rest strings) delimiter))))
14 ;;; The following code is more or less copied frm sb-bsd-sockets.asd,
15 ;;; but extended to allow flags set in a general way
17 (defclass unix-dso (module) ())
18 (defun unix-name (pathname)
21 (logical-pathname (translate-logical-pathname pathname))
24 (defmethod input-files ((operation compile-op) (dso unix-dso))
25 (mapcar #'component-pathname (module-components dso)))
27 (defmethod output-files ((operation compile-op) (dso unix-dso))
28 (let ((dir (component-pathname dso)))
30 (make-pathname :type "so"
31 :name (car (last (pathname-directory dir)))
32 :directory (butlast (pathname-directory dir))
36 (defmethod perform :after ((operation compile-op) (dso unix-dso))
37 (let ((dso-name (unix-name (car (output-files operation dso)))))
40 "gcc ~A -o ~S ~{~S ~}"
42 ;; (sb-ext:posix-getenv "EXTRA_LDFLAGS")
44 #+sunos "-shared -lresolv -lsocket -lnsl"
46 #-(or darwin sunos) "-shared")
50 (output-files operation c))
51 (module-components dso)))))
52 (error 'operation-error :operation operation :component dso))))
54 ;; Taken from foreign.lisp in the CMUCL tree, but modified to delay
55 ;; resolving of symbols until they are used
56 (defun load-dso (file)
57 (system::ensure-lisp-table-opened)
58 ; rtld global: so it can find all the symbols previously loaded
59 ; rtld lazy: that way dlopen will not fail if not all symbols are defined.
60 (let ((filename (namestring file)))
61 (format t ";;; Loading shared library ~A ...~%" filename)
62 (let ((sap (system::dlopen filename (logior system::rtld-lazy system::rtld-global))))
63 (cond ((zerop (system:sap-int sap))
64 (let ((err-string (system::dlerror)))
66 ;; For some reason dlerror always seems to return NIL,
67 ;; which isn't very informative.
68 (error "Can't open object ~S: ~S" file err-string)))
69 ((null (assoc sap system::*global-table* :test #'system:sap=))
70 (setf system::*global-table* (acons sap file system::*global-table*))
75 (defmethod perform ((o load-op) (c unix-dso))
76 (let ((co (make-instance 'compile-op)))
77 (let ((filename (car (output-files co c))))
78 (load-dso filename))))
82 (defclass c-source-file (source-file)
83 ((cflags :initform nil :initarg :cflags)
84 (optimization :initform 2 :initarg :optimization)
85 (definitions :initform nil :initarg :definitions)
86 (include-paths :initform nil :initarg :include-paths)))
89 (defmethod output-files ((op compile-op) (c c-source-file))
91 (make-pathname :type "o" :defaults
92 (component-pathname c))))
95 (defmethod perform ((op compile-op) (c c-source-file))
97 (= 0 (run-shell-command "gcc ~A -o ~S -c ~S"
101 (when (slot-value c 'optimization)
102 (list (format nil "-O~A" (slot-value c 'optimization))))
104 for symbol in (slot-value c 'definitions)
105 collect (format nil "-D~A" symbol))
107 for path in (slot-value c 'include-paths)
108 collect (format nil "-I~A" path))
109 (slot-value c 'cflags))
111 (unix-name (car (output-files op c)))
112 (unix-name (component-pathname c))))
113 (error 'operation-error :operation op :component c)))
116 (defmethod perform ((operation load-op) (c c-source-file))
121 (defclass library (static-file)
122 ((libdir :initarg :libdir)))
125 (defun relative-pathname (path)
128 (string (if (char= #\/ (char path 0))
132 (defmethod component-pathname ((lib library))
133 (make-pathname :type "so"
134 :name (component-name lib)
135 :directory (relative-pathname (slot-value lib 'libdir))))
137 (defmethod perform ((o load-op) (c library))
138 (load-dso (component-pathname c)))