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

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

01 Feb '07

Update of /project/elephant/cvsroot/elephant/src/memutil In directory clnet:/tmp/cvs-serv1882/src/memutil Modified Files: libmemutil.c memutil.lisp Log Message: Added 64-bit support, verified for 32-bit lisp via Allegro/Mac OS X. Thanks to Henrik Hjelte --- /project/elephant/cvsroot/elephant/src/memutil/libmemutil.c 2006/11/11 18:41:11 1.2 +++ /project/elephant/cvsroot/elephant/src/memutil/libmemutil.c 2007/02/01 04:03:27 1.3 @@ -57,48 +57,47 @@ #include <string.h> #include <wchar.h> +#include <stdint.h> /* Pointer arithmetic utility functions */ -/* should these be in network-byte order? probably not..... */ -int read_int(char *buf, int offset) { - int i; - memcpy(&i, buf+offset, sizeof(int)); - return i; -} - -unsigned int read_uint(char *buf, int offset) { - unsigned int ui; - memcpy(&ui, buf+offset, sizeof(unsigned int)); - return ui; -} -float read_float(char *buf, int offset) { - float f; - memcpy(&f, buf+offset, sizeof(float)); - return f; -} +/* NOTE: Byte order is on a per-machine basis, serialized streams using this + library will not be compatable between little-endian and big-endian platforms */ -double read_double(char *buf, int offset) { - double d; - memcpy(&d, buf+offset, sizeof(double)); - return d; -} +/*------------------------------------------------------------------------------ + reader_and_writer -void write_int(char *buf, int num, int offset) { - memcpy(buf+offset, &num, sizeof(int)); -} + Generates the following code: -void write_uint(char *buf, unsigned int num, int offset) { - memcpy(buf+offset, &num, sizeof(unsigned int)); -} - -void write_float(char *buf, float num, int offset) { - memcpy(buf+offset, &num, sizeof(float)); -} - -void write_double(char *buf, double num, int offset) { - memcpy(buf+offset, &num, sizeof(double)); -} + double read_double(char *buf, int offset) { + double d; + memcpy(&d, buf+offset, sizeof(double)); + return d; + } + void write_double(char *buf, double num, int offset) { + memcpy(buf+offset, &num, sizeof(double)); + } + When called like this: + reader_and_writer(double) +-------------------------------------------------------------------------------- +*/ + +#define reader_and_writer( DATATYPE ) \ +DATATYPE read_##DATATYPE (char *buf, int offset) { \ + DATATYPE i; \ + memcpy(&i, buf+offset, sizeof( DATATYPE )); \ + return i; \ +} \ +void write_##DATATYPE (char *buf, DATATYPE num, int offset) { \ + memcpy(buf+offset, &num, sizeof( DATATYPE )); \ +} + +reader_and_writer(int32_t) +reader_and_writer(uint32_t) +reader_and_writer(int64_t) +reader_and_writer(uint64_t) +reader_and_writer(float) +reader_and_writer(double) char *offset_charp(char *p, int offset) { return p + offset; --- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2007/01/31 20:05:38 1.15 +++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2007/02/01 04:03:28 1.16 @@ -40,11 +40,17 @@ #:resize-buffer-stream #:resize-buffer-stream-no-copy #:reset-buffer-stream #:buffer-stream-buffer #:buffer-stream-length #:buffer-stream-size - #: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 + + #:buffer-write-byte #:buffer-write-float + #:buffer-write-double #:buffer-write-string + #:buffer-write-int32 #:buffer-write-uint32 + #:buffer-write-int64 #:buffer-write-uint64 + + #:buffer-read-byte #:buffer-read-fixnum32 #:buffer-read-fixnum64 + #:buffer-read-int32 #:buffer-read-uint32 + #:buffer-read-int64 #:buffer-read-uint64 + #:buffer-read-float #:buffer-read-double + #:buffer-read-ucs1-string #+(or lispworks (and allegro ics)) #:buffer-read-ucs2-string #+(and sbcl sb-unicode) #:buffer-read-ucs4-string @@ -92,11 +98,12 @@ ;;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-byte buffer-write-int32 buffer-write-uint32 + buffer-write-int64 buffer-write-uint64 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 - buffer-read-ucs1-string + buffer-read-byte buffer-read-fixnum buffer-read-int32 + buffer-read-uint32 buffer-read-int64 buffer-read-uint64 + buffer-read-float buffer-read-double buffer-read-ucs1-string #+(or lispworks (and allegro ics)) buffer-read-ucs2-string #+(and sbcl sb-unicode) buffer-read-ucs4-string)) ) @@ -174,7 +181,7 @@ ;; TODO: #+openmcl versions which do macptr arith. #+(or cmu sbcl) -(defun read-int (buf offset) +(defun read-int32 (buf offset) "Read a 32-bit signed integer from a foreign char buffer." (declare (type (alien (* char)) buf) (type fixnum offset)) @@ -183,7 +190,16 @@ (* (signed 32)))))) #+(or cmu sbcl) -(defun read-uint (buf offset) +(defun read-int64 (buf offset) + "Read a 64-bit signed integer from a foreign char buffer." + (declare (type (alien (* char)) buf) + (type fixnum offset)) + (the (signed-byte 64) + (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (* (signed 64)))))) + +#+(or cmu sbcl) +(defun read-uint32 (buf offset) "Read a 32-bit unsigned integer from a foreign char buffer." (declare (type (alien (* char)) buf) (type fixnum offset)) @@ -191,6 +207,16 @@ (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) (* (unsigned 32)))))) + +#+(or cmu sbcl) +(defun read-uint64 (buf offset) + "Read a 64-bit unsigned integer from a foreign char buffer." + (declare (type (alien (* char)) buf) + (type fixnum offset)) + (the (signed-byte 64) + (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (* (signed 64)))))) + #+(or cmu sbcl) (defun read-float (buf offset) "Read a single-float from a foreign char buffer." @@ -210,7 +236,7 @@ (* double-float))))) #+(or cmu sbcl) -(defun write-int (buf num offset) +(defun write-int32 (buf num offset) "Write a 32-bit signed integer to a foreign char buffer." (declare (type (alien (* char)) buf) (type (signed-byte 32) num) @@ -219,7 +245,16 @@ (* (signed 32)))) num)) #+(or cmu sbcl) -(defun write-uint (buf num offset) +(defun write-int64 (buf num offset) + "Write a 64-bit signed integer to a foreign char buffer." + (declare (type (alien (* char)) buf) + (type (signed-byte 64) num) + (type fixnum offset)) + (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (* (signed 64)))) num)) + +#+(or cmu sbcl) +(defun write-uint32 (buf num offset) "Write a 32-bit unsigned integer to a foreign char buffer." (declare (type (alien (* char)) buf) (type (unsigned-byte 32) num) @@ -228,6 +263,14 @@ (* (unsigned 32)))) num)) #+(or cmu sbcl) +(defun write-uint64 (buf num offset) + "Write a 64-bit unsigned integer to a foreign char buffer." + (declare (type (alien (* char)) buf) + (type (unsigned-byte 64) num) + (type fixnum offset)) + (setf (deref (cast (sap-alien (sap+ (alien-sap buf) offset) (* char)) + (* (unsigned 64)))) num)) +#+(or cmu sbcl) (defun write-float (buf num offset) "Write a single-float to a foreign char buffer." (declare (type (alien (* char)) buf) @@ -253,18 +296,30 @@ (sap-alien (sap+ (alien-sap p) offset) (* char))) #-(or cmu sbcl) -(def-function ("read_int" read-int) +(def-function ("read_int32" read-int32) ((buf array-or-pointer-char) (offset :int)) :returning :int) #-(or cmu sbcl) -(def-function ("read_uint" read-uint) +(def-function ("read_uint32" read-uint32) ((buf array-or-pointer-char) (offset :int)) :returning :unsigned-int) #-(or cmu sbcl) +(def-function ("read_int64" read-int64) + ((buf array-or-pointer-char) + (offset :int)) + :returning :long) + +#-(or cmu sbcl) +(def-function ("read_uint64" read-uint64) + ((buf array-or-pointer-char) + (offset :int)) + :returning :unsigned-long) + +#-(or cmu sbcl) (def-function ("read_float" read-float) ((buf array-or-pointer-char) (offset :int)) @@ -277,20 +332,34 @@ :returning :double) #-(or cmu sbcl) -(def-function ("write_int" write-int) +(def-function ("write_int32" write-int32) ((buf array-or-pointer-char) (num :int) (offset :int)) :returning :void) #-(or cmu sbcl) -(def-function ("write_uint" write-uint) +(def-function ("write_uint32" write-uint32) ((buf array-or-pointer-char) (num :unsigned-int) (offset :int)) :returning :void) #-(or cmu sbcl) +(def-function ("write_int64" write-int64) + ((buf array-or-pointer-char) + (num :long) + (offset :int)) + :returning :void) + +#-(or cmu sbcl) +(def-function ("write_uint64" write-uint64) + ((buf array-or-pointer-char) + (num :unsigned-long) + (offset :int)) + :returning :void) + +#-(or cmu sbcl) (def-function ("write_float" write-float) ((buf array-or-pointer-char) (num :float) @@ -482,7 +551,7 @@ (setf (deref-array buf '(:array :char) size) b) (setf size needed)))) -(defun buffer-write-int (i bs) +(defun buffer-write-int32 (i bs) "Write a 32-bit signed integer." (declare (type buffer-stream bs) (type (signed-byte 32) i)) @@ -493,11 +562,11 @@ (let ((needed (+ size 4))) (when (> needed len) (resize-buffer-stream bs needed)) - (write-int buf i size) + (write-int32 buf i size) (setf size needed) nil))) -(defun buffer-write-uint (u bs) +(defun buffer-write-uint32 (u bs) "Write a 32-bit unsigned integer." (declare (type buffer-stream bs) (type (unsigned-byte 32) u)) @@ -508,7 +577,37 @@ (let ((needed (+ size 4))) (when (> needed len) (resize-buffer-stream bs needed)) - (write-uint buf u size) + (write-uint32 buf u size) + (setf size needed) + nil))) + +(defun buffer-write-int64 (i bs) + "Write a 64-bit signed integer." + (declare (type buffer-stream bs) + (type (signed-byte 64) i)) + (with-struct-slots ((buf buffer-stream-buffer) + (size buffer-stream-size) + (len buffer-stream-length)) + bs + (let ((needed (+ size 8))) + (when (> needed len) + (resize-buffer-stream bs needed)) + (write-int64 buf i size) + (setf size needed) + nil))) + +(defun buffer-write-uint64 (u bs) + "Write a 64-bit unsigned integer." + (declare (type buffer-stream bs) + (type (unsigned-byte 64) u)) + (with-struct-slots ((buf buffer-stream-buffer) + (size buffer-stream-size) + (len buffer-stream-length)) + bs + (let ((needed (+ size 8))) + (when (> needed len) + (resize-buffer-stream bs needed)) + (write-uint64 buf u size) (setf size needed) nil))) @@ -600,28 +699,73 @@ (writable (max vlen (- size position)))) (dotimes (i writable bs) (buffer-write-byte (aref bv i) bs)))) - + +(defun buffer-write-int (bs int) + ;; deprecated, better to use explicit int32 or int64 version + (buffer-write-int32 bs int)) + +(defun buffer-read-int (bs) + ;; deprecated, better to use explicit int32 or int64 version + (buffer-read-int32 bs)) (defun buffer-read-fixnum (bs) + ;; deprecated, better to use explicit int32 or int64 version + (the fixnum (buffer-read-fixnum32 bs))) + +(defun buffer-read-uint (bs) + ;; deprecated, better to use explicit int32 or int64 version + (buffer-read-uint32 bs)) + +(defun buffer-write-uint (bs int) + ;; deprecated, better to use explicit int32 or int64 version + (buffer-write-uint32 bs int)) + +(defconstant +2^32+ 4294967296) +(defconstant +2^64+ 18446744073709551616) + +(defun buffer-read-fixnum32 (bs) "Read a 32-bit signed integer, which is assumed to be a fixnum." (declare (type buffer-stream bs)) (let ((position (buffer-stream-position bs))) (setf (buffer-stream-position bs) (+ position 4)) (the fixnum (read-int (buffer-stream-buffer bs) position)))) -(defun buffer-read-int (bs) +(defun buffer-read-int32 (bs) "Read a 32-bit signed integer." (declare (type buffer-stream bs)) (let ((position (buffer-stream-position bs))) (setf (buffer-stream-position bs) (+ position 4)) - (the (signed-byte 32) (read-int (buffer-stream-buffer bs) position)))) + (the (signed-byte 32) (read-int32 (buffer-stream-buffer bs) position)))) -(defun buffer-read-uint (bs) +(defun buffer-read-uint32 (bs) "Read a 32-bit unsigned integer." (declare (type buffer-stream bs)) (let ((position (buffer-stream-position bs))) (setf (buffer-stream-position bs) (+ position 4)) - (the (unsigned-byte 32)(read-uint (buffer-stream-buffer bs) position)))) + (the (unsigned-byte 32)(read-uint32 (buffer-stream-buffer bs) position)))) + +(defun buffer-read-fixnum64 (bs) + (declare (type buffer-stream bs)) + (let ((position (buffer-stream-position bs))) + (setf (buffer-stream-position bs) (+ position 8)) + (if (< #.most-positive-fixnum +2^32+) + (+ (read-int32 (buffer-stream-buffer bs) position) + (* +2^32+ (read-int32 (buffer-stream-buffer bs) (+ position 4)))) + (the fixnum (read-int64 (buffer-stream-buffer bs) position))))) + +(defun buffer-read-int64 (bs) + "Read a 64-bit signed integer." + (declare (type buffer-stream bs)) + (let ((position (buffer-stream-position bs))) + (setf (buffer-stream-position bs) (+ position 8)) + (the (signed-byte 64) (read-int64 (buffer-stream-buffer bs) position)))) + +(defun buffer-read-uint64 (bs) + "Read a 64-bit unsigned integer." + (declare (type buffer-stream bs)) + (let ((position (buffer-stream-position bs))) + (setf (buffer-stream-position bs) (+ position 8)) + (the (unsigned-byte 64) (read-uint64 (buffer-stream-buffer bs) position)))) (defun buffer-read-float (bs) "Read a single-float."

1 0

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

01 Feb '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv1882/src/elephant Modified Files: serializer1.lisp serializer2.lisp Log Message: Added 64-bit support, verified for 32-bit lisp via Allegro/Mac OS X. Thanks to Henrik Hjelte --- /project/elephant/cvsroot/elephant/src/elephant/serializer1.lisp 2007/01/21 21:20:04 1.2 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer1.lisp 2007/02/01 04:03:27 1.3 @@ -93,7 +93,8 @@ (defun serialize (frob bs sc) "Serialize a lisp value into a buffer-stream." (declare #-elephant-without-optimize (optimize (speed 3) (safety 0)) - (type buffer-stream bs)) + (type buffer-stream bs) + (ignore sc)) (setq *lisp-obj-id* 0) (clear-circularity-hash) (labels --- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/01/31 20:05:38 1.7 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/01 04:03:27 1.8 @@ -144,6 +144,9 @@ ;; SERIALIZER ;; +(defconstant +2^32+ 4294967296) +(defconstant +2^64+ 18446744073709551616) + (defun serialize (frob bs sc) "Serialize a lisp value into a buffer-stream." (declare (type buffer-stream bs) @@ -155,9 +158,16 @@ (incf *lisp-obj-id*)) (%serialize (frob) (etypecase frob - ((integer #.most-negative-fixnum #.most-positive-fixnum) - (buffer-write-byte +fixnum32+ bs) - (buffer-write-int frob bs)) + (fixnum ;; (integer #.most-negative-fixnum #.most-positive-fixnum) + ;; Should be compiled away... + (if (< #.most-positive-fixnum +2^32+) + (progn + (buffer-write-byte +fixnum32+ bs) + (buffer-write-int32 frob bs)) + (progn + (assert (< #.most-positive-fixnum +2^64+)) + (buffer-write-byte +fixnum64+ bs) + (buffer-write-int64 frob bs)))) (null (buffer-write-byte +nil+ bs)) (symbol @@ -174,7 +184,7 @@ (serialize-string frob bs)) (persistent (buffer-write-byte +persistent+ bs) - (buffer-write-int (oid frob) bs) + (buffer-write-int32 (oid frob) bs) ;; This circumlocution is necessitated by ;; an apparent bug in SBCL 9.9 --- type-of sometimes ;; does NOT return the "proper name" of the class as the @@ -196,10 +206,10 @@ (standard-object (buffer-write-byte +object+ bs) (let ((idp (gethash frob *circularity-hash*))) - (if idp (buffer-write-int idp bs) + (if idp (buffer-write-int32 idp bs) (progn (let ((id (%next-object-id))) - (buffer-write-int id bs) + (buffer-write-int32 id bs) (setf (gethash frob *circularity-hash*) id)) (%serialize (type-of frob)) (let ((svs (slots-and-values frob))) @@ -220,10 +230,10 @@ (cons (buffer-write-byte +cons+ bs) (let ((idp (gethash frob *circularity-hash*))) - (if idp (buffer-write-int idp bs) + (if idp (buffer-write-int32 idp bs) (progn (let ((id (%next-object-id))) - (buffer-write-int id bs) + (buffer-write-int32 id bs) (setf (gethash frob *circularity-hash*) id)) (%serialize (car frob)) (%serialize (cdr frob)))))) @@ -234,10 +244,10 @@ (hash-table (buffer-write-byte +hash-table+ bs) (let ((idp (gethash frob *circularity-hash*))) - (if idp (buffer-write-int idp bs) + (if idp (buffer-write-int32 idp bs) (progn (let ((id (%next-object-id))) - (buffer-write-int id bs) + (buffer-write-int32 id bs) (setf (gethash frob *circularity-hash*) id)) (%serialize (hash-table-test frob)) (%serialize (hash-table-rehash-size frob)) @@ -251,9 +261,9 @@ ;; (structure-object ;; (buffer-write-byte +struct+ bs) ;; (let ((idp (gethash frob *circularity-hash*))) - ;; (if idp (buffer-write-int idp bs) + ;; (if idp (buffer-write-int32 idp bs) ;; (progn - ;; (buffer-write-int (incf *lisp-obj-id*) bs) + ;; (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))) @@ -264,10 +274,10 @@ (array (buffer-write-byte +array+ bs) (let ((idp (gethash frob *circularity-hash*))) - (if idp (buffer-write-int idp bs) + (if idp (buffer-write-int32 idp bs) (progn (let ((id (%next-object-id))) - (buffer-write-int id bs) + (buffer-write-int32 id bs) (setf (gethash frob *circularity-hash*) id)) (buffer-write-byte (logior (byte-from-array-type (array-element-type frob)) @@ -277,12 +287,11 @@ +adjustable-p+ 0)) bs) (let ((rank (array-rank frob))) - (buffer-write-int rank bs) + (buffer-write-int32 rank bs) (loop for i fixnum from 0 below rank - do (buffer-write-int (array-dimension frob i) - bs))) + do (%serialize (array-dimension frob i)))) (when (array-has-fill-pointer-p frob) - (buffer-write-int (fill-pointer frob) bs)) + (%serialize (fill-pointer frob))) (loop for i fixnum from 0 below (array-total-size frob) do (%serialize (row-major-aref frob i))))))) @@ -334,8 +343,10 @@ (declare (type foreign-char tag) (dynamic-extent tag)) (cond - ((= tag +fixnum32+) - (buffer-read-fixnum bs)) + ((= tag +fixnum32+) + (buffer-read-fixnum32 bs)) + ((= tag +fixnum64+) + (buffer-read-fixnum64 bs)) ((= tag +nil+) nil) ((= tag +utf8-string+) (deserialize-string :utf8 bs)) @@ -352,7 +363,7 @@ (make-symbol name)))) ((= tag +persistent+) (get-cached-instance sc - (buffer-read-fixnum bs) + (buffer-read-fixnum32 bs) (%deserialize bs))) ((= tag +single-float+) (buffer-read-float bs)) @@ -428,14 +439,14 @@ (%deserialize bs))) o))))))) ((= tag +array+) - (let* ((id (buffer-read-fixnum bs)) + (let* ((id (buffer-read-fixnum32 bs)) (maybe-array (lookup-id id))) (if maybe-array maybe-array (let* ((flags (buffer-read-byte bs)) (a (make-array (loop for i fixnum from 0 below - (buffer-read-int bs) - collect (buffer-read-int bs)) + (buffer-read-int32 bs) + collect (%deserialize bs)) :element-type (array-type-from-byte (logand #x3f flags)) :fill-pointer (/= 0 (logand +fill-pointer-p+ @@ -443,7 +454,7 @@ :adjustable (/= 0 (logand +adjustable-p+ flags))))) (when (array-has-fill-pointer-p a) - (setf (fill-pointer a) (buffer-read-int bs))) + (setf (fill-pointer a) (%deserialize bs))) (add-object a) (loop for i fixnum from 0 below (array-total-size a) do

1 0

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

01 Feb '07

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv1882 Modified Files: TODO Log Message: Added 64-bit support, verified for 32-bit lisp via Allegro/Mac OS X. Thanks to Henrik Hjelte --- /project/elephant/cvsroot/elephant/TODO 2007/01/31 20:05:37 1.38 +++ /project/elephant/cvsroot/elephant/TODO 2007/02/01 04:03:26 1.39 @@ -6,6 +6,11 @@ 0.6.1 - performance, safety and portability -------------------------------------------- +Lisp support: +- OpenMCL 1.1 on Mac OS X +- Win32 builds +- Lispworks? + Active tasks: - Full 64-bit support (arrays, native 64-bit fixnums, etc) - Set parameter at startup based on *features*

1 0

[elephant-cvs] CVS elephant/src/db-bdb
by ieslick 01 Feb '07

01 Feb '07

Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv1882/src/db-bdb Modified Files: bdb-controller.lisp Log Message: Added 64-bit support, verified for 32-bit lisp via Allegro/Mac OS X. Thanks to Henrik Hjelte --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/01/31 22:24:16 1.18 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/02/01 04:03:26 1.19 @@ -27,8 +27,6 @@ :accessor controller-environment) (oid-db :type (or null pointer-void) :accessor controller-oid-db) (oid-seq :type (or null pointer-void) :accessor controller-oid-seq) - (symid-db :type (or null pointer-void) :accessor controller-symid-db) - (symid-seq :type (or null pointer-void) :accessor controller-symid-seq) (btrees :type (or null pointer-void) :accessor controller-btrees) (indices :type (or null pointer-void) :accessor controller-indices) (indices-assoc :type (or null pointer-void) @@ -117,19 +115,6 @@ :auto-commit t :create t :thread t) (setf (controller-oid-seq sc) oid-seq))) - (let ((db (db-create env))) - (setf (controller-symid-db sc) db) - (db-open db :file "%ELEPHANTSYMID" :database "%ELEPHANTSYMID" - :auto-commit t :type DB-BTREE :create t :thread thread) - (let ((symid-seq (db-sequence-create db))) - (db-sequence-set-cachesize symid-seq *cachesize*) - (db-sequence-set-flags symid-seq :seq-inc t :seq-wrap t) - (db-sequence-set-range symid-seq 0 most-positive-fixnum) - (db-sequence-initial-value symid-seq 0) - (db-sequence-open symid-seq "%ELEPHANTSYMID" - :auto-commit t :create t :thread t) - (setf (controller-symid-seq sc) symid-seq))) - (setf (slot-value sc 'root) (make-instance 'bdb-btree :from-oid -1 :sc sc)) @@ -153,10 +138,6 @@ ;; clean instance cache (flush-instance-cache sc) ;; close handles / environment - (db-sequence-close (controller-symid-seq sc)) - (setf (controller-symid-seq sc) nil) - (db-close (controller-symid-db sc)) - (setf (controller-symid-db sc) nil) (db-sequence-close (controller-oid-seq sc)) (setf (controller-oid-seq sc) nil) (db-close (controller-oid-db sc)) @@ -179,13 +160,6 @@ (db-sequence-get-fixnum (controller-oid-seq sc) 1 :transaction +NULL-VOID+ :auto-commit t :txn-nosync t)) -(defmethod next-symid ((sc bdb-store-controller)) - (declare (type bdb-store-controller sc)) - (db-sequence-get-fixnum (controller-symid-seq sc) 1 :transaction +NULL-VOID+ - :auto-commit t :txn-nosync t)) - - - ;; ;; Automated Deadlock Support ;;

1 0

[elephant-cvs] CVS elephant/src/db-bdb
by ieslick 31 Jan '07

31 Jan '07

Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv9434/src/db-bdb Modified Files: bdb-controller.lisp berkeley-db.lisp Log Message: Unsure why this doesn't compile, probably due to strings, but I'll comment it out for now --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/01/31 20:05:37 1.17 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/01/31 22:24:16 1.18 @@ -136,8 +136,8 @@ (setf (slot-value sc 'class-root) (make-instance 'bdb-btree :from-oid -2 :sc sc)) - (when errfile - (db-set-error-file (controller-db sc) errfile)) +;; (when errfile +;; (db-set-error-file (controller-db sc) errfile)) (when deadlock-detect (start-deadlock-detector sc)) --- /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/01/31 20:05:37 1.5 +++ /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/01/31 22:24:16 1.6 @@ -485,13 +485,13 @@ :flags (force) :documentation "Make a checkpoint.") -(def-function ("db_set_error_file" %db-set-error-file) - ((db :pointer-void) - (file :cstring))) - -(defun db-set-error-file (db filename) - (with-cstrings ((fname filename)) - (%db-set-error-file db fname))) +;;(def-function ("db_set_error_file" %db-set-error-file) +;; ((db :pointer-void) +;; (file :cstring))) + +;;(defun db-set-error-file (db filename) +;; (with-cstrings ((fname filename)) +;; (%db-set-error-file db fname))) ;; Database

1 0

[elephant-cvs] CVS elephant/src/db-bdb
by ieslick 31 Jan '07

31 Jan '07

Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv24260/src/db-bdb Modified Files: bdb-collections.lisp bdb-controller.lisp berkeley-db.lisp libberkeley-db.c Removed Files: bdb-symbol-tables.lisp Log Message: Upgrade to BDB 4.5; green on Allegro 8.0/Mac OS X --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2006/12/16 19:35:10 1.11 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-collections.lisp 2007/01/31 20:05:37 1.12 @@ -19,6 +19,8 @@ (in-package :db-bdb) +(declaim #-elephant-without-optimize (optimize (speed 3) (safety 1) (space 0) (debug 0))) + (defclass bdb-btree (btree) () (:documentation "A BerkleyDB implementation of a BTree")) @@ -32,7 +34,6 @@ (make-instance 'bdb-btree :sc sc)) (defmethod get-value (key (bt bdb-btree)) - (declare (optimize (speed 3) (space 0) (safety 0))) (let ((sc (get-con bt))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (oid bt) key-buf) @@ -43,7 +44,6 @@ (values nil nil)))))) (defmethod existsp (key (bt bdb-btree)) - (declare (optimize (speed 3) (safety 0) (space 0))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (oid bt) key-buf) (serialize key key-buf (get-con bt)) @@ -55,8 +55,6 @@ (defmethod (setf get-value) (value key (bt bdb-btree)) - (declare (optimize (speed 3) (safety 0) (space 0))) - (assert (or *auto-commit* (not (eq *current-transaction* 0)))) ;; (with-transaction () (let ((sc (get-con bt))) (with-buffer-streams (key-buf value-buf) @@ -64,8 +62,7 @@ (serialize key key-buf sc) (serialize value value-buf sc) (db-put-buffered (controller-btrees sc) - key-buf value-buf - :auto-commit *auto-commit*))) + key-buf value-buf))) ;; ) value) @@ -85,15 +82,13 @@ ;; (write-value)))) (defmethod remove-kv (key (bt bdb-btree)) - (declare (optimize (speed 3) (space 0) (safety 0))) - (assert (or *auto-commit* (not (eq *current-transaction* 0)))) ;; (with-transaction (:store-controller (get-con bt)) (let ((sc (get-con bt)) ) (with-buffer-streams (key-buf) (buffer-write-int (oid bt) key-buf) (serialize key key-buf sc) (db-delete-buffered (controller-btrees sc) - key-buf :auto-commit *auto-commit*)))) + key-buf)))) ;; Secondary indices @@ -216,7 +211,6 @@ (defmethod remove-kv (key (bt bdb-indexed-btree)) "Remove a key / value pair, and update secondary indices." - (declare (optimize (speed 3))) (let ((sc (get-con bt))) (with-buffer-streams (key-buf secondary-buf) (buffer-write-int (oid bt) key-buf) @@ -252,7 +246,6 @@ (defmethod get-value (key (bt bdb-btree-index)) "Get the value in the primary DB from a secondary key." - (declare (optimize (speed 3))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (oid bt) key-buf) (serialize key key-buf (get-con bt)) @@ -263,7 +256,6 @@ (values nil nil))))) (defmethod get-primary-key (key (bt btree-index)) - (declare (optimize (speed 3))) (let ((sc (get-con bt))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (oid bt) key-buf) @@ -282,19 +274,16 @@ (defmethod make-cursor ((bt bdb-btree)) "Make a cursor from a btree." - (declare (optimize (speed 3))) (make-instance 'bdb-cursor :btree bt :handle (db-cursor (controller-btrees (get-con bt))) :oid (oid bt))) (defmethod cursor-close ((cursor bdb-cursor)) - (declare (optimize (speed 3))) (db-cursor-close (cursor-handle cursor)) (setf (cursor-initialized-p cursor) nil)) (defmethod cursor-duplicate ((cursor bdb-cursor)) - (declare (optimize (speed 3))) (make-instance (type-of cursor) :initialized-p (cursor-initialized-p cursor) :oid (cursor-oid cursor) @@ -303,7 +292,6 @@ :position (cursor-initialized-p cursor)))) (defmethod cursor-current ((cursor bdb-cursor)) - (declare (optimize (speed 3))) (when (cursor-initialized-p cursor) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) @@ -317,7 +305,6 @@ (setf (cursor-initialized-p cursor) nil))))))) (defmethod cursor-first ((cursor bdb-cursor)) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (cursor-oid cursor) key-buf) @@ -333,7 +320,6 @@ ;;A bit of a hack..... (defmethod cursor-last ((cursor bdb-cursor)) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (+ (cursor-oid cursor) 1) key-buf) @@ -361,7 +347,6 @@ (setf (cursor-initialized-p cursor) nil))))))) (defmethod cursor-next ((cursor bdb-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) @@ -375,7 +360,6 @@ (cursor-first cursor))) (defmethod cursor-prev ((cursor bdb-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) @@ -389,7 +373,6 @@ (cursor-last cursor)))) (defmethod cursor-set ((cursor bdb-cursor) key) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (cursor-oid cursor) key-buf) @@ -404,7 +387,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-set-range ((cursor bdb-cursor) key) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (cursor-oid cursor) key-buf) @@ -419,7 +401,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-get-both ((cursor bdb-cursor) key value) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (cursor-oid cursor) key-buf) @@ -435,7 +416,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-get-both-range ((cursor bdb-cursor) key value) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf value-buf) (buffer-write-int (cursor-oid cursor) key-buf) @@ -450,7 +430,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-delete ((cursor bdb-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (with-buffer-streams (key-buf value-buf) (multiple-value-bind (key val) @@ -469,7 +448,6 @@ "Put by cursor. Not particularly useful since primaries don't support duplicates. Currently doesn't properly move the cursor." - (declare (optimize (speed 3))) (if key-specified-p (setf (get-value key (cursor-btree cursor)) value) (if (cursor-initialized-p cursor) @@ -493,7 +471,6 @@ (defmethod make-cursor ((bt bdb-btree-index)) "Make a secondary-cursor from a secondary index." - (declare (optimize (speed 3))) (make-instance 'bdb-secondary-cursor :btree bt :handle (db-cursor @@ -502,7 +479,6 @@ (defmethod cursor-pcurrent ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (when (cursor-initialized-p cursor) (with-buffer-streams (key-buf pkey-buf value-buf) (multiple-value-bind (key pkey val) @@ -519,7 +495,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-pfirst ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (with-buffer-streams (key-buf pkey-buf value-buf) (buffer-write-int (cursor-oid cursor) key-buf) (multiple-value-bind (key pkey val) @@ -536,7 +511,6 @@ ;;A bit of a hack..... (defmethod cursor-plast ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf pkey-buf value-buf) (buffer-write-int (+ (cursor-oid cursor) 1) key-buf) @@ -568,7 +542,6 @@ (setf (cursor-initialized-p cursor) nil))))))) (defmethod cursor-pnext ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (with-buffer-streams (key-buf pkey-buf value-buf) (multiple-value-bind (key pkey val) @@ -583,7 +556,6 @@ (cursor-pfirst cursor))) (defmethod cursor-pprev ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (with-buffer-streams (key-buf pkey-buf value-buf) (multiple-value-bind (key pkey val) @@ -598,7 +570,6 @@ (cursor-plast cursor))) (defmethod cursor-pset ((cursor bdb-secondary-cursor) key) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf pkey-buf value-buf) (buffer-write-int (cursor-oid cursor) key-buf) @@ -615,7 +586,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-pset-range ((cursor bdb-secondary-cursor) key) - (declare (optimize (speed 3))) (let ((sc (get-con (cursor-btree cursor)))) (with-buffer-streams (key-buf pkey-buf value-buf) (buffer-write-int (cursor-oid cursor) key-buf) @@ -631,7 +601,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-pget-both ((cursor bdb-secondary-cursor) key pkey) - (declare (optimize (speed 3))) (with-buffer-streams (key-buf pkey-buf value-buf) (let ((primary-oid (oid (primary (cursor-btree cursor)))) (sc (get-con (cursor-btree cursor)))) @@ -649,7 +618,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-pget-both-range ((cursor bdb-secondary-cursor) key pkey) - (declare (optimize (speed 3))) (with-buffer-streams (key-buf pkey-buf value-buf) (let ((primary-oid (oid (primary (cursor-btree cursor)))) (sc (get-con (cursor-btree cursor)))) @@ -668,7 +636,6 @@ (defmethod cursor-delete ((cursor bdb-secondary-cursor)) "Delete by cursor: deletes ALL secondary indices." - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (with-buffer-streams (key-buf pkey-buf value-buf) (multiple-value-bind (key pkey val) @@ -706,7 +673,6 @@ (error "Puts are forbidden on secondary indices. Try adding to the primary.")) (defmethod cursor-next-dup ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (when (cursor-initialized-p cursor) (with-buffer-streams (key-buf value-buf) (multiple-value-bind (key val) @@ -718,7 +684,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-next-nodup ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (with-buffer-streams (key-buf value-buf) (multiple-value-bind (key val) @@ -731,7 +696,6 @@ (cursor-first cursor))) (defmethod cursor-prev-nodup ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (with-buffer-streams (key-buf value-buf) (multiple-value-bind (key val) @@ -744,7 +708,6 @@ (cursor-last cursor))) (defmethod cursor-pnext-dup ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (when (cursor-initialized-p cursor) (with-buffer-streams (key-buf pkey-buf value-buf) (multiple-value-bind (key pkey val) @@ -757,7 +720,6 @@ (setf (cursor-initialized-p cursor) nil)))))) (defmethod cursor-pnext-nodup ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (with-buffer-streams (key-buf pkey-buf value-buf) (multiple-value-bind (key pkey val) @@ -771,16 +733,15 @@ (cursor-pfirst cursor))) (defmethod cursor-pprev-nodup ((cursor bdb-secondary-cursor)) - (declare (optimize (speed 3))) (if (cursor-initialized-p cursor) (with-buffer-streams (key-buf pkey-buf value-buf) (multiple-value-bind (key pkey val) (db-cursor-pmove-buffered (cursor-handle cursor) key-buf pkey-buf value-buf :prev-nodup t) (if (and key (= (buffer-read-int key) (cursor-oid cursor))) - (values t (deserialize key (get-con (cursor-btree cursor))) + (values t (deserialize key (get-con (cursor-btree cursor))) (deserialize val (get-con (cursor-btree cursor))) - (progn (buffer-read-int pkey) + (progn (buffer-read-int pkey) (deserialize pkey (get-con (cursor-btree cursor))))) (setf (cursor-initialized-p cursor) nil)))) (cursor-plast cursor))) --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/01/26 14:41:08 1.16 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/01/31 20:05:37 1.17 @@ -19,6 +19,8 @@ (in-package :db-bdb) +(declaim #-elephant-without-optimize (optimize (speed 3) (safety 1) (space 0) (debug 0))) + (defclass bdb-store-controller (store-controller) ((db :type (or null pointer-void) :accessor controller-db :initform '()) (environment :type (or null pointer-void) @@ -61,15 +63,15 @@ ;; Open/close ;; -(defmethod open-controller ((sc bdb-store-controller) &key (recover t) - (recover-fatal nil) (thread t) +(defmethod open-controller ((sc bdb-store-controller) &key (recover nil) + (recover-fatal nil) (thread t) (errfile nil) (deadlock-detect nil)) (let ((env (db-env-create))) - ;; thread stuff? (setf (controller-environment sc) env) + (db-env-set-flags env 0 :auto-commit t) (db-env-open env (namestring (second (controller-spec sc))) - :create t :init-txn t :init-lock t - :init-mpool t :init-log t :thread thread + :create t :init-rep nil :init-mpool t :thread thread + :init-lock t :init-log t :init-txn t :recover recover :recover-fatal recover-fatal ) (db-env-set-timeout env 100000 :set-transaction-timeout t) @@ -99,7 +101,7 @@ (db-bdb::db-set-lisp-dup-compare indices-assoc (controller-serializer-version sc)) (db-set-flags indices-assoc :dup-sort t) (db-open indices-assoc :file "%ELEPHANT" :database "%ELEPHANTINDICES" - :auto-commit t :type DB-UNKNOWN :thread thread :rdonly t) + :auto-commit t :type DB-UNKNOWN :thread thread) ;; :rdonly t) (db-bdb::db-fake-associate btrees indices-assoc :auto-commit t) (let ((db (db-create env))) @@ -134,18 +136,14 @@ (setf (slot-value sc 'class-root) (make-instance 'bdb-btree :from-oid -2 :sc sc)) + (when errfile + (db-set-error-file (controller-db sc) errfile)) + (when deadlock-detect (start-deadlock-detector sc)) sc))) -;; NOTE: This was the easist way to do this. A BDB hash table would be better -;; and perhaps generally a better thing to export; however I don't want to -;; go through the effort at this time. - -(defparameter *symbol-to-id-table-oid* -3) -(defparameter *id-to-symbol-table-oid* -4) - (defmethod close-controller ((sc bdb-store-controller)) (when (slot-value sc 'root) (stop-deadlock-detector sc) --- /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/01/22 22:22:35 1.4 +++ /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/01/31 20:05:37 1.5 @@ -77,80 +77,85 @@ ;; eventually write a macro which generates a custom flag function. ;; -;I don't like the UFFI syntax for enumerations +;; Current header file version required: Berkeley DB 4.5 + +;; I don't like the UFFI syntax for enumerations (defconstant DB-BTREE 1) (defconstant DB-HASH 2) (defconstant DB-RECNO 3) (defconstant DB-QUEUE 4) (defconstant DB-UNKNOWN 5) -(defconstant DB_CREATE #x00000001) (defconstant DB_LOCK_NOWAIT #x00000002) + +(defconstant DB_CREATE #x00000001) (defconstant DB_FORCE #x00000004) -(defconstant DB_NOMMAP #x00000008) -(defconstant DB_RDONLY #x00000010) -(defconstant DB_RECOVER #x00000020) -(defconstant DB_THREAD #x00000040) -(defconstant DB_TRUNCATE #x00000080) -(defconstant DB_TXN_NOSYNC #x00000100) -(defconstant DB_EXCL #x00002000) +(defconstant DB_MULTIVERSION #x00000008) +(defconstant DB_NOMMAP #x00000010) +(defconstant DB_RDONLY #x00000020) +(defconstant DB_RECOVER #x00000040) +(defconstant DB_THREAD #x00000080) +(defconstant DB_TRUNCATE #x00000100) +(defconstant DB_TXN_NOSYNC #x00000200) +(defconstant DB_TXN_NOT_DURABLE #x00000400) +(defconstant DB_TXN_WRITE_NOSYNC #x00000800) + +(defconstant DB_EXCL #x00004000) -(defconstant DB_TXN_NOWAIT #x00002000) -(defconstant DB_TXN_SYNC #x00004000) +(defconstant DB_TXN_NOWAIT #x00004000) +(defconstant DB_TXN_SYNC #x00008000) -(defconstant DB_DUP #x00004000) -(defconstant DB_DUPSORT #x00008000) +(defconstant DB_DUP #x00008000) +(defconstant DB_DUPSORT #x00010000) (defconstant DB_JOINENV #x00000000) -(defconstant DB_INIT_CDB #x00002000) -(defconstant DB_INIT_LOCK #x00004000) -(defconstant DB_INIT_LOG #x00008000) -(defconstant DB_INIT_MPOOL #x00010000) -(defconstant DB_INIT_REP #x00020000) -(defconstant DB_INIT_TXN #x00040000) -(defconstant DB_LOCKDOWN #x00080000) -(defconstant DB_PRIVATE #x00100000) -(defconstant DB_RECOVER_FATAL #x00200000) -(defconstant DB_SYSTEM_MEM #x00800000) -(defconstant DB_AUTO_COMMIT #x01000000) -(defconstant DB_READ_COMMITTED #x02000000) -(defconstant DB_DEGREE_2 #x02000000) ;; DEPRECATED, now called DB_READ_COMMITTED -(defconstant DB_READ_UNCOMMITTED #x04000000) -(defconstant DB_DIRTY_READ #x04000000) ;; DEPRECATED, now called DB_READ_UNCOMMITTED - -(defconstant DB_CURRENT 7) -(defconstant DB_FIRST 9) -(defconstant DB_GET_BOTH 10) -(defconstant DB_GET_BOTH_RANGE 12) -(defconstant DB_LAST 17) -(defconstant DB_NEXT 18) -(defconstant DB_NEXT_DUP 19) -(defconstant DB_NEXT_NODUP 20) -(defconstant DB_PREV 25) -(defconstant DB_PREV_NODUP 26) -(defconstant DB_SET 28) -(defconstant DB_SET_RANGE 30) +(defconstant DB_INIT_CDB #x00004000) +(defconstant DB_INIT_LOCK #x00008000) +(defconstant DB_INIT_LOG #x00010000) +(defconstant DB_INIT_MPOOL #x00020000) +(defconstant DB_INIT_REP #x00040000) +(defconstant DB_INIT_TXN #x00080000) +(defconstant DB_LOCKDOWN #x00100000) +(defconstant DB_PRIVATE #x00200000) +(defconstant DB_RECOVER_FATAL #x00400000) +(defconstant DB_REGISTER #x00800000) +(defconstant DB_SYSTEM_MEM #x01000000) +(defconstant DB_AUTO_COMMIT #x02000000) +(defconstant DB_READ_COMMITTED #x04000000) +(defconstant DB_DEGREE_2 #x04000000) ;; DEPRECATED, now called DB_READ_COMMITTED +(defconstant DB_READ_UNCOMMITTED #x08000000) +(defconstant DB_DIRTY_READ #x08000000) ;; DEPRECATED, now called DB_READ_UNCOMMITTED (defconstant DB_AFTER 1) (defconstant DB_BEFORE 3) -(defconstant DB_KEYFIRST 15) -(defconstant DB_KEYLAST 16) +(defconstant DB_CURRENT 6) +(defconstant DB_FIRST 7) +(defconstant DB_GET_BOTH 8) +(defconstant DB_GET_BOTH_RANGE 10) +(defconstant DB_LAST 15) +(defconstant DB_NEXT 16) +(defconstant DB_NEXT_DUP 17) +(defconstant DB_NEXT_NODUP 18) +(defconstant DB_PREV 23) +(defconstant DB_PREV_NODUP 24) +(defconstant DB_SET 25) +(defconstant DB_SET_RANGE 27) + +(defconstant DB_NODUPDATA 19) +(defconstant DB_NOOVERWRITE 20) +(defconstant DB_NOSYNC 21) -(defconstant DB_NODUPDATA 21) -(defconstant DB_NOOVERWRITE 22) -(defconstant DB_NOSYNC 23) - -(defconstant DB_POSITION 24) +(defconstant DB_POSITION 22) (defconstant DB_SEQ_DEC #x00000001) (defconstant DB_SEQ_INC #x00000002) (defconstant DB_SEQ_WRAP #x00000008) -(defconstant DB_SET_LOCK_TIMEOUT 29) -(defconstant DB_SET_TXN_TIMEOUT 33) +(defconstant DB_SET_LOCK_TIMEOUT 26) +(defconstant DB_SET_TXN_TIMEOUT 30) -(defconstant DB_FREELIST_ONLY #x00002000) -(defconstant DB_FREE_SPACE #x00004000) +(defconstant DB_FREELIST_ONLY #x00004000) +(defconstant DB_FREE_SPACE #x00008000) (defconstant DB_KEYEMPTY -30997) (defconstant DB_KEYEXIST -30996) @@ -256,7 +261,7 @@ (documentation nil) (transaction nil)) (let ((wname (if (listp names) (first names) names)) - (fname (if (listp names) (second names) + (fname (if (listp names) (second names) (intern (concatenate 'string "%" (symbol-name names))))) (wrapper-args (make-wrapper-args args flags keys)) (fun-args (make-fun-args args flags)) @@ -480,6 +485,14 @@ :flags (force) :documentation "Make a checkpoint.") +(def-function ("db_set_error_file" %db-set-error-file) + ((db :pointer-void) + (file :cstring))) + +(defun db-set-error-file (db filename) + (with-cstrings ((fname filename)) + (%db-set-error-file db fname))) + ;; Database (eval-when (:compile-toplevel :load-toplevel) @@ -1882,8 +1895,7 @@ :returning :int) (defun next-counter (env db parent key key-size lockid lockid-size) - "Get the next element in the counter. To be deprecated -when 4.3 is released." + "Get the next element in the counter. To be deprecated when 4.3 is released." (let ((ret (%next-counter env db parent key key-size lockid lockid-size))) (if (< ret 0) (error 'db-error :errno ret) --- /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c 2007/01/22 16:17:43 1.6 +++ /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c 2007/01/31 20:05:37 1.7 @@ -56,6 +56,7 @@ */ #include <stdint.h> +#include <stdio.h> #include <string.h> #include <wchar.h> @@ -173,7 +174,7 @@ DB_ENV *db_env_cr(u_int32_t flags, int *errno) { DB_ENV *envp; *errno = db_env_create(&envp, flags); - return envp; + return envp; } char * db_strerr(int error) { @@ -215,6 +216,7 @@ return dbenv->txn_checkpoint(dbenv, kbyte, min, flags); } + /* Database */ DB *db_cr(DB_ENV *dbenv, u_int32_t flags, int *errno) { @@ -265,6 +267,10 @@ return db->get_pagesize(db, pagesizep); } +void db_set_error_file(DB *db, char *filename) { + return db->set_errfile(db, fopen(filename, "w+")); +} + /* Accessors */ /* We manage our own buffers (DB_DBT_USERMEM). */

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 31 Jan '07

31 Jan '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv24260/src/elephant Modified Files: collections.lisp controller.lisp serializer2.lisp Log Message: Upgrade to BDB 4.5; green on Allegro 8.0/Mac OS X --- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2006/06/19 01:03:30 1.5 +++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/01/31 20:05:38 1.6 @@ -135,7 +135,6 @@ (defmethod remove-kv (key (bt btree-index)) "Remove a key / value from the PRIMARY by a secondary lookup, updating ALL other secondary indices." - (declare (optimize (speed 3))) (remove-kv (get-primary-key key bt) (primary bt))) --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/01/26 14:41:13 1.25 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/01/31 20:05:38 1.26 @@ -139,7 +139,7 @@ ;; (defclass store-controller () - ((spec :type (or pathname string (simple-array character)) + ((spec :type list :accessor controller-spec :initarg :spec :documentation "Backend create functions should pass in :spec during make-instance") --- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/01/25 18:18:00 1.6 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/01/31 20:05:38 1.7 @@ -20,7 +20,7 @@ (:use :cl :elephant :elephant-memutil) (:import-from :elephant *circularity-initial-hash-size* - *resourced-byte-spec* + #+(or cmu sbcl allegro) get-cached-instance controller-symbol-cache controller-symbol-id-cache

1 0

[elephant-cvs] CVS elephant/src/memutil
by ieslick 31 Jan '07

31 Jan '07

Update of /project/elephant/cvsroot/elephant/src/memutil In directory clnet:/tmp/cvs-serv24260/src/memutil Modified Files: memutil.lisp Log Message: Upgrade to BDB 4.5; green on Allegro 8.0/Mac OS X --- /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2007/01/20 22:12:18 1.14 +++ /project/elephant/cvsroot/elephant/src/memutil/memutil.lisp 2007/01/31 20:05:38 1.15 @@ -82,7 +82,7 @@ (length :int)) :returning :void)) -(eval-when (compile) +(eval-when (:compile-toplevel) (declaim #-elephant-without-optimize (optimize (speed 3) (safety 1) (space 0) (debug 0)) (inline read-int read-uint read-float read-double

1 0

[elephant-cvs] CVS elephant
by ieslick 31 Jan '07

31 Jan '07

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv24260 Modified Files: TODO ele-bdb.asd Log Message: Upgrade to BDB 4.5; green on Allegro 8.0/Mac OS X --- /project/elephant/cvsroot/elephant/TODO 2007/01/25 18:17:59 1.37 +++ /project/elephant/cvsroot/elephant/TODO 2007/01/31 20:05:37 1.38 @@ -7,14 +7,13 @@ -------------------------------------------- Active tasks: -- Speed up symbol storage and reference using symbol id's - - Fast symbols are property tag in DB (so code doesn't corrupt DB) - Full 64-bit support (arrays, native 64-bit fixnums, etc) - Set parameter at startup based on *features* - Mark fixnums appropriately: 32-bit lisps can decode 64-bit fixnums as bignums (two 32-bit entities) - propogate assumptions to bignum byte specs - are there other fixed assumptions? - char vs. uint8 in buffer-stream to read-out (See Marco e-mail) + - Ensure serialization is thread-safe and reasonably efficient - Provide support for fast and slow critical sections by lisps: buffer-streams, circularity-arrays/hashes, shared controller side-effects... (see email) @@ -69,6 +68,7 @@ - Cleaner failure modes if operations are performed without repository or without transaction or auto-commit (auto-commit solved by 4.4?) - Review and address all NOTE comments in the code +- Use SWIG and CFFI to better track changes in defconstant? RELEASE ISSUES @@ -81,8 +81,6 @@ - Validate migration 0.6.0->0.6.1 - Validate that migrate can use either O(c) or O(n/c) where c << n memory - Windows support for asdf-based library builds? Include dll? -- Allow dump of fast-symbol tables for low-level reconstruction in case of - catastrophic errors Documentation: - Migrate code base to SVN and create tickets in TRAC @@ -99,7 +97,6 @@ January 22, 2006 checkins: x Modularize serializers for easy upgrade -x Implement backend support for symbol-table protocol x MCL 1.1 unicode support; clean up other lisp support for unicode x Simplify user-specific configuration parameters using config.sexp and my-config.sexp x Ensure thread safety in buffer-stream allocation! --- /project/elephant/cvsroot/elephant/ele-bdb.asd 2007/01/21 21:20:03 1.15 +++ /project/elephant/cvsroot/elephant/ele-bdb.asd 2007/01/31 20:05:37 1.16 @@ -63,7 +63,6 @@ (:bdb-c-source "libberkeley-db") (:file "berkeley-db") (:file "bdb-controller") - (:file "bdb-symbol-tables") (:file "bdb-slots") (:file "bdb-collections") (:file "bdb-transactions"))

1 0

[elephant-cvs] CVS elephant
by ieslick 29 Jan '07

29 Jan '07

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv26676 Modified Files: elephant.asd Log Message: Build support for 64-bit compilation or OpenMCL 1.1 on OS X --- /project/elephant/cvsroot/elephant/elephant.asd 2007/01/25 18:17:59 1.24 +++ /project/elephant/cvsroot/elephant/elephant.asd 2007/01/29 15:15:04 1.25 @@ -109,6 +109,7 @@ (list #-(or darwin macosx darwin-host) "-shared" #+(or darwin macosx darwin-host) "-bundle" + #+(or x8664-target) "-arch x86_64" "-Wall" "-fPIC" "-O3"

1 0