[elephant-cvs] CVS elephant/src/elephant

ieslick ieslick at common-lisp.net
Mon Feb 26 19:12:19 UTC 2007


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 




More information about the Elephant-cvs mailing list