- elephant-cvs@lists.common-lisp.net - mailman3.common-lisp.net

[elephant-cvs] CVS elephant/src
by rread 24 Jan '06

24 Jan '06

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp:/tmp/cvs-serv9274 Modified Files: RUNTEST.lisp classes.lisp collections.lisp controller.lisp elephant.lisp metaclasses.lisp sql-controller.lisp Log Message: Changes from Andrew Blumberg discovered while debugging on openMCL. --- /project/elephant/cvsroot/elephant/src/RUNTEST.lisp 2005/11/23 17:51:37 1.2 +++ /project/elephant/cvsroot/elephant/src/RUNTEST.lisp 2006/01/24 15:42:30 1.3 @@ -19,6 +19,10 @@ (setq *test-path-primary* *testpg-path*) (setq *test-path-primary* *testsqlite3-path*) (setq *test-path-secondary* *testdb-path*) + +(setq *test-path-primary* *testdb-path*) +(setq *test-path-secondary* nil) + (do-all-tests-spec *test-path-primary*) --- /project/elephant/cvsroot/elephant/src/classes.lisp 2005/11/23 17:51:37 1.14 +++ /project/elephant/cvsroot/elephant/src/classes.lisp 2006/01/24 15:42:30 1.15 @@ -187,6 +187,9 @@ (setf (slot-value-using-class class instance slot-def) (funcall initfun)))) ) +;; (format t "transient-slot-inits ~A~%" transient-slot-inits) +;; (format t "indices boundp ~A~%" (slot-boundp instance 'indices)) +;; (format t "indices-caches boundp ~A~%" (slot-boundp instance 'indices-cache)) ;; let the implementation initialize the transient slots (apply #'call-next-method instance transient-slot-inits initargs)))))) @@ -194,11 +197,16 @@ ;; probably should delete discarded slots, but we'll worry about that later (prog1 (call-next-method) + (format t "persisent-slots ~A~%" (persistent-slots (class-of instance))) +;; (format t "slot-boundp ~A~%" (slot-boundp instance '%persistent-slots)) (let* ((class (class-of instance)) (new-persistent-slots (set-difference (persistent-slots class) (old-persistent-slots class)))) - (apply #'shared-initialize instance new-persistent-slots initargs)))) + (apply #'shared-initialize instance new-persistent-slots initargs)) +;; (format t "slot-boundp ~A~%" (slot-boundp instance '%persistent-slots)) + ) + ) (defun find-slot-def-by-name (class slot-name) (loop for slot-def in (class-slots class) --- /project/elephant/cvsroot/elephant/src/collections.lisp 2005/11/23 17:51:37 1.12 +++ /project/elephant/cvsroot/elephant/src/collections.lisp 2006/01/24 15:42:30 1.13 @@ -377,7 +377,8 @@ (defmethod (setf get-value) (value key (bt btree-index)) "Puts are not allowed on secondary indices. Try adding to the primary." - (declare (ignore value key bt)) + (declare (ignore value key) + (ignorable bt)) (error "Puts are forbidden on secondary indices. Try adding to the primary.")) (defgeneric get-primary-key (key bt) @@ -1008,20 +1009,23 @@ (defmethod cursor-get-both ((cursor bdb-secondary-cursor) key value) "cursor-get-both not implemented for secondary indices. Use cursor-pget-both." - (declare (ignore cursor key value)) + (declare (ignore key value) + (ignorable cursor)) (error "cursor-get-both not implemented on secondary indices. Use cursor-pget-both.")) (defmethod cursor-get-both-range ((cursor bdb-secondary-cursor) key value) "cursor-get-both-range not implemented for secondary indices. Use cursor-pget-both-range." - (declare (ignore cursor key value)) + (declare (ignore key value) + (ignorable cursor)) (error "cursor-get-both-range not implemented on secondary indices. Use cursor-pget-both-range.")) (defmethod cursor-put ((cursor bdb-secondary-cursor) value &rest rest) "Puts are forbidden on secondary indices. Try adding to the primary." - (declare (ignore rest value cursor)) + (declare (ignore rest value) + (ignorable cursor)) (error "Puts are forbidden on secondary indices. Try adding to the primary.")) (defmethod cursor-next-dup ((cursor bdb-secondary-cursor)) --- /project/elephant/cvsroot/elephant/src/controller.lisp 2005/11/23 17:51:37 1.13 +++ /project/elephant/cvsroot/elephant/src/controller.lisp 2006/01/24 15:42:30 1.14 @@ -181,7 +181,7 @@ ) (defun add-index-from-index (iname v dstibt dstsc) - (declare (type btree-index v) +#-ALLEGRO (declare (type btree-index v) (type indexed-btree dstibt)) (let ((kf (key-form v))) (format t " kf ~A ~%" kf) --- /project/elephant/cvsroot/elephant/src/elephant.lisp 2005/11/23 17:51:37 1.15 +++ /project/elephant/cvsroot/elephant/src/elephant.lisp 2006/01/24 15:42:30 1.16 @@ -216,7 +216,11 @@ slot-definition-initargs class-finalized-p finalize-inheritance - compute-slots) + compute-slots + slot-definition-readers + slot-definition-writers + class-direct-slots + ) #+allegro (:import-from :excl compute-effective-slot-definition-initargs) --- /project/elephant/cvsroot/elephant/src/metaclasses.lisp 2006/01/06 14:20:03 1.9 +++ /project/elephant/cvsroot/elephant/src/metaclasses.lisp 2006/01/24 15:42:30 1.10 @@ -94,6 +94,9 @@ default; use the :transient flag otherwise.")) (defmethod persistent-slots ((class persistent-metaclass)) + (if (slot-boundp class '%persistent-slots) + (car (%persistent-slots class)) + nil) (car (%persistent-slots class))) (defmethod persistent-slots ((class standard-class)) --- /project/elephant/cvsroot/elephant/src/sql-controller.lisp 2005/11/23 17:51:38 1.2 +++ /project/elephant/cvsroot/elephant/src/sql-controller.lisp 2006/01/24 15:42:30 1.3 @@ -533,7 +533,7 @@ :where [and [= [clctn_id] clcn]] :database con ))) - (mapcar #'(lambda (x) (mapcar #'(lambda (q) (deserialize-from-base64-string :sc sc)) x)) + (mapcar #'(lambda (x) (mapcar #'(lambda (q) (deserialize-from-base64-string q :sc sc)) x)) tuples))) (defmethod sql-from-root-existsp (key con)

1 0

[elephant-cvs] CVS update: elephant/doc/includes/PLACEHOLDER.txt
by rread＠common-lisp.net 06 Jan '06

06 Jan '06

Update of /project/elephant/cvsroot/elephant/doc/includes In directory common-lisp.net:/tmp/cvs-serv15892/includes Added Files: PLACEHOLDER.txt Log Message: Making sure the directory exists Date: Fri Jan 6 15:42:35 2006 Author: rread

1 0

[elephant-cvs] CVS update: elephant/doc/tutorial.texinfo
by rread＠common-lisp.net 06 Jan '06

06 Jan '06

Update of /project/elephant/cvsroot/elephant/doc In directory common-lisp.net:/tmp/cvs-serv15892 Modified Files: tutorial.texinfo Log Message: Making sure the directory exists Date: Fri Jan 6 15:42:34 2006 Author: rread Index: elephant/doc/tutorial.texinfo diff -u elephant/doc/tutorial.texinfo:1.1 elephant/doc/tutorial.texinfo:1.2 --- elephant/doc/tutorial.texinfo:1.1 Sun Sep 19 19:44:42 2004 +++ elephant/doc/tutorial.texinfo Fri Jan 6 15:42:34 2006 @@ -378,7 +378,7 @@ deserialization, no merge conflicts..... @lisp -* (defvar *friends-birthdays* (make-instance 'btree)) +* (defvar *friends-birthdays* (make-btree)) => *FRIENDS-BIRTHDAYS* * (add-to-root "friends-birthdays" *friends-birthdays*) @@ -500,7 +500,7 @@ and I put them in a table @lisp -* (defvar *appointments* (with-transaction () (make-instance 'indexed-btree))) +* (defvar *appointments* (with-transaction () (make-indexed-btree))) => *APPOINTMENTS* @end lisp @@ -609,7 +609,7 @@ run recovery on the database (see sleepycat docs) you can specify that with the @code{:recover} and @code{:recover-fatal} keys. -To create one by hand, +To create one by hand one can do, @lisp * (setq *store-controller* (make-instance 'store-controller :path "testdb")) @@ -619,7 +619,15 @@ => #<STORE-CONTROLLER @{49252F75@}> @end lisp -opens the environment and database. The @code{persistent-*} objects +but + +@lisp +* (open-store "testdb")) +@end lisp + +is preferred. + +This opens the environment and database. The @code{persistent-*} objects reference the @code{*store-controller*} special. (This is in part because slot accessors can't take additional arguments.) If for some reason you want to operate on 2 store controllers, you'll have to do that by

1 0

[elephant-cvs] CVS update: elephant/src/metaclasses.lisp
by rread＠common-lisp.net 06 Jan '06

06 Jan '06

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv14714/src Modified Files: metaclasses.lisp Log Message: Andrew Philpot found this bug that broke the ACL implementation Date: Fri Jan 6 15:20:03 2006 Author: rread Index: elephant/src/metaclasses.lisp diff -u elephant/src/metaclasses.lisp:1.8 elephant/src/metaclasses.lisp:1.9 --- elephant/src/metaclasses.lisp:1.8 Wed Nov 23 18:51:37 2005 +++ elephant/src/metaclasses.lisp Fri Jan 6 15:20:03 2006 @@ -77,7 +77,10 @@ ;; It probably would be better to put a string in here in the case ;; of sleepycat... (dbonnection-spec-pst :type (or list string) :accessor :dbcn-spc-pst :initarg :dbconnection-spec-pst - :initform '()) +;; Andrew Philpot discovered that this breaks the ACL implementation. +;; We are green under both SBCL and ACL with it commented out, so I am commiting it. -- rlr 06 JAN 2006 +;; :initform '() +) ) (:documentation "Abstract superclass for all persistent classes (common

1 0

[elephant-cvs] CVS update: elephant/src/sleepycat.lisp
by rread＠common-lisp.net 05 Dec '05

05 Dec '05

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv20325/src Modified Files: sleepycat.lisp Log Message: Removing debugging statements. Date: Mon Dec 5 16:27:54 2005 Author: rread Index: elephant/src/sleepycat.lisp diff -u elephant/src/sleepycat.lisp:1.15 elephant/src/sleepycat.lisp:1.16 --- elephant/src/sleepycat.lisp:1.15 Mon Dec 5 16:08:35 2005 +++ elephant/src/sleepycat.lisp Mon Dec 5 16:27:54 2005 @@ -545,7 +545,6 @@ (type array-or-pointer-char d) (type fixnum do so l) (type string s)) -;; (format t "copy-str-to-buf s = ~A do =~a so=~A len=~A~%" s do so l) (%copy-str-to-buf d do #+sbcl (sb-sys:vector-sap s) @@ -661,7 +660,6 @@ (declare (optimize (speed 3) (safety 0)) (type buffer-stream bs) (type (unsigned-byte 8) b)) -;; (format t "BW-byte ~A~%" b) (with-struct-slots ((buf buffer-stream-buffer) (size buffer-stream-size) (len buffer-stream-length))

1 0

[elephant-cvs] CVS update: elephant/tests/testcollections.lisp
by rread＠common-lisp.net 05 Dec '05

05 Dec '05

Update of /project/elephant/cvsroot/elephant/tests In directory common-lisp.net:/tmp/cvs-serv19163/tests Modified Files: testcollections.lisp Log Message: Bug fix for unicode SBCL Date: Mon Dec 5 16:08:37 2005 Author: rread Index: elephant/tests/testcollections.lisp diff -u elephant/tests/testcollections.lisp:1.4 elephant/tests/testcollections.lisp:1.5 --- elephant/tests/testcollections.lisp:1.4 Wed Nov 23 18:51:59 2005 +++ elephant/tests/testcollections.lisp Mon Dec 5 16:08:36 2005 @@ -77,7 +77,7 @@ ;; "key-1". I need to understand this, but don't at present.... (deftest remove-kv (finishes - (with-transaction (:store-controller *store-controller*) (remove-kv "key-1" bt))) + (with-transaction (:store-controller *store-controller*) (remove-kv first-key bt))) t) (deftest removed

1 0

[elephant-cvs] CVS update: elephant/src/serializer.lisp elephant/src/sleepycat.lisp
by rread＠common-lisp.net 05 Dec '05

05 Dec '05

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv19163/src Modified Files: serializer.lisp sleepycat.lisp Log Message: Bug fix for unicode SBCL Date: Mon Dec 5 16:08:36 2005 Author: rread Index: elephant/src/serializer.lisp diff -u elephant/src/serializer.lisp:1.11 elephant/src/serializer.lisp:1.12 --- elephant/src/serializer.lisp:1.11 Wed Nov 23 18:51:37 2005 +++ elephant/src/serializer.lisp Mon Dec 5 16:08:35 2005 @@ -120,6 +120,7 @@ (%serialize (package-name package)) (%serialize nil))))) (string + (progn (buffer-write-byte #+(and allegro ics) +ucs2-string+ #+(or (and sbcl sb-unicode) lispworks) @@ -130,7 +131,7 @@ +ucs1-string+ bs) (buffer-write-int (byte-length frob) bs) - (buffer-write-string frob bs)) + (buffer-write-string frob bs))) (persistent (buffer-write-byte +persistent+ bs) (buffer-write-int (oid frob) bs) @@ -293,6 +294,7 @@ ((= tag +ucs4-symbol+) (let ((name (buffer-read-ucs4-string bs (buffer-read-fixnum bs))) (maybe-package-name (%deserialize bs))) +;; (format t "ouput name = ~A~%" name) (if maybe-package-name (intern name (find-package maybe-package-name)) (make-symbol name)))) Index: elephant/src/sleepycat.lisp diff -u elephant/src/sleepycat.lisp:1.14 elephant/src/sleepycat.lisp:1.15 --- elephant/src/sleepycat.lisp:1.14 Wed Nov 23 18:51:37 2005 +++ elephant/src/sleepycat.lisp Mon Dec 5 16:08:35 2005 @@ -149,19 +149,19 @@ ) (declaim (inline read-int read-uint read-float read-double - write-int write-uint write-float write-double - offset-char-pointer copy-str-to-buf %copy-str-to-buf copy-bufs - ;;resize-buffer-stream - ;;buffer-stream-buffer buffer-stream-size buffer-stream-position - ;;buffer-stream-length - reset-buffer-stream - buffer-write-byte buffer-write-int buffer-write-uint - buffer-write-float buffer-write-double buffer-write-string - buffer-read-byte buffer-read-fixnum buffer-read-int - buffer-read-uint buffer-read-float buffer-read-double - #-(and allegreo ics) buffer-read-ucs1-string - #+(or lispworks (and allegro ics)) buffer-read-ucs2-string - #+(and sbcl sb-unicode) buffer-read-ucs4-string)) + write-int write-uint write-float write-double + offset-char-pointer copy-str-to-buf %copy-str-to-buf copy-bufs + ;;resize-buffer-stream + ;;buffer-stream-buffer buffer-stream-size buffer-stream-position + ;;buffer-stream-length + reset-buffer-stream + buffer-write-byte buffer-write-int buffer-write-uint + buffer-write-float buffer-write-double buffer-write-string + buffer-read-byte buffer-read-fixnum buffer-read-int + buffer-read-uint buffer-read-float buffer-read-double + #-(and allegreo ics) buffer-read-ucs1-string + #+(or lispworks (and allegro ics)) buffer-read-ucs2-string + #+(and sbcl sb-unicode) buffer-read-ucs4-string)) ;; Constants and Flags ;; eventually write a macro which generates a custom flag function. @@ -541,10 +541,11 @@ #+(or cmu sbcl scl) (defun copy-str-to-buf (d do s so l) - (declare (optimize (speed 3) (safety 0)) - (type array-or-pointer-char d) - (type fixnum do so l) - (type string s)) + (declare (optimize (speed 3) (safety 0)) + (type array-or-pointer-char d) + (type fixnum do so l) + (type string s)) +;; (format t "copy-str-to-buf s = ~A do =~a so=~A len=~A~%" s do so l) (%copy-str-to-buf d do #+sbcl (sb-sys:vector-sap s) @@ -660,6 +661,7 @@ (declare (optimize (speed 3) (safety 0)) (type buffer-stream bs) (type (unsigned-byte 8) b)) +;; (format t "BW-byte ~A~%" b) (with-struct-slots ((buf buffer-stream-buffer) (size buffer-stream-size) (len buffer-stream-length)) @@ -737,9 +739,9 @@ (defun buffer-write-string (s bs) "Write the underlying bytes of a string. On Unicode Lisps, this is a 16-bit operation." - (declare (optimize (speed 3) (safety 0)) - (type buffer-stream bs) - (type string s)) +;; (declare (optimize (speed 3) (safety 0)) +;; (type buffer-stream bs) +;; (type string s)) (with-struct-slots ((buf buffer-stream-buffer) (size buffer-stream-size) (len buffer-stream-length)) @@ -750,6 +752,8 @@ (dynamic-extent str-bytes needed)) (when (> needed len) (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"? (copy-str-to-buf buf size s 0 str-bytes) (setf size needed) nil))) @@ -853,11 +857,11 @@ (let ((res (make-string byte-length :element-type 'base-char))) #+#.(sleepycat::new-style-copy-p) (sb-kernel:copy-ub8-from-system-area - (sb-alien:alien-sap (buffer-stream-buffer bs)) - (* position sb-vm:n-byte-bits) - res - (* sb-vm:vector-data-offset sb-vm:n-word-bits) - (* byte-length sb-vm:n-byte-bits)) + (sb-alien:alien-sap (buffer-stream-buffer bs)) + position + res + 0 + byte-length) #-#.(sleepycat::new-style-copy-p) (sb-kernel:copy-from-system-area (sb-alien:alien-sap (buffer-stream-buffer bs)) @@ -896,12 +900,12 @@ (setf (buffer-stream-position bs) (+ position byte-length)) (let ((res (make-string (/ byte-length 4) :element-type 'character))) #+#.(sleepycat::new-style-copy-p) - (sb-kernel:copy-ub8-from-system-area - (sb-alien:alien-sap (buffer-stream-buffer bs)) - (* position sb-vm:n-byte-bits) - res - (* sb-vm:vector-data-offset sb-vm:n-word-bits) - (* byte-length sb-vm:n-byte-bits)) + (sb-kernel:copy-ub8-from-system-area + (sb-alien:alien-sap (buffer-stream-buffer bs)) + position + res + 0 + byte-length) #-#.(sleepycat::new-style-copy-p) (sb-kernel:copy-from-system-area (sb-alien:alien-sap (buffer-stream-buffer bs))

1 0

[elephant-cvs] CVS update: elephant/BEN-RETIRING-TODO.txt
by rread＠common-lisp.net 02 Dec '05

02 Dec '05

Update of /project/elephant/cvsroot/elephant In directory common-lisp.net:/tmp/cvs-serv16462 Added Files: BEN-RETIRING-TODO.txt Log Message: I thought this email from Ben was worth putting in here. Date: Fri Dec 2 16:05:49 2005 Author: rread

1 0

[elephant-cvs] CVS update: elephant/NEWS
by rread＠common-lisp.net 23 Nov '05

23 Nov '05

Update of /project/elephant/cvsroot/elephant In directory common-lisp.net:/tmp/cvs-serv588 Modified Files: NEWS Log Message: Slightly more accurate NEWS. Date: Wed Nov 23 19:17:52 2005 Author: rread Index: elephant/NEWS diff -u elephant/NEWS:1.7 elephant/NEWS:1.8 --- elephant/NEWS:1.7 Wed Nov 23 18:51:31 2005 +++ elephant/NEWS Wed Nov 23 19:17:52 2005 @@ -3,6 +3,14 @@ support for relational database backends, repository migration, and multi-repository operation. +As of this release, the documentation provides a +lot of information about installation and getting +things working; I wouldn't at all claim that it +is complete, smooth, or well organized. The more +notes I get about the use of Elephant, the more +inclined I will be to invest time in improving +the documentation. + October 7, 2004 - Elephant 0.2.1 released. Thanks to Bill Clementson,

1 0

[elephant-cvs] CVS update: elephant/doc/sql-backend.texinfo
by rread＠common-lisp.net 23 Nov '05

23 Nov '05

Update of /project/elephant/cvsroot/elephant/doc In directory common-lisp.net:/tmp/cvs-serv588/doc Modified Files: sql-backend.texinfo Log Message: Slightly more accurate NEWS. Date: Wed Nov 23 19:17:53 2005 Author: rread Index: elephant/doc/sql-backend.texinfo diff -u elephant/doc/sql-backend.texinfo:1.2 elephant/doc/sql-backend.texinfo:1.3 --- elephant/doc/sql-backend.texinfo:1.2 Wed Nov 23 18:51:34 2005 +++ elephant/doc/sql-backend.texinfo Wed Nov 23 19:17:52 2005 @@ -147,7 +147,7 @@ So you could put a symbolic link to libpq.so there, where libmemutil.so and libsleepycat.so will also reside. -Versions of CL-SQL older than 3.2.3 might requie something different. +Versions of CL-SQL older than 3.2.3 might require something different. @node Multi-repository Operation @comment node-name, next, previous, up

1 0