Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv18095/src/elephant
Modified Files: classes.lisp serializer.lisp Log Message: Fixes for Win32 allegro build; lispwork builds but fails to run; new test of :index class keyword which fails
--- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/02/26 19:55:12 1.18 +++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/03/03 17:24:59 1.19 @@ -49,26 +49,18 @@
(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)))) + (let ((result (apply #'call-next-method class name (remove-keywords '(:index) 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)))) + (let ((result (apply #'call-next-method class name (remove-keywords '(:index) 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)) --- /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2007/02/26 19:12:18 1.24 +++ /project/elephant/cvsroot/elephant/src/elephant/serializer.lisp 2007/03/03 17:24:59 1.25 @@ -259,10 +259,5 @@ "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) - (byte 32 (* 32 position)) - ) + (byte 32 (* 32 position)))