elephant-cvs January 2007

elephant-cvs@common-lisp.net

2 participants
37 discussions

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

19 Jan '07

Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv4428/src/db-bdb Modified Files: bdb-controller.lisp berkeley-db.lisp libberkeley-db.c Added Files: bdb-symbol-tables.lisp Log Message: Added missing file; Henrik's fixes to ele-bdb and clsql cursor-pset --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2006/12/16 19:35:10 1.14 +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-controller.lisp 2007/01/19 21:03:29 1.15 @@ -57,16 +57,6 @@ (string t) (otherwise nil)))) -(defmethod controller-version ((sc store-controller)) - (let ((version (controller-version sc))) - (if version version - (let ((path (make-pathname :name "VERSION" :defaults (second (controller-spec sc))))) - (if (probe-file path) - (with-open-file (stream path :direction :input) - (read stream)) - (with-open-file (stream path :direction :output) - (write *elephant-code-version* :stream stream))))))) - ;; ;; Open/close ;; --- /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2006/11/11 18:43:31 1.1 +++ /project/elephant/cvsroot/elephant/src/db-bdb/berkeley-db.lisp 2007/01/19 21:03:29 1.2 @@ -1673,10 +1673,11 @@ :returning :int) (def-function ("db_set_lisp_compare" %db-set-lisp-compare) - ((db :pointer-void)) + ((db :pointer-void) + (version :int)) :returning :int) -(wrap-errno db-set-lisp-compare (db) :documentation +(wrap-errno db-set-lisp-compare (db version) :documentation "Sets the Btree comparision function to a hand-cooked function for Elephant to compare lisp values.") @@ -1686,10 +1687,11 @@ :returning :int) (def-function ("db_set_lisp_dup_compare" %db-set-lisp-dup-compare) - ((db :pointer-void)) + ((db :pointer-void) + (version :int)) :returning :int) -(wrap-errno db-set-lisp-dup-compare (db) :documentation +(wrap-errno db-set-lisp-dup-compare (db version) :documentation "Sets the duplicate comparision function to a hand-cooked function for Elephant to compare lisp values.") --- /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c 2007/01/16 18:02:27 1.3 +++ /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c 2007/01/19 21:03:29 1.4 @@ -873,8 +873,8 @@ void db_multiple_key_next(void *pointer, DBT *data, unsigned char **key, u_int32_t *ret_key_size, unsigned char **result, u_int32_t *result_size) { - DB_MULTIPLE_KEY_NEXT(pointer, data, - *key, *ret_key_size, + DB_MULTIPLE_KEY_NEXT(pointer, data, + *key, *ret_key_size, *result, *result_size); } --- /project/elephant/cvsroot/elephant/src/db-bdb/bdb-symbol-tables.lisp 2007/01/19 21:03:30 NONE +++ /project/elephant/cvsroot/elephant/src/db-bdb/bdb-symbol-tables.lisp 2007/01/19 21:03:30 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; controller.lisp -- Lisp interface to a Berkeley DB store ;;; ;;; Initial version 8/26/2004 by Ben Lee ;;; <blee(a)common-lisp.net> ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee ;;; <ablumberg(a)common-lisp.net> <blee(a)common-lisp.net> ;;; ;;; Elephant users are granted the rights to distribute and use this software ;;; as governed by the terms of the Lisp Lesser GNU Public License ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;; (in-package :db-bdb) (defmethod lookup-persistent-symbol-id ((sc bdb-store-controller) symbol) "Look up and create id association for symbol" (with-buffer-streams (keybuf valbuf) (buffer-write-int *symbol-to-id-table-oid* keybuf) (serialize-symbol-complete symbol keybuf) (let ((buf (db-get-key-buffered (controller-btrees sc) keybuf valbuf))) (if buf (values (buffer-read-int buf) T) (values (create-persistent-symbol sc symbol keybuf valbuf) t))))) (defun create-persistent-symbol (sc symbol keybuf valbuf) "Takes an symbol->id table + symbol keybuf, allocates an ID and updates the persistent tables." (reset-buffer-stream valbuf) ;; Just to avoid any contamination ;; (with-transaction (:txn-nosync t :dirty-read t) (format t "getting next symid") (let ((id (next-symid sc))) ;; allocate a new unique id ;; Update symbol->id table (format t "Writing sym->id: ~A -> ~A~%" symbol id) (buffer-write-int id valbuf) (format t "Putting id into table location~%") (db-put-buffered (controller-btrees sc) keybuf valbuf :auto-commit *auto-commit*) ;; Write id->symbol table (reset-buffer-stream keybuf) (reset-buffer-stream valbuf) (format t "Writing id->sym: ~A -> ~A~%" id symbol) (buffer-write-int *id-to-symbol-table-oid* keybuf) (buffer-write-int id keybuf) (serialize-symbol-complete symbol valbuf) (db-put-buffered (controller-btrees sc) keybuf valbuf :auto-commit *auto-commit*) id) ;; ) ) (defmethod lookup-persistent-symbol ((sc bdb-store-controller) id) "Lookup the ID associated with a symbol" (with-buffer-streams (keybuf valbuf) (format t "Looking up: ~A~%" id) (buffer-write-int *id-to-symbol-table-oid* keybuf) (buffer-write-int id keybuf) (format t "Get for id: ~A~%" id) (let ((buf (db-get-key-buffered (controller-btrees sc) keybuf valbuf))) (format t "Got buf: ~A~%" buf) (if buf (values (deserialize buf sc) T) (error "Invalid ID - no persistent mapping for ID"))))) ;; ;; Stress test ;; (defun stress-test (iters syms) (loop for i fixnum from 0 upto iters do (format t "Iteration ~A~%" i) ;; (with-transaction () ;; (print *current-transaction*) (loop for i fixnum from 0 upto (length syms) do (add-to-root (nth i syms) (nth i syms))))) (defun make-syms (num &aux list) (loop for i fixnum from 0 below num do (let* ((str (format nil "test~A" i)) (sym (intern str))) (push sym list))) (nreverse list))

1 0

[elephant-cvs] CVS elephant/src/db-clsql
by ieslick 19 Jan '07

19 Jan '07

Update of /project/elephant/cvsroot/elephant/src/db-clsql In directory clnet:/tmp/cvs-serv4428/src/db-clsql Modified Files: sql-collections.lisp Log Message: Added missing file; Henrik's fixes to ele-bdb and clsql cursor-pset --- /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2006/11/11 18:41:11 1.6 +++ /project/elephant/cvsroot/elephant/src/db-clsql/sql-collections.lisp 2007/01/19 21:03:30 1.7 @@ -136,7 +136,7 @@ (tup tuples (cdr tup))) ((= i len) nil) (setf (aref (:sql-crsr-ks cursor) i) - (deserialize-from-base64-string (caar tup) :sc sc))) + (deserialize-from-base64-string (caar tup) sc))) (sort (:sql-crsr-ks cursor) #'my-generic-less-than) (setf (:sql-crsr-ck cursor) 0) (setf (cursor-initialized-p cursor) t) @@ -362,14 +362,14 @@ (declare (optimize (speed 3))) (unless (cursor-initialized-p cursor) (cursor-init cursor)) - (let ((idx (position key (:sql-crsr-ks cursor)))) + (let ((idx (position key (:sql-crsr-ks cursor) :test #'equal))) (if idx - (progn - (setf (:sql-crsr-ck cursor) idx) - (setf (:dp-nmbr cursor) 0) - (cursor-current-x cursor :returnpk t)) - (cursor-un-init cursor) - ))) + (progn + (setf (:sql-crsr-ck cursor) idx) + (setf (:dp-nmbr cursor) 0) + (cursor-current-x cursor :returnpk t)) + (cursor-un-init cursor) + ))) (defun array-index-if (p a) (do ((i 0 (1+ i)))

1 0

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

19 Jan '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv4428/src/elephant Modified Files: controller.lisp package.lisp Log Message: Added missing file; Henrik's fixes to ele-bdb and clsql cursor-pset --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2006/12/16 19:35:10 1.17 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/01/19 21:03:30 1.18 @@ -198,7 +198,7 @@ (class-root :reader controller-class-root :documentation "This should be a persistent indexed btree instantiated by the backend") ;; Upgradable serializer strategy - (version :accessor controller-version :initform nil) + (version :accessor controller-version-cached :initform nil) (serializer-version :accessor controller-serializer-version :initform nil) (serialize :accessor controller-serialize :initform nil) (deserialize :accessor controller-deserialize :initform nil) @@ -230,11 +230,16 @@ (defvar *restricted-properties* '(:version) "Properties that are not user manipulable") -(defgeneric controller-version ((sc store-controller)) - (:documentation "Return the elephant version of this controller - should not - require the serializer to operate as it may be used to determine - the serializer version used to read the DB. This has to be valid - prior to the DB being opened.")) +(defmethod controller-version ((sc store-controller)) + (let ((version (controller-version-cached sc))) + (if version version + (let ((path (make-pathname :name "VERSION" :defaults (second (controller-spec sc))))) + (if (probe-file path) + (with-open-file (stream path :direction :input) + (setf (controller-version-cached sc) (read stream))) + (with-open-file (stream path :direction :output) + (setf (controller-version-cached sc) + (write *elephant-code-version* :stream stream)))))))) (defun prior-version-p (v1 v2) "Is v1 an equal or earlier version than v2" --- /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2006/12/16 19:35:10 1.4 +++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/01/19 21:03:30 1.5 @@ -29,7 +29,8 @@ #:*elephant-lib-path* #:*elephant-code-version* #:store-controller #:controller-root #:controller-class-root - #:controller-version #:controller-serialize #:controller-deserialize + #:controller-version #:controller-serializer-version + #:controller-serialize #:controller-deserialize #:open-store #:close-store #:with-open-store #:add-to-root #:get-from-root #:remove-from-root #:root-existsp #:get-cached-instance #:flush-instance-cache

1 0

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

19 Jan '07

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv4428 Modified Files: TODO ele-bdb.asd elephant.asd Log Message: Added missing file; Henrik's fixes to ele-bdb and clsql cursor-pset --- /project/elephant/cvsroot/elephant/TODO 2006/12/16 19:35:09 1.31 +++ /project/elephant/cvsroot/elephant/TODO 2007/01/19 21:03:29 1.32 @@ -14,7 +14,6 @@ - flexible handling of 64-bit fixnums Stability: -- Remove build gensym warnings in sleepycat.lisp - Delete persistent slot values from the slot store with remove-kv to ensure that there's no data left lying around if you define then redefine a class and add back a persistent slot name that you thought was deleted and it gets the old @@ -61,6 +60,8 @@ parameter that determines if this is the default? Performance: +- Allow dump of fast-symbol tables for low-level reconstruction in case of + catastrophic errors - Metering and understanding locking issues. Large transactions seem to use a lot of locks. In general understanding how to use Berkeley DB efficiently seems like a good thing. (From Ben) @@ -85,6 +86,7 @@ 0.6.1 - Features COMPLETED to date ---------------------------------- +January 2006 checkin x Improved optimization options to be more user controlled (Pierre Thierry) x Implement backend support for symbol-table protocol x Speed up symbol storage and reference using symbol id's @@ -94,7 +96,10 @@ x New build interface; all-lisp compilation (sans win32) x Simplify user-specific configuration parameters using config.sexp and my-config.sexp x Make sure to ensure thread safety in buffer-stream allocation! +x Investigated gensym warnings in berkeley-db.lisp (caused by an FFI macro, no harm in it) +x Remove warnings in libberkeley-db.c +Prior to December 2006 x BDB overwrite of values makes DB grow [So far I can only find that it grows on the 2nd write, but not after that...artifact of page allocation or caching of memory pools?] --- /project/elephant/cvsroot/elephant/ele-bdb.asd 2006/12/16 19:35:09 1.13 +++ /project/elephant/cvsroot/elephant/ele-bdb.asd 2007/01/19 21:03:29 1.14 @@ -31,11 +31,16 @@ (defun get-config-option (option component) (unless *bdb-config* - (with-open-file (config (make-pathname :defaults (asdf:component-pathname - (asdf:component-system component)) - :name "my-config" - :type "sexp")) - (setf *bdb-config* (read config)))) + (let ((filespec (make-pathname :defaults (asdf:component-pathname + +(asdf:component-system component)) + :name "my-config" + :type "sexp"))) + (unless (probe-file filespec) + (error "Missing file. Copy config.sexp in elephant root +directory to my-config.sexp and edit it appropriately.")) + (with-open-file (config filespec) + (setf *bdb-config* (read config))))) (cdr (assoc option *bdb-config*))) ;; --- /project/elephant/cvsroot/elephant/elephant.asd 2006/12/16 19:35:09 1.21 +++ /project/elephant/cvsroot/elephant/elephant.asd 2007/01/19 21:03:29 1.22 @@ -130,8 +130,8 @@ (defsystem elephant :name "elephant" :author "Ben Lee <blee(a)common-lisp.net>" - :version "0.6.0" - :maintainer "Ben Lee <blee(a)common-lisp.net>" + :version "0.6.1" + :maintainer "Robert Read <read(a)robertlread.net>" :licence "LLGPL" :description "Object database for Common Lisp" :long-description "An object-oriented database based on Berkeley DB, for CMUCL/SBCL, OpenMCL, and Allegro."

1 0

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

16 Jan '07

Update of /project/elephant/cvsroot/elephant/src/db-bdb In directory clnet:/tmp/cvs-serv771 Modified Files: libberkeley-db.c Log Message: Fixed build errors in db-bdb C interface file. This file is not yet complete for serializer2 --- /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c 2006/12/16 19:35:10 1.2 +++ /project/elephant/cvsroot/elephant/src/db-bdb/libberkeley-db.c 2007/01/16 18:02:27 1.3 @@ -67,7 +67,7 @@ /* Pointer arithmetic utility functions */ /* should these be in network-byte order? probably not..... */ int read_int(char *buf, int offset) { - int int; + int i; memcpy(&i, buf+offset, sizeof(int)); return i; } @@ -79,7 +79,7 @@ } int32_t read_int32(char *buf, int offset) { - int int32_t; + int32_t i; memcpy(&i, buf+offset, sizeof(int32_t)); return i; } @@ -119,7 +119,7 @@ memcpy(buf+offset, &num, sizeof(int)); } -void write_uint(char *buf, unsighed int num, int offset) { +void write_uint(char *buf, unsigned int num, int offset) { memcpy(buf+offset, &num, sizeof(unsigned int)); } @@ -277,6 +277,7 @@ double read_num(char *buf); int case_cmp(const char *a, int32_t length1, const char *b, int32_t length2); +int wcs_cmp(const wchar_t *a, int32_t length1, const wchar_t *b, int32_t length2); int lex_cmp(const char *a, int32_t length1, const char *b, int32_t length2); int utf16_cmp(const char *s1, int32_t length1, const char *s2, int32_t length2); @@ -316,7 +317,7 @@ } /* Compare types. */ - if + /* ISE: need extra conditional here...forget why, so research it */ difference = at - bt; if (difference) return difference; @@ -335,7 +336,7 @@ case 20: case 21: case 22: - return wcs_cmp(ad+9, read_int(ad, 5), bd+9, read_int(bd, 5)); + return wcs_cmp((wchar_t*)ad+9, read_int(ad, 5), (wchar_t*)bd+9, read_int(bd, 5)); default: return lex_cmp(ad+5, (a->size)-5, bd+5, (b->size)-5); } @@ -368,33 +369,37 @@ /* Compare numerics. */ if (type_numeric2(at) && type_numeric2(bt)) { - ddifference = read_num2(ad+4) - read_num2(bd+4); + /* ddifference = read_num2(ad+4) - read_num2(bd+4); */ + ddifference = read_num(ad+4) - read_num(bd+4); if (ddifference > 0) return 1; else if (ddifference < 0) return -1; return 0; } /* Compare types. */ - if + /* ISE: need extra conditional here...forget why, so research it */ difference = at - bt; if (difference) return difference; - ;; TODO: compare strings of different sizes? - ;; TODO: compare symbol-ids? + /* TODO: compare strings of different sizes? */ + /* TODO: compare symbol-ids? */ /* Same type! */ switch (at) { - case #x3F: /* nil */ + case 0x3F: /* nil */ return 0; case 9: /* 8-bit string */ + return case_cmp(ad+9, read_int32(ad, 5), bd+9, read_int32(bd, 5)); + /* ISE: Why did I do this? if( bt == 9 ) return case_cmp(ad+9, read_int32(ad, 5), bd+9, read_int32(bd, 5)); else return full_cmp(ad+9, read_int32(ad, 5), bd+9, read_int32(bd, 5)) + */ case 10: /* 16-bit string */ return utf16_cmp(ad+9, read_int32(ad, 5), bd+9, read_int32(bd, 5)); case 11: - return wcs_cmp(ad+9, read_int32(ad, 5), bd+9, read_int32(bd, 5)); + return wcs_cmp((wchar_t*)ad+9, read_int32(ad, 5), (wchar_t*)bd+9, read_int32(bd, 5)); default: return lex_cmp(ad+5, (a->size)-5, bd+5, (b->size)-5); } @@ -866,8 +871,8 @@ } void db_multiple_key_next(void *pointer, DBT *data, - char **key, u_int32_t *ret_key_size, - char **result, u_int32_t *result_size) { + unsigned char **key, u_int32_t *ret_key_size, + unsigned char **result, u_int32_t *result_size) { DB_MULTIPLE_KEY_NEXT(pointer, data, *key, *ret_key_size, *result, *result_size); @@ -875,7 +880,7 @@ /* Transactions */ -DB_TXN * db_txn_begin(DB_ENV *env, DB_TXN *parent, +DB_TXN *db_txn_begin(DB_ENV *env, DB_TXN *parent, u_int32_t flags, int *errno) { DB_TXN * p; *errno = env->txn_begin(env, parent, &p, flags);

1 0

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

16 Jan '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv4243 Added Files: classes-new.lisp serializer2-locks.lisp serializer3.lisp Log Message: Adding missing files, some of these will go away later but I want to keep a record of my work to date. I really should have put this on a branch, but it got out of control before I realized how much rewiring I was doing! ----------- --- /project/elephant/cvsroot/elephant/src/elephant/classes-new.lisp 2007/01/16 00:55:22 NONE +++ /project/elephant/cvsroot/elephant/src/elephant/classes-new.lisp 2007/01/16 00:55:22 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; classes.lisp -- persistent objects via metaobjects ;;; ;;; Initial version 8/26/2004 by Andrew Blumberg ;;; <ablumberg(a)common-lisp.net> ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee ;;; <ablumberg(a)common-lisp.net> <blee(a)common-lisp.net> ;;; ;;; Elephant users are granted the rights to distribute and use this software ;;; as governed by the terms of the Lisp Lesser GNU Public License ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;; (in-package "ELEPHANT") (defvar *debug-si* nil) (defmethod initialize-instance :before ((instance persistent) &rest initargs &key from-oid (sc *store-controller*)) "Sets the OID and home controller" (declare (ignore initargs)) (if (null sc) (error "Initialize instance for type persistent requires valid store controller argument :sc")) (if from-oid (setf (oid instance) from-oid) (setf (oid instance) (next-oid sc))) (setf (:dbcn-spc-pst instance) (controller-spec sc)) (cache-instance sc instance)) (defclass persistent-object (persistent) () (:metaclass persistent-metaclass) (:documentation "Superclass of all user-defined persistent classes. This is automatically inherited if you use the persistent-metaclass metaclass.")) ;; ================================================ ;; METACLASS INITIALIZATION AND CHANGES ;; ================================================ (defmethod ensure-class-using-class :around ((class (eql nil)) name &rest args &key index) "Support the :index class option" (let ((result (apply #'call-next-method class name (remove-index-keyword args)))) (when (and index (subtypep (type-of result) 'persistent-metaclass)) (update-indexed-record result nil :class-indexed t)) result)) (defmethod ensure-class-using-class :around ((class persistent-metaclass) name &rest args &key index) "Support the :index class option on redefinition" (let ((result (apply #'call-next-method class name (remove-index-keyword args)))) (when index (update-indexed-record result nil :class-indexed t)) result)) (defun remove-index-keyword (list) (cond ((null list) nil) ((eq (car list) :index) (cddr list)) (t (cons (car list) (remove-index-keyword (cdr list)))))) (defmethod shared-initialize :around ((class persistent-metaclass) slot-names &rest args &key direct-superclasses) "Ensures we inherit from persistent-object." (let* ((persistent-metaclass (find-class 'persistent-metaclass)) (persistent-object (find-class 'persistent-object)) (not-already-persistent (loop for superclass in direct-superclasses never (eq (class-of superclass) persistent-metaclass)))) (if (and (not (eq class persistent-object)) not-already-persistent) (apply #'call-next-method class slot-names :direct-superclasses (cons persistent-object direct-superclasses) args) (call-next-method)))) (defmethod finalize-inheritance :around ((instance persistent-metaclass)) "Update the persistent slot records in the metaclass." (prog1 (call-next-method) (when (not (slot-boundp instance '%persistent-slots)) (setf (%persistent-slots instance) (cons (persistent-slot-names instance) nil))) (update-indexed-record instance (indexed-slot-names-from-defs instance)))) (defmethod reinitialize-instance :around ((instance persistent-metaclass) &rest initargs &key &allow-other-keys) (declare (ignore initargs)) (prog1 (call-next-method) (when (class-finalized-p instance) (update-persistent-slots instance (persistent-slot-names instance)) (update-indexed-record instance (indexed-slot-names-from-defs instance)) (if (removed-indexing? instance) (progn (let ((class-idx (get-value (class-name instance) (controller-class-root *store-controller*)))) (when class-idx (wipe-class-indexing instance class-idx))) (setf (%index-cache instance) nil)) (set-db-synch instance :class)) ;; #+allegro ;; (loop with persistent-slots = (persistent-slots instance) ;; for slot-def in (class-direct-slots instance) ;; when (member (slot-definition-name slot-def) persistent-slots) ;; do (initialize-accessors slot-def instance)) (make-instances-obsolete instance)))) ;; ================================================ ;; PERSISTENT OBJECT MAINTENANCE ;; ================================================ ;; ;; CLASS INSTANCE INITIALIZATION ;; (defmethod shared-initialize :around ((instance persistent-object) slot-names &rest initargs &key from-oid &allow-other-keys) "Initializes the persistent slots via initargs or forms. This seems to be necessary because it is typical for implementations to optimize setting the slots via initforms and initargs in such a way that slot-value-using-class et al aren't used. We also handle writing any indices after the class is fully initialized. Calls the next method for the transient slots." (let* ((class (find-class (class-name (class-of instance)))) (oid (oid instance)) (persistent-slot-names (persistent-slot-names class))) (flet ((persistent-slot-p (item) (member item persistent-slot-names :test #'eq))) (let ((transient-slot-inits (if (eq slot-names t) ; t means all slots (transient-slot-names class) (remove-if #'persistent-slot-p slot-names))) (persistent-slot-inits (if (eq slot-names t) persistent-slot-names (remove-if-not #'persistent-slot-p slot-names)))) (inhibit-indexing oid) (unwind-protect (progn ;; initialize the persistent slots ourselves (initialize-persistent-slots class instance persistent-slot-inits initargs) ;; let the implementation initialize the transient slots (apply #'call-next-method instance transient-slot-inits initargs)) (uninhibit-indexing oid)) ;; Inhibit indexing altogether if the object already was defined (ie being created ;; from an oid) as it should be indexed already. This hack avoids a deadlock ;; situation where we write the class or index page that we are currently reading ;; via a cursor without going through the cursor abstraction. There has to be a ;; better way to do this. (when (and (indexed class) (not from-oid)) (let ((class-index (find-class-index class))) (when class-index (setf (get-value oid class-index) instance)))) )))) (defun initialize-persistent-slots (class instance persistent-slot-inits initargs) (flet ((initialize-from-initarg (slot-def) (loop for initarg in initargs with slot-initargs = (slot-definition-initargs slot-def) when (member initarg slot-initargs :test #'eq) do (setf (slot-value-using-class class instance slot-def) (getf initargs initarg)) (return t)))) (with-transaction (:store-controller (get-con instance)) (loop for slot-def in (class-slots class) unless (initialize-from-initarg slot-def) when (member (slot-definition-name slot-def) persistent-slot-inits :test #'eq) unless (slot-boundp-using-class class instance slot-def) do (let ((initfun (slot-definition-initfunction slot-def))) (when initfun (setf (slot-value-using-class class instance slot-def) (funcall initfun)))))))) ;; ;; CLASS REDEFINITION PROTOCOL ;; (defmethod update-instance-for-redefined-class :around ((instance persistent-object) added-slots discarded-slots property-list &rest initargs &key &allow-other-keys) ;; NOTE: probably should delete discarded slots, but we'll worry about that later ;; (also will want to delete discarded indices since we don't have a good GC) (declare (ignore property-list discarded-slots added-slots)) (prog1 (call-next-method) (let* ((class (class-of instance)) (new-persistent-slots (set-difference (persistent-slots class) (old-persistent-slots class)))) ;; Update new persistent slots, the others we get for free (same oid!) ;; Isn't this done by the default call-next-method? (apply #'shared-initialize instance new-persistent-slots initargs)) )) ;; ;; CLASS CHANGE PROTOCOL ;; (defmethod update-instance-for-different-class :around ((previous persistent) (current persistent) &rest initargs &key) (let* ((old-class (class-of previous)) (new-class (class-of current)) (new-persistent-slots (set-difference (persistent-slots new-class) (persistent-slots old-class))) (raw-retained-persistent-slots (intersection (persistent-slots new-class) (persistent-slots old-class))) (retained-unbound-slots (loop for slot-name in raw-retained-persistent-slots when (not (persistent-slot-boundp (get-con previous) previous slot-name)) collect slot-name)) (retained-persistent-slots (set-difference raw-retained-persistent-slots retained-unbound-slots))) ;; Apply default values for unbound & new slots (updates class index) (apply #'shared-initialize current (append new-persistent-slots retained-unbound-slots) initargs) ;; Copy values from old class (NOTE: should delete discarded slots?) (updates class index) (with-transaction (:store-controller (get-con current)) (loop for slot-def in (class-slots new-class) when (member (slot-definition-name slot-def) retained-persistent-slots) do (setf (slot-value-using-class new-class current slot-def) (slot-value-using-class old-class previous (find-slot-def-by-name old-class (slot-definition-name slot-def)))))) ;; Delete this instance from its old class index, if exists (when (indexed old-class) (remove-kv (oid previous) (find-class-index old-class))) (call-next-method))) ;; ;; SLOT ACCESS PROTOCOLS ;; (defmethod slot-value-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition)) "Get the slot value from the database." (declare (optimize (speed 3))) (let ((name (slot-definition-name slot-def))) (persistent-slot-reader (get-con instance) instance name))) (defmethod (setf slot-value-using-class) :around (new-value (class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition)) "Set the slot value in the database." (declare (optimize (speed 3))) (if (indexed class) (indexed-slot-writer class instance slot-def new-value) (let ((name (slot-definition-name slot-def))) (persistent-slot-writer (get-con instance) new-value instance name)))) (defmethod slot-boundp-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition)) "Checks if the slot exists in the database." (declare (optimize (speed 3))) (let ((name (slot-definition-name slot-def))) (persistent-slot-boundp (get-con instance) instance name))) (defmethod slot-boundp-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-name symbol)) "Checks if the slot exists in the database." (declare (optimize (speed 3))) (loop for slot in (class-slots class) for matches-p = (eq (slot-definition-name slot) slot-name) until matches-p finally (return (if (and matches-p (subtypep (type-of slot) 'persistent-slot-definition)) (persistent-slot-boundp (get-con instance) instance slot-name) (call-next-method))))) (defmethod slot-makunbound-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition)) "Deletes the slot from the database." (declare (optimize (speed 3))) ;; NOTE: call remove-indexed-slot here instead? (when (indexed slot-def) (unregister-indexed-slot class (slot-definition-name slot-def))) (persistent-slot-makunbound (get-con instance) instance (slot-definition-name slot-def))) --- /project/elephant/cvsroot/elephant/src/elephant/serializer2-locks.lisp 2007/01/16 00:55:22 NONE +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2-locks.lisp 2007/01/16 00:55:22 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; serializer.lisp -- convert Lisp data to/from byte arrays ;;; ;;; Initial version 8/26/2004 by Ben Lee ;;; <blee(a)common-lisp.net> ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Elephant users are granted the rights to distribute and use this software ;;; as governed by the terms of the Lisp Lesser GNU Public License ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;; (in-package :elephant) (defpackage :elephant-serializer2 (:use :cl :elephant :elephant-memutil) (:import-from :elephant *circularity-initial-hash-size* *resourced-byte-spec* get-cached-instance slot-definition-allocation slot-definition-name compute-slots oid)) (in-package :elephant-serializer2) (declaim (inline int-byte-spec serialize deserialize slots-and-values deserialize-bignum)) (uffi:def-type foreign-char :char) ;; Constants (defconstant +fixnum+ 1) (defconstant +fixnum64+ 2) (defconstant +char+ 3) (defconstant +single-float+ 4) (defconstant +double-float+ 5) (defconstant +negative-bignum+ 6) (defconstant +positive-bignum+ 7) (defconstant +rational+ 8) ;; Save constants by splitting strings and encoding (defconstant +utf8-string+ 9) (defconstant +utf16-string+ 10) (defconstant +utf32-string+ 11) ;; String-based aggregates (defconstant +pathname+ 12) (defconstant +symbol+ 13) ;; Cached symbol references (defconstant +symbol-id+ 14) ;; stored by id+classname (defconstant +persistent+ 15) ;; Composite objects (defconstant +cons+ 16) (defconstant +hash-table+ 17) (defconstant +object+ 18) (defconstant +array+ 19) (defconstant +struct+ 20) (defconstant +class+ 21) (defconstant +nil+ #x3F) ;; Arrays (defconstant +fill-pointer-p+ #x40) (defconstant +adjustable-p+ #x80) ;; ;; The following may be overkill, but is intended to avoid continually ;; allocating hashes each time we serialize an object. I added some ;; adaptation to keep it from dropping and re-allocating if the user ;; continually saves large collections of objects. However the ;; defaults should handle most apps just fine. The queue is useful ;; because a system with 10 threads will need 10 circularity queues if ;; it is storing large objects ;; ;; ;; Circularity Hash for Serializer ;; (defparameter *circularity-hash-queue* (make-array 20 :fill-pointer 0 :adjustable t) "Circularity ids for the serializer.") (defparameter *circularity-lock* (ele-make-lock) "Enable multiprocessor ") (defun get-circularity-hash () "Get a clean hash for object serialization" (declare (optimize (speed 3) (safety 0))) (make-hash-table :test 'eq :size *circularity-initial-hash-size*)) ;; (if (= 0 (length *circularity-hash-queue*)) ;; (make-hash-table :test 'eq :size *circularity-initial-hash-size*)) ;; (ele-with-lock (*circularity-lock*) ;; (vector-pop *circularity-hash-queue*)))) (defun release-circularity-hash (hash) "Return the hash to the queue for reuse" (declare (optimize (speed 3) (safety 0)) (type hash-table hash) (type array *circularity-hash-queue*)) nil) ;; (unless (= (hash-table-count hash) 0) ;; (clrhash hash)) ;; (ele-with-lock (*circularity-lock*) ;; (vector-push-extend hash *circularity-hash-queue*))) ;; ;; Circularity Hash for Serializer ;; (defparameter *circularity-vector-queue* (make-array 20 :fill-pointer 0 :adjustable t) "A list of vectors used for linear deserialization. This works nicely because all ID's are written [449 lines skipped] --- /project/elephant/cvsroot/elephant/src/elephant/serializer3.lisp 2007/01/16 00:55:22 NONE +++ /project/elephant/cvsroot/elephant/src/elephant/serializer3.lisp 2007/01/16 00:55:22 1.1 [582 lines skipped]

1 0

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

16 Jan '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv4094 Added Files: cross-platform.lisp serializer1.lisp serializer2.lisp unicode2.lisp Log Message: --- /project/elephant/cvsroot/elephant/src/elephant/cross-platform.lisp 2007/01/16 00:51:25 NONE +++ /project/elephant/cvsroot/elephant/src/elephant/cross-platform.lisp 2007/01/16 00:51:25 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; cross-platform.lisp -- convert Lisp data to/from byte arrays ;;; ;;; Initial version 8/26/2004 by Ben Lee ;;; <blee(a)common-lisp.net> ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Elephant users are granted the rights to distribute and use this software ;;; as governed by the terms of the Lisp Lesser GNU Public License ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;; (in-package :elephant) ;; This is a quick portability hack to avoid external dependencies, if we get ;; to many of these do we need to import a standard library? do we need to import 'port' or some ;; other thread layer to the elephant dependency list? (defmacro ele-without-interrupts (&body body) `(elephant-memutil::memutil-without-interrupts ,@body)) (defun ele-make-lock () #+allegro (mp::make-process-lock) #+cmu (mp:make-lock) #+sbcl (sb-thread:make-mutex) #+mcl (ccl:make-lock) #+lispworks (mp:make-lock) #-(or allegro sbcl cmu lispworks mcl) nil ) (defmacro ele-with-lock ((lock &rest ignored) &body body) (declare (ignore ignored) (ignorable lock)) #+allegro `(mp:with-process-lock (,lock) ,@body) #+cmu `(mp:with-lock-held (,lock) ,@body) #+sbcl `(sb-thread:with-mutex (,lock) ,@body) #+lispworks `(mp:with-lock (,lock) ,@body) #+mcl `(ccl:with-lock-grabbed (,lock) ,@body) #-(or allegro sbcl cmu lispworks mcl) `(progn ,@body) ) --- /project/elephant/cvsroot/elephant/src/elephant/serializer1.lisp 2007/01/16 00:51:25 NONE +++ /project/elephant/cvsroot/elephant/src/elephant/serializer1.lisp 2007/01/16 00:51:25 1.1 ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;; ;;; serializer.lisp -- convert Lisp data to/from byte arrays ;;; ;;; Initial version 8/26/2004 by Ben Lee ;;; <blee(a)common-lisp.net> ;;; ;;; part of ;;; ;;; Elephant: an object-oriented database for Common Lisp ;;; ;;; Elephant users are granted the rights to distribute and use this software ;;; as governed by the terms of the Lisp Lesser GNU Public License ;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL. ;;; (in-package "ELEPHANT") (defpackage :elephant-serializer1 (:use :cl :elephant :elephant-memutil) (:import-from :elephant *resourced-byte-spec* get-cached-instance slot-definition-allocation slot-definition-name compute-slots oid)) (in-package :elephant-serializer1) (declaim (inline int-byte-spec serialize deserialize slots-and-values deserialize-bignum)) (uffi:def-type foreign-char :char) ;; Constants (defconstant +fixnum+ 1) (defconstant +char+ 2) (defconstant +single-float+ 3) (defconstant +double-float+ 4) (defconstant +negative-bignum+ 5) (defconstant +positive-bignum+ 6) (defconstant +rational+ 7) (defconstant +nil+ 8) ;; 8-bit (defconstant +ucs1-symbol+ 9) (defconstant +ucs1-string+ 10) (defconstant +ucs1-pathname+ 11) ;; 16-bit (defconstant +ucs2-symbol+ 12) (defconstant +ucs2-string+ 13) (defconstant +ucs2-pathname+ 14) ;; 32-bit (defconstant +ucs4-symbol+ 20) (defconstant +ucs4-string+ 21) (defconstant +ucs4-pathname+ 22) (defconstant +persistent+ 15) ;; stored by id+classname (defconstant +cons+ 16) (defconstant +hash-table+ 17) (defconstant +object+ 18) (defconstant +array+ 19) (defconstant +fill-pointer-p+ #x40) (defconstant +adjustable-p+ #x80) (defvar *lisp-obj-id* 0 "Circularity ids for the serializer.") (defvar *circularity-hash* (make-hash-table) "Circularity hash for the serializer.") (defun clear-circularity-hash () "This handles the case where we store an object with lots of object references. CLRHASH then starts to dominate performance as it has to visit ever spot in the table so we're better off GCing the old table than clearing it" (declare (optimize (speed 3) (safety 0))) (if (> (hash-table-size *circularity-hash*) 100) (setf *circularity-hash* (make-hash-table :test 'eq :size 50)) (clrhash *circularity-hash*))) (defun serialize (frob bs sc) "Serialize a lisp value into a buffer-stream." (declare (optimize (speed 3) (safety 0)) (type buffer-stream bs)) (setq *lisp-obj-id* 0) (clear-circularity-hash) (labels ((%serialize (frob) (declare (optimize (speed 3) (safety 0))) (typecase frob (fixnum (buffer-write-byte +fixnum+ bs) (buffer-write-int frob bs)) (null (buffer-write-byte +nil+ bs)) (symbol (let ((s (symbol-name frob))) (declare (type string s) (dynamic-extent s)) (buffer-write-byte #+(and allegro ics) (etypecase s (base-string +ucs1-symbol+) ;; +ucs1-symbol+ (string +ucs2-symbol+)) #+(or (and sbcl sb-unicode) lispworks) (etypecase s (base-string +ucs1-symbol+) (string #+sbcl +ucs4-symbol+ #+lispworks +ucs2-symbol+)) #-(or lispworks (and allegro ics) (and sbcl sb-unicode)) +ucs1-symbol+ bs) (buffer-write-int (byte-length s) bs) (buffer-write-string s bs) (let ((package (symbol-package frob))) (if package (%serialize (package-name package)) (%serialize nil))))) (string (progn (buffer-write-byte #+(and allegro ics) (etypecase frob (base-string +ucs1-string+) ;; +ucs1-string+ (string +ucs2-string+)) #+(or (and sbcl sb-unicode) lispworks) (etypecase frob (base-string +ucs1-string+) (string #+sbcl +ucs4-string+ #+lispworks +ucs2-string+)) #-(or lispworks (and allegro ics) (and sbcl sb-unicode)) +ucs1-string+ bs) (buffer-write-int (byte-length frob) bs) (buffer-write-string frob bs))) (persistent (buffer-write-byte +persistent+ bs) (buffer-write-int (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 ;; CLHS says it should, but gives the class object itself, ;; which cannot be directly serialized.... (let ((tp (type-of frob))) #+(or sbcl) (if (not (symbolp tp)) (setf tp (class-name (class-of frob)))) (%serialize tp)) ) #-(and :lispworks (or :win32 :linux)) (single-float (buffer-write-byte +single-float+ bs) (buffer-write-float frob bs)) (double-float (buffer-write-byte +double-float+ bs) (buffer-write-double frob bs)) (character (buffer-write-byte +char+ bs) ;; might be wide! (buffer-write-uint (char-code frob) bs)) (pathname (let ((s (namestring frob))) (declare (type string s) (dynamic-extent s)) (buffer-write-byte #+(and allegro ics) (etypecase s (base-string +ucs1-pathname+) ;; +ucs1-pathname+ (string +ucs2-pathname+)) #+(or (and sbcl sb-unicode) lispworks) (etypecase s (base-string +ucs1-pathname+) (string #+sbcl +ucs4-pathname+ #+lispwoks +ucs2-pathname+)) #-(or lispworks (and allegro ics) (and sbcl sb-unicode)) +ucs1-pathname+ bs) (buffer-write-int (byte-length s) bs) (buffer-write-string s bs))) (integer (let* ((num (abs frob)) (word-size (ceiling (/ (integer-length num) 32))) (needed (* word-size 4))) (declare (type fixnum word-size needed)) (if (< frob 0) (buffer-write-byte +negative-bignum+ bs) (buffer-write-byte +positive-bignum+ bs)) (buffer-write-int needed bs) (loop for i fixnum from 0 below word-size ;; this ldb is consing on CMUCL! ;; there is an OpenMCL function which should work ;; and non-cons do #+(or cmu sbcl) (buffer-write-uint (%bignum-ref num i) bs) #+(or allegro lispworks openmcl) (buffer-write-uint (ldb (int-byte-spec i) num) bs)))) (rational (buffer-write-byte +rational+ bs) (%serialize (numerator frob)) (%serialize (denominator frob))) (cons (buffer-write-byte +cons+ bs) (let ((idp (gethash frob *circularity-hash*))) (if idp (buffer-write-int idp bs) (progn (buffer-write-int (incf *lisp-obj-id*) bs) (setf (gethash frob *circularity-hash*) *lisp-obj-id*) (%serialize (car frob)) (%serialize (cdr frob)))))) (hash-table (buffer-write-byte +hash-table+ bs) (let ((idp (gethash frob *circularity-hash*))) (if idp (buffer-write-int idp bs) (progn (buffer-write-int (incf *lisp-obj-id*) bs) (setf (gethash frob *circularity-hash*) *lisp-obj-id*) (%serialize (hash-table-test frob)) (%serialize (hash-table-rehash-size frob)) (%serialize (hash-table-rehash-threshold frob)) (%serialize (hash-table-count frob)) (loop for key being the hash-key of frob using (hash-value value) do (%serialize key) (%serialize value)))))) (standard-object (buffer-write-byte +object+ bs) (let ((idp (gethash frob *circularity-hash*))) (if idp (buffer-write-int idp bs) (progn (buffer-write-int (incf *lisp-obj-id*) bs) (setf (gethash frob *circularity-hash*) *lisp-obj-id*) (%serialize (type-of frob)) (let ((svs (slots-and-values frob))) (declare (dynamic-extent svs)) (%serialize (/ (length svs) 2)) (loop for item in svs do (%serialize item))))))) (array (buffer-write-byte +array+ bs) (let ((idp (gethash frob *circularity-hash*))) (if idp (buffer-write-int idp bs) (progn (buffer-write-int (incf *lisp-obj-id*) bs) (setf (gethash frob *circularity-hash*) *lisp-obj-id*) (buffer-write-byte (logior (byte-from-array-type (array-element-type frob)) (if (array-has-fill-pointer-p frob) +fill-pointer-p+ 0) (if (adjustable-array-p frob) +adjustable-p+ 0)) bs) (let ((rank (array-rank frob))) (buffer-write-int rank bs) (loop for i fixnum from 0 below rank do (buffer-write-int (array-dimension frob i) bs))) (when (array-has-fill-pointer-p frob) (buffer-write-int (fill-pointer frob) bs)) (loop for i fixnum from 0 below (array-total-size frob) do (%serialize (row-major-aref frob i))))))) ))) (%serialize frob) bs)) (defun slots-and-values (o) (declare (optimize (speed 3) (safety 0))) (loop for sd in (compute-slots (class-of o)) for slot-name = (slot-definition-name sd) with ret = () do (when (and (slot-boundp o slot-name) (eq :instance (slot-definition-allocation sd))) (push (slot-value o slot-name) ret) (push slot-name ret)) finally (return ret))) (defun deserialize (buf-str sc) "Deserialize a lisp value from a buffer-stream." (declare (optimize (speed 3) (safety 0)) (type (or null buffer-stream) buf-str)) (labels ((%deserialize (bs) (declare (optimize (speed 3) (safety 0)) (type buffer-stream bs)) (let ((tag (buffer-read-byte bs))) (declare (type foreign-char tag)) (cond ((= tag +fixnum+) (buffer-read-fixnum bs)) ((= tag +nil+) nil) ((= tag +ucs1-symbol+) (let ((name (buffer-read-ucs1-string bs (buffer-read-fixnum bs))) (maybe-package-name (%deserialize bs))) (if maybe-package-name (intern name (find-package maybe-package-name)) (make-symbol name)))) #+(or lispworks (and allegro ics)) ((= tag +ucs2-symbol+) (let ((name (buffer-read-ucs2-string bs (buffer-read-fixnum bs))) (maybe-package-name (%deserialize bs))) (if maybe-package-name (intern name (find-package maybe-package-name)) (make-symbol name)))) #+(and sbcl sb-unicode) ((= tag +ucs4-symbol+) (let ((name (buffer-read-ucs4-string bs (buffer-read-fixnum bs))) (maybe-package-name (%deserialize bs))) ;; (format t "ouput name = ~A~%" name) (if maybe-package-name (intern name (find-package maybe-package-name)) (make-symbol name)))) ((= tag +ucs1-string+) (buffer-read-ucs1-string bs (buffer-read-fixnum bs))) #+(or lispworks (and allegro ics)) ((= tag +ucs2-string+) (buffer-read-ucs2-string bs (buffer-read-fixnum bs))) #+(and sbcl sb-unicode) ((= tag +ucs4-string+) (buffer-read-ucs4-string bs (buffer-read-fixnum bs))) ((= tag +persistent+) ;; (get-cached-instance *store-controller* (get-cached-instance sc (buffer-read-fixnum bs) (%deserialize bs))) ((= tag +single-float+) (buffer-read-float bs)) ((= tag +double-float+) (buffer-read-double bs)) ((= tag +char+) (code-char (buffer-read-uint bs))) ((= tag +ucs1-pathname+) (parse-namestring (or (buffer-read-ucs1-string bs (buffer-read-fixnum bs)) ""))) #+(or lispworks (and allegro ics)) ((= tag +ucs2-pathname+) (parse-namestring (or (buffer-read-ucs2-string bs (buffer-read-fixnum bs)) ""))) #+(and sbcl sb-unicode) ((= tag +ucs4-pathname+) (parse-namestring (or (buffer-read-ucs4-string bs (buffer-read-fixnum bs)) ""))) ((= tag +positive-bignum+) (deserialize-bignum bs (buffer-read-fixnum bs) t)) ((= tag +negative-bignum+) (deserialize-bignum bs (buffer-read-fixnum bs) nil)) ((= tag +rational+) (/ (the integer (%deserialize bs)) (the integer (%deserialize bs)))) ((= tag +cons+) [151 lines skipped] --- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/01/16 00:51:25 NONE +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/01/16 00:51:25 1.1 [720 lines skipped] --- /project/elephant/cvsroot/elephant/src/elephant/unicode2.lisp 2007/01/16 00:51:25 NONE +++ /project/elephant/cvsroot/elephant/src/elephant/unicode2.lisp 2007/01/16 00:51:25 1.1 [980 lines skipped]

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

elephant-cvs January 2007