elephant-cvs February 2007

elephant-cvs@common-lisp.net

2 participants
167 discussions

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

07 Feb '07

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv4302/tests Modified Files: elephant-tests.lisp testindexing.lisp Log Message: Commiting a thread-safe version of the SQL side (but SBCL-depdent.) --- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2007/02/05 19:33:46 1.24 +++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2007/02/07 22:54:13 1.25 @@ -165,10 +165,12 @@ (print (do-test 'indexing-basic)) (print (do-test 'indexing-inherit)) (print (do-test 'indexing-range)) + (print (do-test 'indexing-wipe-index)) (print (do-test 'indexing-reconnect-db)) (print (do-test 'indexing-change-class)) (print (do-test 'indexing-redef-class)) - (print (do-test 'indexing-timing)))) + (print (do-test 'indexing-timing)) + )) (defun do-collection-tests (&optional (spec *default-spec*)) "Just test indexing" --- /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/02/06 16:32:02 1.24 +++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp 2007/02/07 22:54:13 1.25 @@ -204,7 +204,9 @@ (defclass idx-five-del () ((slot1 :initarg :slot1 :initform 1 :accessor slot1)) (:metaclass persistent-metaclass)) - + (format t "r1 = ~A~%" r1) + (format t "r1 = ~A~%" (get-index (get-value 'idx-five-del (elephant::controller-class-root *store-controller*)) + 'slot1)) (values (eq (length r1) 1) (signals-error (get-instances-by-value 'idx-five-del 'slot1 1))

1 0

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

07 Feb '07

Update of /project/elephant/cvsroot/elephant/src/db-clsql In directory clnet:/tmp/cvs-serv4302/src/db-clsql Modified Files: package.lisp sql-controller.lisp Log Message: Commiting a thread-safe version of the SQL side (but SBCL-depdent.) --- /project/elephant/cvsroot/elephant/src/db-clsql/package.lisp 2006/11/11 18:41:11 1.1 +++ /project/elephant/cvsroot/elephant/src/db-clsql/package.lisp 2007/02/07 22:54:12 1.2 @@ -20,5 +20,8 @@ (defpackage db-clsql (:use :common-lisp :uffi :cl-base64 - :elephant :elephant-memutil :elephant-backend)) + :elephant :elephant-memutil :elephant-backend +;; :elephant-utils + #+sbcl :sb-thread + )) --- /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2007/02/05 00:32:27 1.16 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-controller.lisp 2007/02/07 22:54:12 1.17 @@ -22,14 +22,64 @@ ;; The main SQL Controller Class ;; +;; Every actual CL-SQL connection has to be in a separate thread. +;; My solution to this is to keep a map of threads, and reuse +;; connections within a certain thread. +;; This seems to be effective under SBCL; as of 06-Feb-2007 we +;; don't necessarily have a way to do this under the other implementations +;; (see src/utils/lock.lisp.) + (defclass sql-store-controller (store-controller) - ((db :accessor controller-db :initarg :db :initform nil)) + ( +;; (db :accessor controller-db :initarg :db :initform nil) + (dbcons :accessor controller-db-table :initarg :db :initform nil) + ) (:documentation "Class of objects responsible for the book-keeping of holding DB handles, the cache, table creation, counters, locks, the root (for garbage collection,) et cetera. This is the Postgresql-specific subclass of store-controller.")) + +;; This should be much more elegant --- but as of Feb. 6, SBCL 1.0.2 has a weird, +;; unpleasant bug when ASDF tries to load this stuff. +;; (defvar *thread-table-lock* nil) +;; (defvar *thread-table-lock* (sb-thread::make-mutex :name "thread-table-lock")) + +(defvar *thread-table-lock* nil) + +(defun insure-thread-table-lock () + (if (null *thread-table-lock*) +;; nil +;; (setq *thread-table-lock* (sb-thread::make-mutex :name "thread-table-lock")) + (setq *thread-table-lock* (elephant::ele-make-lock)) + ) +) + + +(defun thread-hash () + (elephant::ele-thread-hash-key) +) + + +(defmethod controller-db ((sc sql-store-controller)) + (elephant::ele-with-lock (*thread-table-lock*) + (let ((curcon (gethash (thread-hash) (controller-db-table sc)))) + (if curcon + curcon + (let* ((dbtype (car (second (controller-spec sc)))) + (con (clsql:connect (cdr (second (controller-spec sc))) + :database-type dbtype + :pool t + :if-exists :new))) + (setf (gethash (thread-hash) (controller-db-table sc)) + con) + con) + ) + ) + )) + + (eval-when (:compile-toplevel :load-toplevel) (register-backend-con-init :clsql 'sql-test-and-construct)) @@ -270,15 +320,25 @@ ;; CREATE-SEQUENCE and SEQUENCE-NEXT. That would solve our problem! ;; ALL OF THIS needs to be inside a transaction. - (clsql::create-table [keyvalue] - - ;; This is most likely to work with any database system.. - '( - ([clctn_id] integer :not-null) - ([key] text :not-null) - ([value] text) - ) - :database con) + (clsql::create-sequence [serial] :database con) + (clsql::query + (format nil "create table keyvalue ( + pk integer PRIMARY KEY DEFAULT nextval('serial'), + clctn_id integer NOT NULL, + key varchar NOT NULL, + value varchar + )") + :database con) + + ;; (clsql::create-table [keyvalue] + + ;; ;; This is most likely to work with any database system.. + ;; '( + ;; ([clctn_id] integer :not-null) + ;; ([key] text :not-null) + ;; ([value] text) + ;; ) + ;; :database con) ;; :constraints '("PRIMARY KEY (clctn_id key)" ;; "UNIQUE (clctn_id,key)") @@ -338,6 +398,7 @@ (recover-fatal nil) (thread t)) (declare (ignore recover recover-fatal thread)) + (insure-thread-table-lock) (the sql-store-controller (let* ((dbtype (car (second (controller-spec sc)))) (path (cadr (second (controller-spec sc)))) @@ -346,7 +407,8 @@ (con (clsql:connect (cdr (second (controller-spec sc))) :database-type dbtype :if-exists :old))) - (setf (slot-value sc 'db) con) + (setf (slot-value sc 'dbcons) (make-hash-table :test 'equal)) +;; (setf (slot-value sc 'db) con) ;; Now we should make sure that the KEYVALUE table exists, and, if ;; it does not, we need to create it.. (unless (keyvalue-table-exists con) @@ -365,19 +427,45 @@ ) ) +(defmethod connection-ok-p ((sc sql-store-controller)) + (connection-ok-p-con (controller-db sc))) + +(defun connection-ok-p-con (con) + (let ((str (format nil "~A" con))) + (search "OPEN" str) + )) + +(defmethod connection-really-ok-p ((sc sql-store-controller)) + ;; I don't really have a good way of doing this, but + ;; one thing that is sure is that the the print form should + ;; have OPEN and not CLOSED in it. + ) + +(defmethod controller-status ((sc sql-store-controller)) +;; This is a crummy way to deal with status; we really want +;; to return something we can compute against. + (clsql:status) + ) + + (defmethod reconnect-controller ((sc sql-store-controller)) - (setf (controller-db sc) - (clsql:reconnect :database (controller-db sc))) + (clsql:reconnect :database (controller-db sc) :force nil) +;; (setf (controller-db sc) +;; (clsql:reconnect :database (controller-db sc))) ) + (defmethod close-controller ((sc sql-store-controller)) - (when (slot-value sc 'db) - ;; close the connection - ;; (actually clsql has pooling and other complications, I am not sure - ;; that this is complete.) - (clsql:disconnect :database (controller-db sc)) - (setf (slot-value sc 'class-root) nil) + (maphash #'(lambda (k v) + (ignore-errors + (if (connection-ok-p-con v) + (clsql:disconnect :database v) + ) + ) + ) + (controller-db-table sc) + ) (setf (slot-value sc 'root) nil) - )) + ) ;; Because this is part of the public ;; interface that I'm tied to, it has to accept a store-controller... @@ -401,7 +489,6 @@ (defun sql-add-to-clcn (clcn key value sc &key (insert-only nil)) - (declare (ignore sc)) (assert (integerp clcn)) (let ((con (controller-db sc)) (vbs @@ -456,17 +543,17 @@ (let* ((con (controller-db sc)) (kbs (serialize-to-base64-string key sc)) - (offsetquery (format nil "select value from keyvalue where clctn_id = ~A and key = '~A' order by value offset ~A limit 1 " + (offsetquery (format nil "select value from keyvalue where clctn_id = ~A and key = '~A' order by pk offset ~A limit 1 " clcn kbs n)) (tuples -;; (clsql::query offsetquery :database con) - (clsql::select [value] - :from [keyvalue] - :where [and [= [clctn_id] clcn] [= [key] kbs]] - :database con - ) + (clsql::query offsetquery :database con) +;; (clsql::select [value] +;; :from [keyvalue] +;; :where [and [= [clctn_id] clcn] [= [key] kbs]] +;; :database con +;; ) ) ) ;; Get the lowest value by sorting and taking the first value; @@ -478,20 +565,21 @@ ;; that efficiently without changing the database structure; ;; but that's OK, I could add a column to support that ;; relatively easily later on. -;; (if (and (> (length tuples) 1)) -;; (format t "l = ~A~%" (length tuples)) -;; ) - (if (< n (length tuples)) -;; (values (deserialize-from-base64-string (car (nth n tuples)) sc) -;; t) - (values (nth n (sort - (mapcar - #'(lambda (x) - (deserialize-from-base64-string (car x) sc)) - tuples) - #'my-generic-less-than)) + (if tuples + (values (deserialize-from-base64-string (caar tuples) sc) t) - (values nil nil)))) + (values nil nil)) + +;; (if (< n (length tuples)) +;; (values (nth n (sort +;; (mapcar +;; #'(lambda (x) +;; (deserialize-from-base64-string (car x) sc)) +;; tuples) +;; #'my-generic-less-than)) +;; t) +;; (values nil nil)) +)) (defun sql-get-from-clcn-cnt (clcn key sc) (assert (integerp clcn)) @@ -509,7 +597,7 @@ (assert (integerp clcn)) (let* ((con (controller-db sc)) (tuples - (clsql::select [key] [value] + (clsql::select [pk] [key] [value] :from [keyvalue] :where [and [= [clctn_id] clcn]] :database con @@ -559,7 +647,6 @@ (defun sql-remove-from-clcn (clcn key sc) - (declare (ignore sc)) (assert (integerp clcn)) (let ((con (controller-db sc)) (kbs (serialize-to-base64-string key sc))

1 0

[elephant-cvs] CVS elephant
by rread 07 Feb '07

07 Feb '07

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv4302 Modified Files: INSTALL ele-clsql.asd Log Message: Commiting a thread-safe version of the SQL side (but SBCL-depdent.) --- /project/elephant/cvsroot/elephant/INSTALL 2007/02/05 19:33:10 1.21 +++ /project/elephant/cvsroot/elephant/INSTALL 2007/02/07 22:54:12 1.22 @@ -117,7 +117,7 @@ 4) Compile and load Elephant: The new backend load process should work automatically on Un*x -systems but if there are problems with loading foreign libraries, +systems but if there are probolems with loading foreign libraries, then you can test your C tools setup with 'make' in the elephant root directory. This will build the common memutils library in src/memutil/libmemutil.so/dylib that all backends require. @@ -168,7 +168,7 @@ (asdf:operate 'asdf:load-op :elephant-tests) (in-package :ele-tests) (setf *default-spec* <backend>) - where <backend> = { *testsqlite3-spec* | *testpg-spec* | *testbdb-spec* } + Where <backend> = { *testsqlite3-spec* | *testpg-spec* | *testbdb-spec* } (do-backend-tests) This will test the standalone API for your backend. Currently all tests are --- /project/elephant/cvsroot/elephant/ele-clsql.asd 2006/11/11 18:41:10 1.8 +++ /project/elephant/cvsroot/elephant/ele-clsql.asd 2007/02/07 22:54:12 1.9 @@ -57,7 +57,8 @@ (:file "sql-controller") (:file "sql-transaction") (:file "sql-collections")) - :serial t)))) + :serial t + )))) :depends-on (:elephant :clsql :cl-base64))

1 0

[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/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-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
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-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

← Newer
1
...
8
9
10
11
12
13
14
...
17
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 February 2007