1.0.4.85: small PCL cleanups and thread-safety notes

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

diff --git a/src/pcl/dlisp2.lisp b/src/pcl/dlisp2.lisp
index 7186fc3..538c781 100644 (file)
--- a/src/pcl/dlisp2.lisp
+++ b/src/pcl/dlisp2.lisp
@@ -22,24 +22,35 @@
 ;;;; specification.
 
 (in-package "SB-PCL")
+
+;;;; The whole of this file is dead code as long as *optimize-cache-functions-p*
+;;;; is true, which it currently _always_ is.
+
 \f
 (defun emit-reader/writer-function (reader/writer 1-or-2-class class-slot-p)
   (values
    (ecase reader/writer
      (:reader (ecase 1-or-2-class
-               (1 (if class-slot-p
-                      (emit-reader/writer-macro :reader 1 t)
-                      (emit-reader/writer-macro :reader 1 nil)))
-               (2 (if class-slot-p
-                      (emit-reader/writer-macro :reader 2 t)
-                      (emit-reader/writer-macro :reader 2 nil)))))
+                (1 (if class-slot-p
+                       (emit-reader/writer-macro :reader 1 t)
+                       (emit-reader/writer-macro :reader 1 nil)))
+                (2 (if class-slot-p
+                       (emit-reader/writer-macro :reader 2 t)
+                       (emit-reader/writer-macro :reader 2 nil)))))
      (:writer (ecase 1-or-2-class
-               (1 (if class-slot-p
-                      (emit-reader/writer-macro :writer 1 t)
-                      (emit-reader/writer-macro :writer 1 nil)))
-               (2 (if class-slot-p
-                      (emit-reader/writer-macro :writer 2 t)
-                      (emit-reader/writer-macro :writer 2 nil))))))
+                (1 (if class-slot-p
+                       (emit-reader/writer-macro :writer 1 t)
+                       (emit-reader/writer-macro :writer 1 nil)))
+                (2 (if class-slot-p
+                       (emit-reader/writer-macro :writer 2 t)
+                       (emit-reader/writer-macro :writer 2 nil)))))
+     (:boundp (ecase 1-or-2-class
+                (1 (if class-slot-p
+                       (emit-reader/writer-macro :boundp 1 t)
+                       (emit-reader/writer-macro :boundp 1 nil)))
+                (2 (if class-slot-p
+                       (emit-reader/writer-macro :boundp 2 t)
+                       (emit-reader/writer-macro :boundp 2 nil))))))
    nil))
 
 (defun emit-one-or-n-index-reader/writer-function
@@ -47,25 +58,32 @@
   (values
    (ecase reader/writer
      (:reader (if cached-index-p
-                 (if class-slot-p
-                     (emit-one-or-n-index-reader/writer-macro :reader t t)
-                     (emit-one-or-n-index-reader/writer-macro :reader t nil))
-                 (if class-slot-p
-                     (emit-one-or-n-index-reader/writer-macro :reader nil t)
-                     (emit-one-or-n-index-reader/writer-macro :reader nil nil))))
+                  (if class-slot-p
+                      (emit-one-or-n-index-reader/writer-macro :reader t t)
+                      (emit-one-or-n-index-reader/writer-macro :reader t nil))
+                  (if class-slot-p
+                      (emit-one-or-n-index-reader/writer-macro :reader nil t)
+                      (emit-one-or-n-index-reader/writer-macro :reader nil nil))))
      (:writer (if cached-index-p
-                 (if class-slot-p
-                     (emit-one-or-n-index-reader/writer-macro :writer t t)
-                     (emit-one-or-n-index-reader/writer-macro :writer t nil))
-                 (if class-slot-p
-                     (emit-one-or-n-index-reader/writer-macro :writer nil t)
-                     (emit-one-or-n-index-reader/writer-macro :writer nil nil)))))
+                  (if class-slot-p
+                      (emit-one-or-n-index-reader/writer-macro :writer t t)
+                      (emit-one-or-n-index-reader/writer-macro :writer t nil))
+                  (if class-slot-p
+                      (emit-one-or-n-index-reader/writer-macro :writer nil t)
+                      (emit-one-or-n-index-reader/writer-macro :writer nil nil))))
+     (:boundp (if cached-index-p
+                  (if class-slot-p
+                      (emit-one-or-n-index-reader/writer-macro :boundp t t)
+                      (emit-one-or-n-index-reader/writer-macro :boundp t nil))
+                  (if class-slot-p
+                      (emit-one-or-n-index-reader/writer-macro :boundp nil t)
+                      (emit-one-or-n-index-reader/writer-macro :boundp nil nil)))))
    nil))
 
 (defun emit-checking-or-caching-function (cached-emf-p return-value-p metatypes applyp)
   (values (emit-checking-or-caching-function-preliminary
-          cached-emf-p return-value-p metatypes applyp)
-         t))
+           cached-emf-p return-value-p metatypes applyp)
+          t))
 
 (defvar *not-in-cache* (make-symbol "not in cache"))
 
@@ -74,41 +92,41 @@
   (declare (ignore applyp))
   (if cached-emf-p
       (lambda (cache miss-fn)
-       (declare (type function miss-fn))
-       #'(sb-kernel:instance-lambda (&rest args)
+        (declare (type function miss-fn))
+        #'(lambda (&rest args)
             (declare #.*optimize-speed*)
-           (with-dfun-wrappers (args metatypes)
-             (dfun-wrappers invalid-wrapper-p)
-             (apply miss-fn args)
-             (if invalid-wrapper-p
-                 (apply miss-fn args)
-                 (let ((emf (probe-cache cache dfun-wrappers *not-in-cache*)))
-                   (if (eq emf *not-in-cache*)
-                       (apply miss-fn args)
-                       (if return-value-p
-                           emf
-                           (invoke-emf emf args))))))))
+            (with-dfun-wrappers (args metatypes)
+              (dfun-wrappers invalid-wrapper-p)
+              (apply miss-fn args)
+              (if invalid-wrapper-p
+                  (apply miss-fn args)
+                  (let ((emf (probe-cache cache dfun-wrappers *not-in-cache*)))
+                    (if (eq emf *not-in-cache*)
+                        (apply miss-fn args)
+                        (if return-value-p
+                            emf
+                            (invoke-emf emf args))))))))
       (lambda (cache emf miss-fn)
-       (declare (type function miss-fn))
-       #'(sb-kernel:instance-lambda (&rest args)
-           (declare #.*optimize-speed*)
-           (with-dfun-wrappers (args metatypes)
-             (dfun-wrappers invalid-wrapper-p)
-             (apply miss-fn args)
-             (if invalid-wrapper-p
-                 (apply miss-fn args)
-                 (let ((found-p (not (eq *not-in-cache*
-                                         (probe-cache cache dfun-wrappers
-                                                      *not-in-cache*)))))
-                   (if found-p
-                       (invoke-emf emf args)
-                       (if return-value-p
-                           t
-                           (apply miss-fn args))))))))))
+        (declare (type function miss-fn))
+        #'(lambda (&rest args)
+            (declare #.*optimize-speed*)
+            (with-dfun-wrappers (args metatypes)
+              (dfun-wrappers invalid-wrapper-p)
+              (apply miss-fn args)
+              (if invalid-wrapper-p
+                  (apply miss-fn args)
+                  (let ((found-p (not (eq *not-in-cache*
+                                          (probe-cache cache dfun-wrappers
+                                                       *not-in-cache*)))))
+                    (if found-p
+                        (invoke-emf emf args)
+                        (if return-value-p
+                            t
+                            (apply miss-fn args))))))))))
 
 (defun emit-default-only-function (metatypes applyp)
   (declare (ignore metatypes applyp))
   (values (lambda (emf)
-           (lambda (&rest args)
-             (invoke-emf emf args)))
-         t))
+            (lambda (&rest args)
+              (invoke-emf emf args)))
+          t))