X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fstd-class.lisp;h=04cdc989b16fdaf080012ac7a2cf82daed2eedaf;hb=6d3a964ae6d89003fc056d9cfa8afe31fd63514f;hp=fcb86c1e919086ed48e715185e30f777c01bd784;hpb=157e21959c8023f146d6b03206aea6daa60e7b0d;p=sbcl.git diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp index fcb86c1..04cdc98 100644 --- a/src/pcl/std-class.lisp +++ b/src/pcl/std-class.lisp @@ -535,8 +535,8 @@ (setq cpl-available-p t) (add-direct-subclasses class direct-superclasses) (let ((slots (compute-slots class))) - (setf (slot-value class 'slots) slots - (slot-value class 'slot-vector) (make-slot-vector class slots))))) + (setf (slot-value class 'slots) slots) + (setf (layout-slot-table wrapper) (make-slot-table class slots))))) ;; Comment from Gerd's PCL, 2003-05-15: ;; ;; We don't ADD-SLOT-ACCESSORS here because we don't want to @@ -717,11 +717,12 @@ (compute-class-precedence-list class)) (setf (slot-value class 'cpl-available-p) t) (let ((slots (compute-slots class))) - (setf (slot-value class 'slots) slots - (slot-value class 'slot-vector) (make-slot-vector class slots))) - (let ((lclass (find-classoid (class-name class)))) - (setf (classoid-pcl-class lclass) class) - (setf (slot-value class 'wrapper) (classoid-layout lclass))) + (setf (slot-value class 'slots) slots) + (let* ((lclass (find-classoid (class-name class))) + (layout (classoid-layout lclass))) + (setf (classoid-pcl-class lclass) class) + (setf (slot-value class 'wrapper) layout) + (setf (layout-slot-table layout) (make-slot-table class slots)))) (setf (slot-value class 'finalized-p) t) (update-pv-table-cache-info class) (add-slot-accessors class direct-slots))) @@ -895,7 +896,7 @@ (update-lisp-class-layout class nwrapper) (setf (slot-value class 'slots) eslotds - (slot-value class 'slot-vector) (make-slot-vector class eslotds) + (layout-slot-table nwrapper) (make-slot-table class eslotds) (wrapper-instance-slots-layout nwrapper) nlayout (wrapper-class-slots nwrapper) nwrapper-class-slots (layout-length nwrapper) nslots @@ -1278,6 +1279,8 @@ (wrapper-instance-slots-layout owrapper)) (setf (wrapper-class-slots nwrapper) (wrapper-class-slots owrapper)) + (setf (wrapper-slot-table nwrapper) + (wrapper-slot-table owrapper)) (with-pcl-lock (update-lisp-class-layout class nwrapper) (setf (slot-value class 'wrapper) nwrapper) @@ -1557,11 +1560,6 @@ (def class-direct-default-initargs) (def class-default-initargs)) -(defmethod class-slot-vector (class) - ;; Default method to cause FIND-SLOT-DEFINITION return NIL for all - ;; non SLOT-CLASS classes. - #(nil)) - (defmethod validate-superclass ((c class) (s built-in-class)) (or (eq s *the-class-t*) (eq s *the-class-stream*) ;; FIXME: bad things happen if someone tries to mix in both