-
Notifications
You must be signed in to change notification settings - Fork 5
/
elephant.asd
356 lines (318 loc) · 14 KB
/
elephant.asd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;
;;; elephant.asd -- ASDF system definition for elephant
;;;
;;; Initial version 8/26/2004 by Ben Lee
;;; <[email protected]>
;;;
;;; part of
;;;
;;; Elephant: an object-oriented database for Common Lisp
;;;
;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee
;;; <[email protected]> <[email protected]>
;;;
;;; Elephant users are granted the rights to distribute and use this software
;;; as governed by the terms of the Lisp Lesser GNU Public License
;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
(in-package :cl-user)
(defpackage elephant-system
(:use :cl :asdf)
(:export :elephant-c-source :compiler-options :foreign-libraries-to-load-first :get-config-option))
(in-package :elephant-system)
;;
;; Simple lisp/asdf-based make utility for elephant c files
;;
(defgeneric compiler-options (compiler c-source-file &key input-file output-file)
(:documentation "Returns a list of options to pass to <compiler>"))
(defgeneric foreign-libraries-to-load-first (c-source-file)
(:documentation "Provides an alist of foreign-libraries to load and the modules to load them into. Similar to (input-files load-op), but much more specific"))
(defun uffi-funcall (fn &rest args)
"Simplify uffi funcall, first ensure uffi is loaded"
(unless (find-package :uffi)
(asdf:operate 'asdf:load-op :uffi))
(apply (find-symbol (symbol-name fn) (symbol-name :uffi)) args))
;;
;; User parameters (bdb root and pthread, if necessary)
;;
(defun get-config-option (option component)
(let ((filespec (make-pathname :defaults (asdf:component-pathname (asdf:component-system component))
:name "my-config"
:type "sexp"))
(orig-filespec (make-pathname :defaults (asdf:component-pathname (asdf:component-system component))
:name "config"
:type "sexp")))
(unless (probe-file filespec)
(with-simple-restart (accept-default "Create default settings for my-config.sexp and proceed.")
(error "Missing configuration file: my-config.sexp. Please copy config.sexp to my-config.sexp and customize for your local environment."))
(with-open-file (src orig-filespec :direction :input)
(with-open-file (dest filespec :direction :output)
(write (read src) :stream dest))))
(with-open-file (config filespec)
(cdr (assoc option (read config))))))
;;
;; Supported C compilers
;;
(defvar *c-compilers*
'((:gcc . "gcc")
(:cygwin . "gcc")
(:msvc . ""))
"Associate compilers with platforms for compiling libmemutil/libsleepycat")
(defun c-compiler (comp)
(get-config-option :compiler comp))
(defun c-compiler-path (comp)
(let* ((compiler (get-config-option :compiler comp))
(entry (assoc compiler *c-compilers*)))
(if entry
(cdr entry)
(error "Cannot find compiler path for config.sexp :compiler option: ~A" compiler))))
;;
;; Basic utilities for elephant c files
;;
(defclass elephant-c-source (c-source-file) ())
;; COMPILE
(defmethod output-files ((o compile-op) (c elephant-c-source))
"Compute the output files (for dependency tracking), here we assume
a library with the same name and a platform dependant extension"
(list (make-pathname :name (component-name c)
:type (uffi-funcall :default-foreign-library-type)
:defaults (component-pathname c))))
(defmethod perform ((o compile-op) (c elephant-c-source))
"Run the appropriate compiler for this platform on the source, getting
the specific options from 'compiler-options method. Default options
can be overridden or augmented by subclass methods"
(unless (get-config-option :prebuilt-libraries c)
#+(or mswindows windows win32)
(progn
(let* ((pathname (component-pathname c))
(directory #+lispworks (make-pathname :host (pathname-host pathname) :directory (pathname-directory pathname))
#-lispworks (make-pathname :device (pathname-device pathname) :directory (pathname-directory pathname)))
(stdout-lines) (stderr-lines) (exit-status))
(let ((command (format nil "~A ~{~A ~}"
(c-compiler-path c)
(compiler-options (c-compiler c) c
:input-file (format nil "\"~A\"" (namestring pathname))
:output-file nil
:library nil))))
#+allegro (multiple-value-setq (stdout-lines stderr-lines exit-status)
(excl.osi:command-output command :directory directory))
#+lispworks (setf exit-status (system:call-system-showing-output command :current-directory directory))
#+sbcl (setf exit-status
(run-shell-command
(format nil "cd ~S && ~A" (namestring directory) command)))
(unless (zerop exit-status)
(error 'operation-error :component c :operation o)))
(let ((command (format nil "dlltool -z ~A --export-all-symbols -e exports.o -l ~A ~A"
(format nil "\"~A\"" (namestring (make-pathname :type "def" :defaults pathname)))
(format nil "\"~A\"" (namestring (make-pathname :type "lib" :defaults pathname)))
(format nil "\"~A\"" (namestring (make-pathname :type "o" :defaults pathname))))))
#+allegro (multiple-value-setq (stdout-lines stderr-lines exit-status)
(excl.osi:command-output command :directory directory))
#+lispworks (setf exit-status (system:call-system-showing-output command :current-directory directory))
#+sbcl (setf exit-status
(run-shell-command
(format nil "cd ~S && ~A" (namestring directory) command)))
(unless (zerop exit-status)
(error 'operation-error :component c :operation o)))
(let ((command (format nil "~A ~{~A ~}" ;; -I~A -L~A -l~A
(c-compiler-path c)
(compiler-options (c-compiler c) c
:input-file
(list (format nil "\"~A\"" (namestring
(make-pathname :type "o" :defaults pathname)))
"exports.o")
:output-file (format nil "\"~A\"" (first (output-files o c)))
:library t))))
#+allegro (multiple-value-setq (stdout-lines stderr-lines exit-status)
(excl.osi:command-output command :directory directory))
#+lispworks (setf exit-status (system:call-system-showing-output command :current-directory directory))
#+sbcl (setf exit-status
(run-shell-command
(format nil "cd ~S && ~A" (namestring directory) command)))
(unless (zerop exit-status)
(error 'operation-error :component c :operation o)))))
#-(or mswindows windows win32)
(unless (zerop (run-shell-command
"~A ~{~A ~}"
(c-compiler-path c)
(compiler-options (c-compiler c) c
:input-file (namestring (component-pathname c))
:output-file (namestring (first (output-files o c))))))
(error 'operation-error :component c :operation o))))
#|
(defmethod perform ((o compile-op) (c elephant-c-source))
"Run the appropriate compiler for this platform on the source, getting
the specific options from 'compiler-options method. Default options
can be overridden or augmented by subclass methods"
#+(or mswindows windows)
(progn
(let ((pathname (component-pathname c)))
(unless (zerop (run-shell-command
(format nil "~A ~{~A ~}"
(c-compiler-path c)
(compiler-options (c-compiler c) c
:input-file (format nil "\"~A\"" (namestring pathname))
:output-file nil
:library nil))))
(error 'operation-error :component c :operation o))
(unless (zerop (run-shell-command
(format nil "dlltool -z ~A --export-all-symbols -e exports.o -l ~A ~A"
(format nil "\"~A\"" (namestring (make-pathname :type "def" :defaults pathname)))
(format nil "\"~A\"" (namestring (make-pathname :type "lib" :defaults pathname)))
(format nil "\"~A\"" (namestring (make-pathname :type "o" :defaults pathname))))))
(error 'operation-error :component c :operation o))
(unless (zerop (run-shell-command
(format nil "~A ~{~A ~} -I~A -L~A -l~A"
(c-compiler-path c)
(compiler-options (c-compiler c) c
:input-files
(list (format nil "\"~A\"" (namestring
(make-pathname :type "o" :defaults pathname)))
"exports.o")
:output-file (format nil "\"~A\"" (first (output-files o c)))
:library t))))
(error 'operation-error :component c :operation o))))
#-windows
(unless (zerop (run-shell-command
"~A ~{~A ~}"
(c-compiler-path c)
(compiler-options (c-compiler c) c
:input-file (namestring (component-pathname c))
:output-file (namestring (first (output-files o c))))))
(error 'operation-error :component c :operation o)))
|#
;;Cygwin compile script:
;;gcc -mno-cygwin -mwindows -std=c99 -c libmemutil.c
;;dlltool -z libmemutil.def --export-all-symbols -e exports.o -l libmemutil.lib libmemutil.o
;;gcc -shared -mno-cygwin -mwindows libmemutil.o exports.o -o libmemutil.dll
(defmethod operation-done-p ((o compile-op) (c elephant-c-source))
"Is the first generated library more recent than the source file?"
(let ((lib (first (output-files o c))))
(and (probe-file (component-pathname c))
(probe-file lib)
(> (file-write-date lib) (file-write-date (component-pathname c))))))
(defmethod compiler-options ((compiler (eql :gcc)) (c elephant-c-source) &key input-file output-file &allow-other-keys)
"Default compile and link options to create a library; no -L or -I options included; math lib as default"
(unless (and input-file output-file)
(error "Must specify both input and output files"))
(list
#-(or darwin macosx darwin-host) "-shared"
#+(or darwin macosx darwin-host) "-bundle"
#+(and X86-64 (or macosx darwin darwin-host)) "-arch x86_64"
#+(and X86 (or macosx darwin darwin-host)) "-m32" ; Snow Leopard
#+(and X86-64 linux) "-march=x86-64"
"-fPIC"
"-Wall"
"-g"
"-O2"
"-g"
input-file
"-o" output-file
"-lm"))
(defmethod compiler-options ((compiler (eql :cygwin)) (c elephant-c-source) &key input-file output-file library &allow-other-keys)
(unless input-file
(error "Must specify both input files"))
(append
(when library (list "-shared"))
(list
"-mno-cygwin"
"-mwindows"
"-Wall")
(unless library (list "-c -std=c99"))
(if (listp input-file) input-file (list input-file))
(when output-file (list "-o" output-file))))
(defmethod compiler-options ((compiler (eql :msvc)) (c elephant-c-source) &key input-file output-file)
(declare (ignore input-file output-file))
(error "MSVC compiler option not supported yet"))
;; LOAD
(defmethod perform ((o load-op) (c elephant-c-source))
;; Load any required external libraries
(let ((libs (foreign-libraries-to-load-first c)))
(dolist (file+module libs)
(destructuring-bind (file . module) file+module
(format t "Loading ~A~%" file)
(or (uffi-funcall :load-foreign-library file :module module)
(error "Could not load ~A into ~A" file module)))))
;; Load the compiled libraries
(dolist (file (output-files (make-operation 'compile-op) c))
(format t "Attempting to load ~A...~%" (file-namestring file))
(if (and (probe-file file)
(not (get-config-option :prebuilt-libraries c)))
(progn
(or (uffi-funcall :load-foreign-library file :module (component-name c))
(error "Could not load ~A" file))
(format t "Loaded ~A~%" file))
(let* ((root-dir (asdf:component-pathname (asdf:component-system c)))
(root-library-file (merge-pathnames (file-namestring file) root-dir)))
(or (uffi-funcall :load-foreign-library
root-library-file
:module (component-name c))
(error "Output file ~A not found in elephant root" (namestring root-library-file)))
(format t "Loaded ~A~%" root-library-file)))))
(defmethod operation-done-p ((o load-op) (c elephant-c-source))
nil)
(defmethod foreign-libraries-to-load-first ((c elephant-c-source))
nil)
;;
;; System definition
;;
(defsystem elephant
:name "elephant"
:author "Ben Lee <[email protected]>"
:version "1.0a1"
:maintainer "Ian Eslick <[email protected], Robert Read <[email protected]>"
:licence "LLGPL"
:description "Object database for Common Lisp"
:long-description "An object-oriented database based on Berkeley DB, for CMUCL/SBCL, OpenMCL, and Allegro."
:components
((:module :src
:components
((:module utils
:components
((:file "package")
(:file "convenience")
(:file "locks")
(:file "os"))
:serial t)
(:module memutil
:components
((:elephant-c-source "libmemutil")
(:file "memutil"))
:serial t
:depends-on (utils))
(:module elephant
:components
((:file "package")
#+cmu (:file "cmu-mop-patches")
#+openmcl (:file "openmcl-mop-patches")
(:file "variables")
(:file "transactions")
(:file "schemas")
(:file "metaclasses")
(:file "classes")
(:file "slots")
(:file "cache")
(:file "serializer")
(:file "controller")
(:file "schema-evolution")
(:file "cached-slots")
(:file "collections")
(:file "indexed-slots")
(:file "pset")
(:file "set-valued-slots")
(:file "associations")
(:file "serializer1") ;; 0.6.0 db's
(:file "serializer2") ;; 0.6.1+ db's
(:file "unicode")
(:file "migrate")
(:file "gc")
(:file "query")
(:file "data-store-api"))
:serial t
:depends-on (memutil utils)))))
:serial t
:depends-on (:uffi
#+sbcl :sb-posix
:cl-base64))
(defmethod asdf:perform :after ((op load-op) (system (eql (find-system :elephant))))
(pushnew :elephant cl:*features*))