diff --git a/pcl/methods.lisp b/pcl/methods.lisp index 19680a93b5fb49f6da5d71b545c186e21e6d8318..3021b1a820ceecd7a32fc4e7cbe8ec0a8f7d8e61 100644 --- a/pcl/methods.lisp +++ b/pcl/methods.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.19 2002/12/18 00:57:05 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/methods.lisp,v 1.20 2002/12/18 16:29:06 pmai Exp $") ;;; (in-package :pcl) @@ -67,12 +67,6 @@ ;;; ;;; ;;; -(defmethod shared-initialize :after ((slotd standard-slot-definition) slot-names &key) - (declare (ignore slot-names)) - (with-slots (allocation class) - slotd - (setq allocation (if (eq allocation :class) class allocation)))) - (defmethod shared-initialize :after ((slotd structure-slot-definition) slot-names &key (allocation :instance)) (declare (ignore slot-names)) diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp index 6c8b5994dd793909c5a4c08d31e9044d119cfdc1..8422f661b748010850cf8222937aba812ff17078 100644 --- a/pcl/std-class.lisp +++ b/pcl/std-class.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.37 2002/10/29 16:20:45 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.38 2002/12/18 16:29:06 pmai Exp $") ;;; (in-package :pcl) @@ -475,7 +475,7 @@ (setf (plist-value class 'class-slot-cells) (let ((collected ())) (dolist (dslotd direct-slots (nreverse collected)) - (when (eq (slot-definition-allocation dslotd) class) + (when (eq (slot-definition-allocation dslotd) :class) (let ((initfunction (slot-definition-initfunction dslotd))) (push (cons (slot-definition-name dslotd) (if initfunction @@ -703,9 +703,9 @@ (let ((instance-slots ()) (class-slots ())) (dolist (eslotd eslotds) - (let ((alloc (slot-definition-allocation eslotd))) - (cond ((eq alloc :instance) (push eslotd instance-slots)) - ((classp alloc) (push eslotd class-slots))))) + (ecase (slot-definition-allocation eslotd) + (:instance (push eslotd instance-slots)) + (:class (push eslotd class-slots)))) ;; ;; If there is a change in the shape of the instances then the ;; old class is now obsolete. @@ -748,8 +748,8 @@ (defun compute-class-slots (eslotds) (loop for eslotd in eslotds for name = (slot-definition-name eslotd) - and allocation = (slot-definition-allocation eslotd) - collect (assoc name (class-slot-cells allocation)))) + and class = (slot-definition-class eslotd) + collect (assoc name (class-slot-cells class)))) (defun compute-layout (cpl instance-eslotds) (let* ((names (loop for eslotd in instance-eslotds @@ -851,9 +851,9 @@ (instance-slots ()) (class-slots ())) (dolist (eslotd eslotds) - (let ((alloc (slot-definition-allocation eslotd))) - (cond ((eq alloc :instance) (push eslotd instance-slots)) - ((classp alloc) (push eslotd class-slots))))) + (ecase (slot-definition-allocation eslotd) + (:instance (push eslotd instance-slots)) + (:class (push eslotd class-slots)))) (let ((nlayout (compute-layout cpl instance-slots))) (dolist (eslotd instance-slots) (setf (slot-definition-location eslotd) @@ -861,7 +861,7 @@ (dolist (eslotd class-slots) (setf (slot-definition-location eslotd) (assoc (slot-definition-name eslotd) - (class-slot-cells (slot-definition-allocation eslotd))))) + (class-slot-cells (slot-definition-class eslotd))))) (mapc #'initialize-internal-slot-functions eslotds) eslotds)) diff --git a/pcl/vector.lisp b/pcl/vector.lisp index 9f26256c748ee725f669020993c74545b8beb028..8238fd8c7c66a45052857886dd6031b52a41b547 100644 --- a/pcl/vector.lisp +++ b/pcl/vector.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/vector.lisp,v 1.25 2002/12/18 00:57:05 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/vector.lisp,v 1.26 2002/12/18 16:29:07 pmai Exp $") ;;; ;;; Permutation vectors. ;;; @@ -639,7 +639,7 @@ (standard-class-p class) (not (eq class *the-class-t*)) ; shouldn't happen, though. (let ((slotd (find-slot-definition class slot-name))) - (and slotd (classp (slot-definition-allocation slotd))))))) + (and slotd (eq :class (slot-definition-allocation slotd))))))) (defun skip-fast-slot-access-p (class-form slot-name-form type) (let ((class (and (constantp class-form) (eval class-form)))