elephant-cvs

elephant-cvs@common-lisp.net

858 discussions

[elephant-cvs] CVS elephant/tests
by rread 06 Feb '07

06 Feb '07

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv3412 Modified Files: testindexing.lisp Log Message: Improvements in the indexing test --- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/02/05 19:33:46 1.23 +++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/02/06 16:32:02 1.24 @@ -389,15 +389,22 @@ (stress3 :accessor stress3 :initarg :stress3 :initform 3 :index nil)) (:metaclass persistent-metaclass))) +(defparameter *stress-count* 700) +(defparameter *range-size* 10) + +(defun non-monotonic-stress-def (i) + (- *stress-count* i) +) + (defun normal-stress-setup (count class-name &rest inst-args) (setf normal-index (make-btree)) (dotimes (i count) - (setf (get-value i normal-index) (apply #'make-instance class-name :stress1 i inst-args)))) + (setf (get-value i normal-index) (apply #'make-instance class-name :stress1 (non-monotonic-stress-def i) inst-args)))) (defun indexed-stress-setup (count class-name &rest inst-args) (dotimes (i count) (progn - (apply #'make-instance class-name :stress1 i inst-args)))) + (apply #'make-instance class-name :stress1 (non-monotonic-stress-def i) inst-args)))) (defun normal-range-lookup (count size) "Given stress1 slot has values between 1 and count, extract a range of size size that starts @@ -410,8 +417,11 @@ (multiple-value-bind (value? key val) (cursor-next cur) (declare (ignore key)) (cond ((or (not value?) - (and value? - (>= (stress1 val) end))) +;; I think these lines were in correctly assuming a particular order. +;; (and value? +;; (>= (stress1 val) end) +;; ) + ) (return-from normal-range-lookup objects)) ((and value? (>= (stress1 val) start) @@ -421,56 +431,52 @@ (defun indexed-range-lookup (class count size) (let* ((start (/ count 2)) - (end (1- (+ start size)))) + (end (1- (+ start size))) + (res (get-instances-by-range class 'stress1 start end))) + res + )) + -(defparameter *stress-count* 700) -;;(defparameter *stress-count* 70) -(defparameter *range-size* 80) (deftest indexing-timing (progn (make-stress-classes) -;; (trace elephant::drop-pobject) -;; (trace remove-kv) (let ((insts (get-instances-by-class 'stress-index)) (start nil) (end nil) + (normal-check nil) + (index-check nil) (normal-time 0) (index-time 0)) (when insts (drop-instances insts :sc *store-controller*)) - (format t "Got done with that~%") - (format t "~%Stress test normal setup time (~A):~%" *stress-count*) (with-transaction () (normal-stress-setup *stress-count* 'stress-normal :stress2 10)) - (format t "~%Stress test indexed setup time (~A):~%" *stress-count*) (with-transaction () (indexed-stress-setup *stress-count* 'stress-index :stress2 10)) - (format t "~%Stress test normal lookup time (~A):~%" *range-size*) (setf start (get-internal-run-time)) (dotimes (i *range-size*) (declare (ignore i)) - (normal-range-lookup *stress-count* *range-size*)) + (push (length (normal-range-lookup *stress-count* *range-size*)) + normal-check)) (setf end (get-internal-run-time)) (setf normal-time (/ (- end start 0.0) internal-time-units-per-second)) - (format t "~%Stress test indexed lookup time (~A):~%" *range-size*) -;; (trace indexed-range-lookup) -;; (trace get-instances-by-range) (setf start (get-internal-run-time)) (dotimes (i *range-size*) (declare (ignore i)) - (indexed-range-lookup 'stress-index *stress-count* *range-size*)) + (push (length (indexed-range-lookup 'stress-index *stress-count* *range-size*)) + index-check)) (setf end (get-internal-run-time)) (setf index-time (/ (- end start 0.0) internal-time-units-per-second)) - (format t "~%Ranged get of ~A/~A objects = Linear: ~A sec Indexed: ~A sec~%" *range-size* *stress-count* normal-time index-time) - (> normal-time index-time))) + (and (equal normal-check index-check) (> normal-time index-time))) + ) t)

1 0

[elephant-cvs] CVS elephant/tests
by rread 05 Feb '07

05 Feb '07

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv19168 Modified Files: elephant-tests.lisp testindexing.lisp Log Message: Some things to test just pieces --- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2007/02/04 10:08:28 1.23 +++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2007/02/05 19:33:46 1.24 @@ -161,6 +161,7 @@ (defun do-indexing-tests (&optional (spec *default-spec*)) "Just test indexing" (with-open-store (spec) + (make-stress-classes) (print (do-test 'indexing-basic)) (print (do-test 'indexing-inherit)) (print (do-test 'indexing-range)) @@ -169,6 +170,76 @@ (print (do-test 'indexing-redef-class)) (print (do-test 'indexing-timing)))) +(defun do-collection-tests (&optional (spec *default-spec*)) + "Just test indexing" + (with-open-store (spec) + (print (do-test 'basicpersistence)) + (print (do-test 'testoid)) + (print (do-test 'btree-make)) + (print (do-test 'btree-put)) + (print (do-test 'btree-get)) + (print (do-test 'remove-kv)) + (print (do-test 'removed)) + (print (do-test 'map-btree)) + (print (do-test 'indexed-btree-make)) + (print (do-test 'indexed-btree-make)) + (print (do-test 'add-indices)) + (print (do-test 'test-indices)) + (print (do-test 'indexed-put)) + (print (do-test 'indexed-get)) + (print (do-test 'simple-slot-get)) + (print (do-test 'indexed-get-from-slot1)) + (print (do-test 'indexed-get-from-slot2)) + (print (do-test 'remove-kv-indexed)) + (print (do-test 'no-key-nor-indices)) + (print (do-test 'remove-kv-from-slot1)) + (print (do-test 'no-key-nor-indices-slot1)) + (print (do-test 'remove-kv-from-slot2)) + (print (do-test 'no-key-nor-indices-slot2)) + (print (do-test 'map-indexed)) + (print (do-test 'get-first)) + (print (do-test 'get-first2)) + (print (do-test 'get-last)) + (print (do-test 'get-last2)) + (print (do-test 'set)) + (print (do-test 'set2)) + (print (do-test 'set-range)) + (print (do-test 'set-range2)) + (print (do-test 'rem-kv)) + (print (do-test 'rem-idexkv)) + (print (do-test 'make-indexed2)) + (print (do-test 'add-indices2)) + (print (do-test 'put-indexed2)) + (print (do-test 'get-indexed2)) + (print (do-test 'get-from-index3)) + (print (do-test 'dup-test)) + (print (do-test 'nodup-test)) + (print (do-test 'prev-nodup-test)) + (print (do-test 'pnodup-test)) + (print (do-test 'pprev-nodup-test)) + (print (do-test 'cur-del1)) + (print (do-test 'indexed-delete)) + (print (do-test 'test-deleted)) + (print (do-test 'indexed-delete2)) + (print (do-test 'test-deleted2)) + (print (do-test 'cur-del2)) + (print (do-test 'get-both)) + (print (do-test 'pget-both)) + (print (do-test 'pget-both-range)) + (print (do-test 'pcursor)) + (print (do-test 'newindex)) + (print (do-test 'pcursor2)) + (print (do-test 'add-get-remove)) + (print (do-test 'add-get-remove-symbol)) + (print (do-test 'existsp)) + )) + +(defun do-cur-del2-test (&optional (spec *default-spec*)) + "Just test indexing" + (with-open-store (spec) + (print (do-test 'cur-del2)) + )) + (defun do-crazy-pg-tests() "Specific problematic pg tests" (open-store *testpg-spec*) --- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/02/03 04:09:14 1.22 +++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/02/05 19:33:46 1.23 @@ -321,7 +321,6 @@ (:metaclass persistent-metaclass)) (disable-class-indexing 'idx-eight :errorp nil) (setf (find-class 'idx-eight nil) nil)) - ;; (format t "sc: ~A ct: ~A~%" *store-controller* *current-transaction*) (defclass idx-eight () ((slot1 :accessor slot1 :initarg :slot1 :index t) @@ -330,13 +329,11 @@ (slot4 :accessor slot4 :initarg :slot4 :index t) (slot5 :accessor slot5 :initarg :slot5)) (:metaclass persistent-metaclass)) - (let ((o1 nil) (o2 nil)) (with-transaction () (setf o1 (make-instance 'idx-eight :slot1 1 :slot2 2 :slot3 3 :slot4 4 :slot5 5)) (setf o2 (make-instance 'idx-eight :slot1 10 :slot2 20 :slot3 30 :slot4 40 :slot5 50))) - (defclass idx-eight () ((slot1 :accessor slot1 :initarg :slot1 :initform 11) (slot2 :accessor slot2 :initarg :slot2 :initform 12 :index t) @@ -344,23 +341,35 @@ (slot6 :accessor slot6 :initarg :slot6 :initform 14 :index t) (slot7 :accessor slot7 :initarg :slot7)) (:metaclass persistent-metaclass)) - - (values - (and (eq (slot1 o1) 1) - (signals-error (get-instances-by-value 'idx-eight 'slot1 1))) - (and (eq (slot2 o1) 2) - (eq (length (get-instances-by-value 'idx-eight 'slot2 2)) 1)) - (eq (slot3 o1) 13) ;; transient values not preserved (would be inconsistent) - (and (not (slot-exists-p o1 'slot4)) - (not (slot-exists-p o1 'slot5)) - (signals-error (get-instances-by-value 'idx-eight 'slot4 4))) - (eq (slot6 o1) 14) - (eq (length (get-instances-by-value 'idx-eight 'slot6 14)) 2) - (and ;;(slot-exists-p o1 'slot7) - (not (slot-boundp o1 'slot7))) - (and ;;(slot-exists-p o2 'slot7) - (not (slot-boundp o2 'slot7)))))) - t t t t t t t t) + ;; (format t "indexing redef-class d~%") + (let (( + v1 + (and (eq (slot1 o1) 1) + (signals-error (get-instances-by-value 'idx-eight 'slot1 1)))) + ;; (v1x (format t "indexing redef-class v1x~%")) + (v2 (and (eq (slot2 o1) 2) + (eq (length (get-instances-by-value 'idx-eight 'slot2 2)) 1))) + ;; (v2x (format t "indexing redef-class v2x~%")) + (v3 (eq (slot3 o1) 13)) ;; transient values not preserved (would be inconsistent) + ;; (v3x (format t "indexing redef-class v3x~%")) + (v4 (and (not (slot-exists-p o1 'slot4)) + (not (slot-exists-p o1 'slot5)) + (signals-error (get-instances-by-value 'idx-eight 'slot4 4)))) + ;; (v4x (format t "indexing redef-class v4x~%")) + (v5 (eq (slot6 o1) 14)) + ;; (v5x (format t "indexing redef-class v5x~%")) + (v6 (eq (length (get-instances-by-value 'idx-eight 'slot6 14)) 2)) + ;; (v6x (format t "indexing redef-class v6x~%")) + (v7 (and ;;(slot-exists-p o1 'slot7) + (not (slot-boundp o1 'slot7)))) + ;; (v7x (format t "indexing redef-class v7x~%")) + (v8 (and ;;(slot-exists-p o2 'slot7) + (not (slot-boundp o2 'slot7)))) + ;; (v8x (format t "indexing redef-class v8x~%"))) + ) + (values + v1 v2 v3 v4 v5 v6 v7 v8)))) + t t t t t t t t) ;; create 500 objects, write each object's slots @@ -387,7 +396,8 @@ (defun indexed-stress-setup (count class-name &rest inst-args) (dotimes (i count) - (apply #'make-instance class-name :stress1 i inst-args))) + (progn + (apply #'make-instance class-name :stress1 i inst-args)))) (defun normal-range-lookup (count size) "Given stress1 slot has values between 1 and count, extract a range of size size that starts @@ -415,11 +425,14 @@ (get-instances-by-range class 'stress1 start end))) (defparameter *stress-count* 700) +;;(defparameter *stress-count* 70) (defparameter *range-size* 80) (deftest indexing-timing (progn (make-stress-classes) +;; (trace elephant::drop-pobject) +;; (trace remove-kv) (let ((insts (get-instances-by-class 'stress-index)) (start nil) (end nil) @@ -428,15 +441,16 @@ (when insts (drop-instances insts :sc *store-controller*)) -;; (format t "~%Stress test normal setup time (~A):~%" *stress-count*) + (format t "Got done with that~%") + (format t "~%Stress test normal setup time (~A):~%" *stress-count*) (with-transaction () (normal-stress-setup *stress-count* 'stress-normal :stress2 10)) -;; (format t "~%Stress test indexed setup time (~A):~%" *stress-count*) + (format t "~%Stress test indexed setup time (~A):~%" *stress-count*) (with-transaction () (indexed-stress-setup *stress-count* 'stress-index :stress2 10)) -;; (format t "~%Stress test normal lookup time (~A):~%" *range-size*) + (format t "~%Stress test normal lookup time (~A):~%" *range-size*) (setf start (get-internal-run-time)) (dotimes (i *range-size*) (declare (ignore i)) @@ -444,7 +458,9 @@ (setf end (get-internal-run-time)) (setf normal-time (/ (- end start 0.0) internal-time-units-per-second)) -;; (format t "~%Stress test indexed lookup time (~A):~%" *range-size*) + (format t "~%Stress test indexed lookup time (~A):~%" *range-size*) +;; (trace indexed-range-lookup) +;; (trace get-instances-by-range) (setf start (get-internal-run-time)) (dotimes (i *range-size*) (declare (ignore i))

1 0

[elephant-cvs] CVS elephant
by ieslick 05 Feb '07

05 Feb '07

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv19051 Modified Files: INSTALL TODO elephant.asd Log Message: Integrated Henrik's changes, except for the sbcl/%bignum-ref in serializer2.lisp which I believed we fixed by importing it from :sb-bignum --- /project/elephant/cvsroot/elephant/INSTALL 2007/01/25 18:17:59 1.20 +++ /project/elephant/cvsroot/elephant/INSTALL 2007/02/05 19:33:10 1.21 @@ -15,7 +15,7 @@ UFFI 1.5.4+ - http://uffi.b9.com/ A Backend Database: -1) Oracle Berkeley DB 4.4 or 4.5 - http://www.oracle.com/database/berkeley-db.html +1) Oracle Berkeley DB 4.5 - http://www.oracle.com/database/berkeley-db.html 2) CLSQL - http://clsql.b9.com/ with an appropriate SQL installation. Tested with SQlite3 and Postgresql so far @@ -57,7 +57,7 @@ 2) Install UFFI -3) Install a backend: Either Berkeley DB 4.4, PostGresql, or SQLite 3. +3) Install a backend: Either Berkeley DB 4.5, PostGresql, or SQLite 3. ------- SQL @@ -67,11 +67,13 @@ other the heading "SQL-BACK-END". ------------- -Berkeley 4.4: +Berkeley 4.5: ------------- -(Note: 0.6.0 users used 4.3; upgrade to 4.4 and run 0.6.1+ and - your existing DB will automatically upgrade when the DB is opened) +(Note: 0.6.0 required BDB 4.3; to upgrade 0.6.0 to 0.6.1, upgrade BDB to 4.5, + modify my-config.sexp appropriately then run 0.6.1+; your underlying Berekely DB + files will automatically upgrade when the DB is opened. To use 0.6.1, you will + have to manually migrate your 0.6.0 database to a fresh database created in 0.6.1) Under Un*x, you may actually already have this installed, though it may be compiled with funny options, so if things don't work @@ -79,11 +81,11 @@ for this, as I'm sure do other BSDs (including DarwinPorts/Fink.) Take note of where libdb.so and db.h are installed, usually: - /usr/local/BerkeleyDB.4.4/lib/libdb.so and - /usr/local/BerkeleyDB.4.4/include/db.h, or + /usr/local/BerkeleyDB.4.5/lib/libdb.so and + /usr/local/BerkeleyDB.4.5/include/db.h, or - /usr/local/lib/db44/libdb.so and - /usr/local/include/db44/db.h.) + /usr/local/lib/db45/libdb.so and + /usr/local/include/db45/db.h.) a) Site specific configuration --- /project/elephant/cvsroot/elephant/TODO 2007/02/05 00:32:27 1.44 +++ /project/elephant/cvsroot/elephant/TODO 2007/02/05 19:33:10 1.45 @@ -6,18 +6,20 @@ 0.6.1 - performance, safety and portability -------------------------------------------- -Active tasks: +ALPHA RELEASE TASKS + +Bug and feature fixes: ~ Resolve duplicate sorting guarantee in btree interface; currently supported by BDB but not SQL and it is not tested in the regression suite (Robert) -- Trace all paths to db-put or db-delete and ensure that there is a check or a - default ensure-transaction around the primitive components - write a document - clarifying transaction design & assumptions in the backend] - Fix *dbconnection-spec* to support multiple controllers for multiple threads for CLSQL backend - Validate migration 0.6.0->0.6.1 -- Improve SQL serializer performance (Robert) +- Fix cur-del2 failure under SBCL -BDB Features: +BDB Features/Cleanup: +- Trace all paths to db-put or db-delete and ensure that there is a check or a + default ensure-transaction around the primitive components - write a document + clarifying transaction design & assumptions in the backend] - Determine how to detect deadlock conditions as an optional run-safe mode? - Automatically run db_deadlock when opening a bdb backend? Requires path to functions and ability to launch shell command. Closing the store stops the @@ -26,22 +28,25 @@ - Figure out how to compact a specific btree and/or key-range using optimize-storage. Probably need to update keyword part of the API -ALPHA RELEASE ITEMS +BETA RELEASE TASKS Lisp support: -- 64-bit lisp verification - Win32 builds - Windows support for asdf-based library builds? Include 32-bit dll in release? -- OpenMCL 1.1 on Mac OS X -- Lispworks +- Validate OpenMCL 1.1 on Mac OS X +- Validate Lispworks +- 64-bit lisp verification -Stability: +Stability and Performance: - Review and address all NOTE comments in the code +- Review SBCL string serialization performance +- Improve SQL base-64 serializer performance? +- Improve SQL secondary cursor performance (Robert) Migration: - Validate that migrate can use either O(c) or O(n/c) where c << n memory for large DBs -BETA RELEASE ITEMS +FINAL RELEASE TASKS Test coverage: - Test for optimize storage method (just add probe-file methods to get file size) --- /project/elephant/cvsroot/elephant/elephant.asd 2007/02/03 00:57:33 1.26 +++ /project/elephant/cvsroot/elephant/elephant.asd 2007/02/05 19:33:10 1.27 @@ -109,7 +109,7 @@ (list #-(or darwin macosx darwin-host) "-shared" #+(or darwin macosx darwin-host) "-bundle" - #+(or x8664-target) "-arch x86_64" + #+(or :X86-64) "-arch x86_64" "-Wall" "-fPIC" "-O3"

1 0

[elephant-cvs] CVS elephant/src/contrib/henrik
by ieslick 05 Feb '07

05 Feb '07

Update of /project/elephant/cvsroot/elephant/src/contrib/henrik In directory clnet:/tmp/cvs-serv19051/src/contrib/henrik Added Files: install-bdb.sh Log Message: Integrated Henrik's changes, except for the sbcl/%bignum-ref in serializer2.lisp which I believed we fixed by importing it from :sb-bignum --- /project/elephant/cvsroot/elephant/src/contrib/henrik/install-bdb.sh 2007/02/05 19:33:11 NONE +++ /project/elephant/cvsroot/elephant/src/contrib/henrik/install-bdb.sh 2007/02/05 19:33:11 1.1 #!/bin/sh # Latest 4.5 release from http://www.oracle.com/technology/software/products/berkeley-db/db/index.html OLDDIR=`pwd` VERSION="4.5.20" echo Downloading $VERSION if [ -d db-$VERSION ]; then echo "Berkeley DB $VERSION already downloaded, will not install it" else wget http://download.oracle.com/berkeley-db/db-$VERSION.tar.gz tar -xvf db-$VERSION.tar.gz cd db-$VERSION/build_unix/ ../dist/configure make #Check for sufficient write privileges if [ -w /usr/local/BerkeleyDB.4.5 ] ; then make install else #Install as super user echo "Elephant install-bdb" echo "Make install needs write permissions to /usr/local, running:" echo "sudo make install" sudo make install fi fi cd $OLDDIR echo "Create my-config.sexp" if [ -e /usr/local/BerkeleyDB.4.5/lib/ ] ; then if [ -e my-config.sexp ] ; then echo "my-config.sexp already exists, will not overwrite it" else echo '' > my-config.sexp echo '((:berkeley-db-include-dir . "/usr/local/BerkeleyDB.4.5/include/")' >> my-config.sexp echo ' (:berkeley-db-lib-dir . "/usr/local/BerkeleyDB.4.5/lib/")' >> my-config.sexp echo ' (:berkeley-db-lib . "/usr/local/BerkeleyDB.4.5/lib/libdb-4.5.so")' >> my-config.sexp echo ' (:pthread-lib . nil)' >> my-config.sexp echo ' (:clsql-lib . nil))' >> my-config.sexp fi fi

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 05 Feb '07

05 Feb '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv19051/src/elephant Modified Files: serializer2.lisp Log Message: Integrated Henrik's changes, except for the sbcl/%bignum-ref in serializer2.lisp which I believed we fixed by importing it from :sb-bignum --- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/05 17:22:57 1.17 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/05 19:33:11 1.18 @@ -152,8 +152,9 @@ ;; SERIALIZER ;; -(defconstant +2^32+ 4294967296) -(defconstant +2^64+ 18446744073709551616) +(defconstant +2^31+ (expt 2 31)) +(defconstant +2^32+ (expt 2 32)) +(defconstant +2^64+ (expt 2 64)) (defun serialize (frob bs sc) "Serialize a lisp value into a buffer-stream." @@ -173,7 +174,7 @@ (buffer-write-int32 frob bs)) (progn (assert (< #.most-positive-fixnum +2^64+)) - (if (< frob +2^32+) + (if (< (abs frob) +2^32+) (progn (buffer-write-byte +fixnum32+ bs) (buffer-write-int32 frob bs))

1 0

[elephant-cvs] CVS elephant/src/contrib/henrik
by ieslick 05 Feb '07

05 Feb '07

Update of /project/elephant/cvsroot/elephant/src/contrib/henrik In directory clnet:/tmp/cvs-serv18943/henrik Log Message: Directory /project/elephant/cvsroot/elephant/src/contrib/henrik added to the repository

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 05 Feb '07

05 Feb '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv29823/src/elephant Modified Files: serializer2.lisp Log Message: Support sqlite3 in delete script; fix allegro %bignum conditional bug --- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/05 16:09:25 1.16 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/05 17:22:57 1.17 @@ -44,7 +44,7 @@ (inline serialize deserialize slots-and-values deserialize-bignum - %bignum-ref))) + #+(or sbcl cmu) %bignum-ref))) (uffi:def-type foreign-char :char) @@ -332,9 +332,9 @@ ;; there is an OpenMCL function which should work ;; and non-cons do - #+(or cmu sbcl allegro) + #+(or cmu sbcl) (buffer-write-uint (%bignum-ref num i) bs) - #+(or lispworks openmcl) + #+(or lispworks openmcl allegro) (buffer-write-uint (ldb (byte 32 (* 32 i)) num) bs) )))

1 0

[elephant-cvs] CVS elephant/tests
by ieslick 05 Feb '07

05 Feb '07

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv29823/tests Modified Files: delscript.sh Log Message: Support sqlite3 in delete script; fix allegro %bignum conditional bug --- /project/elephant/cvsroot/elephant/tests/delscript.sh 2007/01/22 16:17:44 1.3 +++ /project/elephant/cvsroot/elephant/tests/delscript.sh 2007/02/05 17:22:58 1.4 @@ -9,4 +9,6 @@ rm testbdb/testsbdb rm testbdb/__* rm testbdb/log* -rm testbdb/VERSION \ No newline at end of file +rm testbdb/VERSION +rm sqlite3-test.db +rm sqlite3-test2.db \ No newline at end of file

1 0

[elephant-cvs] CVS elephant/src/elephant
by rread 05 Feb '07

05 Feb '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv15946/src/elephant Modified Files: serializer2.lisp Log Message: Changing misspelled maybe-cons symbol. --- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/05 03:18:22 1.15 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/05 16:09:25 1.16 @@ -410,7 +410,7 @@ ((= tag +hash-table+) (let* ((id (buffer-read-fixnum bs)) (maybe-hash (lookup-id id))) - (declare (dynamic-extent id maybe-cons) + (declare (dynamic-extent id maybe-hash) (type fixnum id)) (if maybe-hash maybe-hash (let* ((test (%deserialize bs))

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 05 Feb '07

05 Feb '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv8038/src/elephant Modified Files: serializer1.lisp serializer2.lisp Log Message: Small fix and a renaming to avoid warnings in SBCL --- /project/elephant/cvsroot/elephant/src/elephant/serializer1.lisp 2007/02/05 00:40:31 1.5 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer1.lisp 2007/02/05 03:18:22 1.6 @@ -18,7 +18,10 @@ (defpackage :elephant-serializer1 (:use :cl :elephant :elephant-memutil) - #+(or cmu sbcl) + #+cmu + (:import-from :bignum + %bignum-ref) + #+sbcl (:import-from :sb-bignum %bignum-ref) (:import-from :elephant --- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/05 01:01:26 1.14 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/05 03:18:22 1.15 @@ -18,12 +18,14 @@ (defpackage :elephant-serializer2 (:use :cl :elephant :elephant-memutil :elephant-utils) - #+(or cmu sbcl) + #+cmu + (:import-from :bignum + %bignum-ref) + #+sbcl (:import-from :sb-bignum %bignum-ref) (:import-from :elephant *circularity-initial-hash-size* - #+(or cmu sbcl allegro) get-cached-instance controller-symbol-cache controller-symbol-id-cache @@ -37,11 +39,12 @@ (in-package :elephant-serializer2) -(eval-when (compile) +(eval-when (:compile-toplevel) (declaim #-elephant-without-optimize (optimize (speed 3) (safety 1) (space 0) (debug 0)) (inline serialize deserialize slots-and-values - deserialize-bignum))) + deserialize-bignum + %bignum-ref))) (uffi:def-type foreign-char :char) @@ -156,11 +159,11 @@ "Serialize a lisp value into a buffer-stream." (declare (type buffer-stream bs) (ignorable sc)) - (let ((*lisp-obj-id* -1) - (*circularity-hash* (get-circularity-hash))) + (let ((lisp-obj-id -1) + (circularity-hash (get-circularity-hash))) (labels ((%next-object-id () - (incf *lisp-obj-id*)) + (incf lisp-obj-id)) (%serialize (frob) (etypecase frob (fixnum @@ -214,12 +217,12 @@ (buffer-write-double frob bs)) (standard-object (buffer-write-byte +object+ bs) - (let ((idp (gethash frob *circularity-hash*))) + (let ((idp (gethash frob circularity-hash))) (if idp (buffer-write-int32 idp bs) (progn (let ((id (%next-object-id))) (buffer-write-int32 id bs) - (setf (gethash frob *circularity-hash*) id)) + (setf (gethash frob circularity-hash) id)) (%serialize (type-of frob)) (let ((svs (slots-and-values frob))) (declare (dynamic-extent svs)) @@ -238,12 +241,12 @@ (buffer-write-uint (char-code frob) bs)) (cons (buffer-write-byte +cons+ bs) - (let ((idp (gethash frob *circularity-hash*))) + (let ((idp (gethash frob circularity-hash))) (if idp (buffer-write-int32 idp bs) (progn (let ((id (%next-object-id))) (buffer-write-int32 id bs) - (setf (gethash frob *circularity-hash*) id)) + (setf (gethash frob circularity-hash) id)) (%serialize (car frob)) (%serialize (cdr frob)))))) (pathname @@ -252,12 +255,12 @@ (serialize-string pstring bs))) (hash-table (buffer-write-byte +hash-table+ bs) - (let ((idp (gethash frob *circularity-hash*))) + (let ((idp (gethash frob circularity-hash))) (if idp (buffer-write-int32 idp bs) (progn (let ((id (%next-object-id))) (buffer-write-int32 id bs) - (setf (gethash frob *circularity-hash*) id)) + (setf (gethash frob circularity-hash) id)) (%serialize (hash-table-test frob)) (%serialize (hash-table-rehash-size frob)) (%serialize (hash-table-rehash-threshold frob)) @@ -269,11 +272,11 @@ (%serialize value)))))) ;; (structure-object ;; (buffer-write-byte +struct+ bs) - ;; (let ((idp (gethash frob *circularity-hash*))) + ;; (let ((idp (gethash frob circularity-hash))) ;; (if idp (buffer-write-int32 idp bs) ;; (progn - ;; (buffer-write-int32 (incf *lisp-obj-id*) bs) - ;; (setf (gethash frbo *circularity-hash*) *lisp-obj-id*) + ;; (buffer-write-int32 (incf lisp-obj-id) bs) + ;; (setf (gethash frbo circularity-hash) lisp-obj-id) ;; (%serialize (type-of frob)) ;; (let ((svs (slots-and-values frob))) ;; (declare (dynamic-extent svs)) @@ -282,12 +285,12 @@ ;; do (%serialize item))))))) (array (buffer-write-byte +array+ bs) - (let ((idp (gethash frob *circularity-hash*))) + (let ((idp (gethash frob circularity-hash))) (if idp (buffer-write-int32 idp bs) (progn (let ((id (%next-object-id))) (buffer-write-int32 id bs) - (setf (gethash frob *circularity-hash*) id)) + (setf (gethash frob circularity-hash) id)) (buffer-write-byte (logior (byte-from-array-type (array-element-type frob)) (if (array-has-fill-pointer-p frob) @@ -306,7 +309,7 @@ (%serialize (row-major-aref frob i))))))) ))) (%serialize frob) - (release-circularity-hash *circularity-hash*) + (release-circularity-hash circularity-hash) bs))) (defun serialize-bignum (frob bs) @@ -330,9 +333,7 @@ ;; and non-cons do #+(or cmu sbcl allegro) - (progn (setf (cdr byte-spec) (* 32 i)) - (%bignum-ref num i) bs) -;; (buffer-write-uint (ldb byte-spec num) bs)) + (buffer-write-uint (%bignum-ref num i) bs) #+(or lispworks openmcl) (buffer-write-uint (ldb (byte 32 (* 32 i)) num) bs) ))) @@ -344,14 +345,14 @@ (defun deserialize (buf-str sc) "Deserialize a lisp value from a buffer-stream." (declare (type (or null buffer-stream) buf-str)) - (let ((*circularity-vector* (get-circularity-vector))) + (let ((circularity-vector (get-circularity-vector))) (labels ((lookup-id (id) - (if (>= id (fill-pointer *circularity-vector*)) nil - (aref *circularity-vector* id))) + (if (>= id (fill-pointer circularity-vector)) nil + (aref circularity-vector id))) (add-object (object) - (vector-push-extend object *circularity-vector* 50) - (1- (fill-pointer *circularity-vector*))) + (vector-push-extend object circularity-vector 50) + (1- (fill-pointer circularity-vector))) (%deserialize (bs) (declare (type buffer-stream bs)) (let ((tag (buffer-read-byte bs))) @@ -484,7 +485,7 @@ (null (return-from deserialize nil)) (buffer-stream (let ((result (%deserialize buf-str))) - (release-circularity-vector *circularity-vector*) + (release-circularity-vector circularity-vector) result)))))) (defun deserialize-bignum (bs length positive)

1 0

← Newer
1
...
29
30
31
32
33
34
35
...
86
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

elephant-cvs