1.0.11.22: hash-table synchronization support

[sbcl.git] / src / pcl / braid.lisp

diff --git a/src/pcl/braid.lisp b/src/pcl/braid.lisp
index 2e0f11a..ae39f21 100644 (file)
--- a/src/pcl/braid.lisp
+++ b/src/pcl/braid.lisp
@@ -672,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))
-
-          (update-lisp-class-layout class layout)
-
-          (cond (olclass
-                 (aver (eq lclass olclass)))
-                (t
-                 (setf (find-classoid name) lclass)))
+(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)
+
+    (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)
 
@@ -711,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