Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv1238/src/elephant

Modified Files: classes.lisp classindex.lisp controller.lisp metaclasses.lisp migrate.lisp package.lisp serializer.lisp serializer1.lisp serializer2.lisp Log Message: Tweaks for lispworks compatability

--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/02/24 14:51:59 1.16 +++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/02/26 19:12:18 1.17 @@ -33,7 +33,7 @@ (if from-oid (setf (oid instance) from-oid) (setf (oid instance) (next-oid sc))) - (setf (:dbcn-spc-pst instance) (controller-spec sc)) + (setf (dbcn-spc-pst instance) (controller-spec sc)) (cache-instance sc instance))

(defclass persistent-object (persistent) () --- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/02/25 03:37:37 1.25 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/02/26 19:12:18 1.26 @@ -99,7 +99,7 @@ btree))

(define-condition persistent-class-not-indexed (error) - ((class-obj :initarg :class :initarg nil :reader :unindexed-class-obj))) + ((class-obj :initarg :class :initarg nil :reader unindexed-class-obj)))

(defun cache-new-class-index (class sc) "If not cached or persistent then this is a new class, make the new index" --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/02/25 09:12:47 1.38 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/02/26 19:12:18 1.39 @@ -47,7 +47,7 @@ we re-open the controller from the spec if it's not cached? That might be dangerous so for now we error" (declare (ignore sc)) - (let ((con (gethash (:dbcn-spc-pst instance) *dbconnection-spec*))) + (let ((con (gethash (dbcn-spc-pst instance) *dbconnection-spec*))) (cond ((not con) ;; ISE NOTE: Create a new one here & warn instead? ;; (get-controller spec) --- /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp 2007/02/14 04:36:10 1.8 +++ /project/elephant/cvsroot/elephant/src/elephant/metaclasses.lisp 2007/02/26 19:12:18 1.9 @@ -24,7 +24,7 @@

(defclass persistent () ((%oid :accessor oid :initarg :from-oid) - (dbonnection-spec-pst :type (or list string) :accessor :dbcn-spc-pst :initarg :dbconnection-spec-pst)) + (dbonnection-spec-pst :type (or list string) :accessor dbcn-spc-pst :initarg :dbconnection-spec-pst)) (:documentation "Abstract superclass for all persistent classes (common to user-defined classes and collections.)"))

@@ -239,7 +239,8 @@ '(:instance :class :database))

(defmethod slot-definition-allocation ((slot-definition persistent-slot-definition)) - :database) + #-lispworks :database + #+lispworks nil)

(defmethod direct-slot-definition-class ((class persistent-metaclass) &rest initargs) "Checks for the transient tag (and the allocation type) --- /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp 2007/02/24 14:51:59 1.8 +++ /project/elephant/cvsroot/elephant/src/elephant/migrate.lisp 2007/02/26 19:12:18 1.9 @@ -117,7 +117,7 @@ (unless (object-was-copied-p src) (typecase src (store-controller (assert (not (equal dst-spec (controller-spec src))))) - (persistent (assert (not (equal dst-spec (:dbcn-spc-pst src))))))))) + (persistent (assert (not (equal dst-spec (dbcn-spc-pst src)))))))))

;; WHOLE STORE MIGRATION

@@ -225,7 +225,7 @@ (gethash (oid src) *migrate-copied-oids*)))

(defun register-copied-object (src dst) - (assert (not (equal (:dbcn-spc-pst src) (:dbcn-spc-pst dst)))) + (assert (not (equal (dbcn-spc-pst src) (dbcn-spc-pst dst)))) (setf (gethash (oid src) *migrate-copied-oids*) dst))

(defun retrieve-copied-object (src) @@ -245,7 +245,7 @@ (defun inhibit-indexed-slot-copy? (sc class) (and (indexed class) (not (equal (controller-spec sc) - (:dbcn-spc-pst (%index-cache class)))))) + (dbcn-spc-pst (%index-cache class))))))

(defun copy-persistent-slots (dstsc class src dst) "Copy only persistent slots from src to dst" --- /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/02/25 20:02:32 1.20 +++ /project/elephant/cvsroot/elephant/src/elephant/package.lisp 2007/02/26 19:12:18 1.21 @@ -21,7 +21,7 @@

(defpackage elephant (:use :common-lisp :elephant-memutil :elephant-utils) - (:nicknames ele :ele) + (:nicknames :ele) (:documentation "Elephant: an object-oriented database for Common Lisp with multiple backends for Berkeley DB, SQL and others.") @@ -275,6 +275,7 @@ %slot-definition-type) #+lispworks (:import-from :clos + class-finalized-p compute-class-precedence-list validate-superclass ensure-class-using-class --- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2007/02/25 09:12:47 1.23 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2007/02/26 19:12:18 1.24 @@ -259,10 +259,10 @@ "Shared byte-spec peformance hack; not thread safe so removed from use for serializer2" (declare (type (unsigned-byte 24) position)) - #+(or cmu sbcl allegro) - (progn (setf (cdr *resourced-byte-spec*) (* 32 position)) - *resourced-byte-spec*) - #-(or cmu sbcl allegro) +;; #+(or cmu sbcl allegro) +;; (progn (setf (cdr *resourced-byte-spec*) (* 32 position)) +;; *resourced-byte-spec*) +;; #-(or cmu sbcl allegro) (byte 32 (* 32 position)) )

--- /project/elephant/cvsroot/elephant/src/elephant/serializer1.lisp 2007/02/22 20:19:57 1.11 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer1.lisp 2007/02/26 19:12:18 1.12 @@ -488,7 +488,7 @@ (type boolean positive)) (loop for i from 0 below (/ length 4) for byte-spec = (int-byte-spec i) - with num integer = 0 + with num of-type integer = 0 do (setq num (dpb (buffer-read-uint bs) byte-spec num)) finally (return (if positive num (- num))))) --- /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/25 03:40:19 1.29 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer2.lisp 2007/02/26 19:12:18 1.30 @@ -550,7 +550,7 @@ for byte-spec = ;; #+(or allegro) (progn (setf (cdr int-byte-spec) (* 32 i)) int-byte-spec) #+(or allegro sbcl cmu lispworks openmcl) (byte 32 (* 32 i)) - with num integer = 0 + with num of-type integer = 0 do (setq num (dpb (buffer-read-uint bs) byte-spec num)) finally