[elephant-cvs] CVS elephant/src
ieslick
ieslick at common-lisp.net
Sun Jan 29 01:08:32 UTC 2006
Update of /project/elephant/cvsroot/elephant/src
In directory common-lisp:/tmp/cvs-serv30673/src
Modified Files:
bdb-enable.lisp sleepycat.lisp sql-controller.lisp
Log Message:
Minor modifications to improve compilation on Mac OS X and test completion under Allegro
--- /project/elephant/cvsroot/elephant/src/bdb-enable.lisp 2006/01/25 22:18:03 1.4
+++ /project/elephant/cvsroot/elephant/src/bdb-enable.lisp 2006/01/29 01:08:32 1.5
@@ -41,11 +41,12 @@
;;; to the Free Software Foundation, Inc., 59 Temple Place,
;;; Suite 330, Boston, MA 02111-1307 USA
;;;
-;; (defpackage ele-bdb
-;; (:documentation
-;; "ELE-BDB: This is just a marker-pacakge to show whether or not
-;; the Berkeley-DB code is enabled.")
-;; (:nicknames ele-bdb :ele-bdb))
+
+(defpackage ele-bdb
+ (:documentation
+ "ELE-BDB: This is just a marker-pacakge to show whether or not
+the Berkeley-DB code is enabled.")
+ (:nicknames ele-bdb :ele-bdb))
#+cmu
(eval-when (:compile-toplevel)
@@ -66,15 +67,15 @@
(uffi:load-foreign-library "/lib/tls/libpthread.so.0" :module "pthread")
(error "Couldn't load libpthread!"))
- (unless
- (uffi:load-foreign-library
- (if (find-package 'asdf)
+ (unless
+ (uffi:load-foreign-library
+ (if (find-package 'asdf)
(merge-pathnames
- #p"libmemutil.so"
+ (make-pathname :name "libmemutil" :type *c-library-extension*)
(asdf:component-pathname (asdf:find-system 'elephant)))
- "/usr/local/share/common-lisp/elephant-0.3/libmemutil.so")
- :module "libmemutil")
- (error "Couldn't load libmemutil.so!"))
+ (format nil "/usr/local/share/common-lisp/elephant-0.3/libmemutil.~A" *c-library-extension*))
+ :module "libmemutil")
+ (error "Couldn't load libmemutil.~A!" *c-library-extension*))
;; This code has now been moved to the small, asdf-loadable system
@@ -87,9 +88,9 @@
;; "/db/ben/lisp/db43/lib/libdb.so"
"/usr/local/BerkeleyDB.4.3/lib/libdb-4.3.so"
;; this works on FreeBSD
- #+(and (or bsd freebsd) (not darwin))
+ #+(and (or bsd freebsd) (not darwin macosx))
"/usr/local/lib/db43/libdb.so"
- #+darwin
+ #+(or darwin macosx)
;; for Fink (OS X) -- but I will assume Linux more common...
;; "/sw/lib/libdb-4.3.dylib"
;; a possible manual install
@@ -102,10 +103,10 @@
(uffi:load-foreign-library
(if (find-package 'asdf)
(merge-pathnames
- #p"libsleepycat.so"
+ (make-pathname :name "libsleepycat" :type *c-library-extension*)
(asdf:component-pathname (asdf:find-system 'elephant)))
- "/usr/local/share/common-lisp/elephant-0.3/libsleepycat.so")
+ (format nil "/usr/local/share/common-lisp/elephant-0.3/libsleepycat.~A" *c-library-extension*))
:module "libsleepycat")
- (error "Couldn't load libsleepycat!"))
+ (error "Couldn't load libsleepycat.~A!" *c-library-extension*))
)
--- /project/elephant/cvsroot/elephant/src/sleepycat.lisp 2005/12/05 15:27:54 1.16
+++ /project/elephant/cvsroot/elephant/src/sleepycat.lisp 2006/01/29 01:08:32 1.17
@@ -124,6 +124,10 @@
(eval-when (:compile-toplevel)
(proclaim '(optimize (ext:inhibit-warnings 3))))
+(eval-when (:compile-toplevel :load-toplevel)
+ (defparameter *c-library-extension*
+ #+macosx "dylib"
+ #-macosx "so" ))
(eval-when (:compile-toplevel :load-toplevel)
@@ -131,11 +135,11 @@
(uffi:load-foreign-library
(if (find-package 'asdf)
(merge-pathnames
- #p"libmemutil.so"
+ (make-pathname :name "libmemutil" :type *c-library-extension*)
(asdf:component-pathname (asdf:find-system 'elephant)))
- (format nil "~A/~A" *elephant-lib-path* "libmemutil.so"))
+ (format nil "~A/~A.~A" *elephant-lib-path* "libmemutil" *c-library-extension*))
:module "libmemutil")
- (error "Couldn't load libmemutil.so!"))
+ (error "Couldn't load libmemutil.~A!" *c-library-extension*))
;; fini on user editable part
@@ -509,7 +513,8 @@
"Return the number of bytes of the internal representation
of a string."
#+(and allegro ics)
- `(let ((l (length ,s))) (+ l l))
+ ;; old: `(let ((l (length ,s))) (+ l l))
+ `(excl:native-string-sizeof ,s :external-format :unicode)
#+(or (and sbcl sb-unicode) lispworks)
`(etypecase ,s
(base-string (length ,s))
@@ -521,7 +526,7 @@
;; memcpy is faster than looping! For Lispworks this causes
;; a string to array conversion, but I don't know how to do
;; any better (fli:replace-foreign-array is promising?)
-#-(or cmu sbcl scl openmcl)
+#-(or cmu sbcl scl openmcl allegro)
(def-function ("copy_buf" copy-str-to-buf)
((dest array-or-pointer-char)
(dest-offset :int)
@@ -566,6 +571,18 @@
(ccl::%copy-ivector-to-ptr ivector (+ disp src-offset)
dest dest-offset length)))
+#+allegro
+(defun copy-str-to-buf (dest dest-offset src src-offset length)
+ "Use build-in unicode handling and copying facilities.
+ NOTE: We need to validate the speed of this vs. default."
+ (declare (optimize (speed 3) (safety 0))
+ (type string src)
+ (type array-or-pointer-char dest)
+ (type fixnum length src-offset dest-offset)
+ (dynamic-extent src dest length))
+ (excl:string-to-native (subseq src src-offset) :address (offset-char-pointer dest dest-offset)
+ :external-format :unicode))
+
;; Lisp version, for kicks. this assumes 8-bit chars!
#+(not (or cmu sbcl scl allegro openmcl lispworks))
(defun copy-str-to-buf (dest dest-offset src src-offset length)
@@ -752,7 +769,10 @@
(resize-buffer-stream bs needed))
;; I wonder if the basic problem here is that we are using this
;; routine instead of something like "copy-ub8-from-system-area"?
+ #-allegro
(copy-str-to-buf buf size s 0 str-bytes)
+ #+allegro
+ (excl:string-to-native s :address (offset-char-pointer buf size) :external-format :unicode)
(setf size needed)
nil)))
@@ -880,7 +900,7 @@
;; wide!!!
#+(and allegro ics)
(excl:native-to-string
- (offset-char-pointer (buffer-stream-buffer bs) position)
+ (offset-char-pointer (buffer-stream-buffer bs) position)
:length byte-length
:external-format :unicode)
#+lispworks
--- /project/elephant/cvsroot/elephant/src/sql-controller.lisp 2006/01/24 15:42:30 1.3
+++ /project/elephant/cvsroot/elephant/src/sql-controller.lisp 2006/01/29 01:08:32 1.4
@@ -232,8 +232,6 @@
index)
(error "Invalid index initargs!"))))
-
-
(defmethod (setf get-value) (value key (bt sql-indexed-btree))
"Set a key / value pair, and update secondary indices."
(let* ((sc (check-con (:dbcn-spc-pst bt)))
More information about the Elephant-cvs
mailing list