[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