X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fbraid.lisp;h=ae39f214aaba88404baf9c8a968db035e18cd291;hb=3fbcd9b98c58d80858d1e0f9834aaaa83283cbba;hp=fd3f49a85f5ed730f1e1dfb561ec60caa4095658;hpb=119d1c157e519573074720b7897a9fa918329ac5;p=sbcl.git

diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp
index fd3f49a..ae39f21 100644
--- a/src/pcl/braid.lisp
+++ b/src/pcl/braid.lisp
@@ -219,6 +219,8 @@
                      name class slots
                      standard-effective-slot-definition-wrapper t))
 
+              (setf (layout-slot-table wrapper) (make-slot-table class slots t))
+
               (case meta
                 ((standard-class funcallable-standard-class)
                  (!bootstrap-initialize-class
@@ -310,7 +312,10 @@
                                  slot-class))
       (set-slot 'direct-slots direct-slots)
       (set-slot 'slots slots)
-      (setf (layout-slot-table wrapper) (make-slot-table class slots)))
+      (setf (layout-slot-table wrapper)
+            (make-slot-table class slots
+                             (member metaclass-name
+                                     '(standard-class funcallable-standard-class)))))
 
     ;; For all direct superclasses SUPER of CLASS, make sure CLASS is
     ;; a direct subclass of SUPER.  Note that METACLASS-NAME doesn't
@@ -667,24 +672,24 @@
 (!bootstrap-class-predicates nil)
 (!bootstrap-built-in-classes)
 
-(dohash (name x *find-class*)
-        (let* ((class (find-class-from-cell name x))
-               (layout (class-wrapper class))
-               (lclass (layout-classoid layout))
-               (lclass-pcl-class (classoid-pcl-class lclass))
-               (olclass (find-classoid name nil)))
-          (if lclass-pcl-class
-              (aver (eq class lclass-pcl-class))
-              (setf (classoid-pcl-class lclass) class))
+(dohash ((name x) *find-class*)
+  (let* ((class (find-class-from-cell name x))
+         (layout (class-wrapper class))
+         (lclass (layout-classoid layout))
+         (lclass-pcl-class (classoid-pcl-class lclass))
+         (olclass (find-classoid name nil)))
+    (if lclass-pcl-class
+        (aver (eq class lclass-pcl-class))
+        (setf (classoid-pcl-class lclass) class))
 
-          (update-lisp-class-layout class layout)
+    (update-lisp-class-layout class layout)
 
-          (cond (olclass
-                 (aver (eq lclass olclass)))
-                (t
-                 (setf (find-classoid name) lclass)))
+    (cond (olclass
+           (aver (eq lclass olclass)))
+          (t
+           (setf (find-classoid name) lclass)))
 
-          (set-class-type-translation class name)))
+    (set-class-type-translation class name)))
 
 (setq *boot-state* 'braid)
 
@@ -706,11 +711,18 @@
 ;;; :BEFORE method, it would seem that going through
 ;;; NO-APPLICABLE-METHOD is prohibited, as in fact there is an
 ;;; applicable method.  -- CSR, 2002-11-15
+(define-condition no-primary-method (reference-condition error)
+  ((generic-function :initarg :generic-function :reader no-primary-method-generic-function)
+   (args :initarg :args :reader no-primary-method-args))
+  (:report
+   (lambda (c s)
+     (format s "~@<There is no primary method for the generic function ~2I~_~S~
+                ~I~_when called with arguments ~2I~_~S.~:>"
+             (no-primary-method-generic-function c)
+             (no-primary-method-args c))))
+  (:default-initargs :references (list '(:ansi-cl :section (7 6 6 2)))))
 (defmethod no-primary-method (generic-function &rest args)
-  (error "~@<There is no primary method for the generic function ~2I~_~S~
-          ~I~_when called with arguments ~2I~_~S.~:>"
-         generic-function
-         args))
+  (error 'no-primary-method :generic-function generic-function :args args))
 
 (defmethod invalid-qualifiers ((gf generic-function)
                                combin