0.6.10.19:

[sbcl.git] / src / pcl / slots-boot.lisp

diff --git a/src/pcl/slots-boot.lisp b/src/pcl/slots-boot.lisp
index 3def80a..4129a81 100644 (file)
--- a/src/pcl/slots-boot.lisp
+++ b/src/pcl/slots-boot.lisp
@@ -22,9 +22,6 @@
 ;;;; specification.
 
 (in-package "SB-PCL")
-
-(sb-int:file-comment
-  "$Header$")
 \f
 (defmacro slot-symbol (slot-name type)
   `(if (and (symbolp ,slot-name) (symbol-package ,slot-name))
@@ -87,7 +84,10 @@
        `(let ,bindings ,form)
        form)))
 
-(defconstant *optimize-slot-boundp* nil)
+;;; FIXME: Why is this defined in two different places? And what does
+;;; it mean anyway? And can we just eliminate it completely (replacing
+;;; it with NIL, then hand-eliminating any resulting dead code)?
+(defconstant +optimize-slot-boundp+ nil)
 
 (defmacro accessor-slot-boundp (object slot-name)
   (unless (constantp slot-name)
@@ -95,7 +95,7 @@
           'accessor-slot-boundp))
   (let* ((slot-name (eval slot-name))
         (sym (slot-boundp-symbol slot-name)))
-    (if (not *optimize-slot-boundp*)
+    (if (not +optimize-slot-boundp+)
        `(slot-boundp-normal ,object ',slot-name)
        `(asv-funcall ,sym ,slot-name boundp ,object))))
 
@@ -106,7 +106,7 @@
 (defun make-structure-slot-boundp-function (slotd)
   (let* ((reader (slot-definition-internal-reader-function slotd))
         (fun #'(lambda (object)
-                 (not (eq (funcall reader object) *slot-unbound*)))))
+                 (not (eq (funcall reader object) +slot-unbound+)))))
     (declare (type function reader))
     fun))
 
@@ -141,18 +141,18 @@
    (etypecase index
      (fixnum (if fsc-p
                 #'(lambda (instance)
-                    (let ((value (%instance-ref (fsc-instance-slots instance) index)))
-                      (if (eq value *slot-unbound*)
+                    (let ((value (instance-ref (fsc-instance-slots instance) index)))
+                      (if (eq value +slot-unbound+)
                           (slot-unbound (class-of instance) instance slot-name)
                           value)))
                 #'(lambda (instance)
-                    (let ((value (%instance-ref (std-instance-slots instance) index)))
-                      (if (eq value *slot-unbound*)
+                    (let ((value (instance-ref (std-instance-slots instance) index)))
+                      (if (eq value +slot-unbound+)
                           (slot-unbound (class-of instance) instance slot-name)
                           value)))))
      (cons   #'(lambda (instance)
                 (let ((value (cdr index)))
-                  (if (eq value *slot-unbound*)
+                  (if (eq value +slot-unbound+)
                       (slot-unbound (class-of instance) instance slot-name)
                       value)))))
    `(reader ,slot-name)))
@@ -163,9 +163,9 @@
    (etypecase index
      (fixnum (if fsc-p
                 #'(lambda (nv instance)
-                    (setf (%instance-ref (fsc-instance-slots instance) index) nv))
+                    (setf (instance-ref (fsc-instance-slots instance) index) nv))
                 #'(lambda (nv instance)
-                    (setf (%instance-ref (std-instance-slots instance) index) nv))))
+                    (setf (instance-ref (std-instance-slots instance) index) nv))))
      (cons   #'(lambda (nv instance)
                 (declare (ignore instance))
                 (setf (cdr index) nv))))
@@ -177,23 +177,23 @@
    (etypecase index
      (fixnum (if fsc-p
                 #'(lambda (instance)
-                    (not (eq (%instance-ref (fsc-instance-slots instance)
+                    (not (eq (instance-ref (fsc-instance-slots instance)
                                             index)
-                             *slot-unbound*)))
+                             +slot-unbound+)))
                 #'(lambda (instance)
-                    (not (eq (%instance-ref (std-instance-slots instance)
+                    (not (eq (instance-ref (std-instance-slots instance)
                                             index)
-                             *slot-unbound*)))))
+                             +slot-unbound+)))))
      (cons   #'(lambda (instance)
                 (declare (ignore instance))
-                (not (eq (cdr index) *slot-unbound*)))))
+                (not (eq (cdr index) +slot-unbound+)))))
    `(boundp ,slot-name)))
 
 (defun make-optimized-structure-slot-value-using-class-method-function (function)
   (declare (type function function))
   #'(lambda (class object slotd)
       (let ((value (funcall function object)))
-       (if (eq value *slot-unbound*)
+       (if (eq value +slot-unbound+)
            (slot-unbound class object (slot-definition-name slotd))
            value))))
 
@@ -207,7 +207,7 @@
   (declare (type function function))
   #'(lambda (class object slotd)
       (declare (ignore class slotd))
-      (not (eq (funcall function object) *slot-unbound*))))
+      (not (eq (funcall function object) +slot-unbound+))))
 
 (defun get-optimized-std-slot-value-using-class-method-function (class slotd name)
   (if (structure-class-p class)
@@ -242,21 +242,21 @@
                #'(lambda (class instance slotd)
                    (declare (ignore slotd))
                    (unless (fsc-instance-p instance) (error "not fsc"))
-                   (let ((value (%instance-ref (fsc-instance-slots instance) index)))
-                     (if (eq value *slot-unbound*)
+                   (let ((value (instance-ref (fsc-instance-slots instance) index)))
+                     (if (eq value +slot-unbound+)
                          (slot-unbound class instance slot-name)
                          value)))
                #'(lambda (class instance slotd)
                    (declare (ignore slotd))
                    (unless (std-instance-p instance) (error "not std"))
-                   (let ((value (%instance-ref (std-instance-slots instance) index)))
-                     (if (eq value *slot-unbound*)
+                   (let ((value (instance-ref (std-instance-slots instance) index)))
+                     (if (eq value +slot-unbound+)
                          (slot-unbound class instance slot-name)
                          value)))))
     (cons   #'(lambda (class instance slotd)
                (declare (ignore slotd))
                (let ((value (cdr index)))
-                 (if (eq value *slot-unbound*)
+                 (if (eq value +slot-unbound+)
                      (slot-unbound class instance slot-name)
                      value))))))
 
@@ -268,10 +268,10 @@
     (fixnum (if fsc-p
                #'(lambda (nv class instance slotd)
                    (declare (ignore class slotd))
-                   (setf (%instance-ref (fsc-instance-slots instance) index) nv))
+                   (setf (instance-ref (fsc-instance-slots instance) index) nv))
                #'(lambda (nv class instance slotd)
                    (declare (ignore class slotd))
-                   (setf (%instance-ref (std-instance-slots instance) index) nv))))
+                   (setf (instance-ref (std-instance-slots instance) index) nv))))
     (cons   #'(lambda (nv class instance slotd)
                (declare (ignore class instance slotd))
                (setf (cdr index) nv)))))
@@ -284,17 +284,17 @@
     (fixnum (if fsc-p
                #'(lambda (class instance slotd)
                    (declare (ignore class slotd))
-                   (not (eq (%instance-ref (fsc-instance-slots instance)
+                   (not (eq (instance-ref (fsc-instance-slots instance)
                                            index)
-                            *slot-unbound* )))
+                            +slot-unbound+ )))
                #'(lambda (class instance slotd)
                    (declare (ignore class slotd))
-                   (not (eq (%instance-ref (std-instance-slots instance)
+                   (not (eq (instance-ref (std-instance-slots instance)
                                            index)
-                            *slot-unbound* )))))
+                            +slot-unbound+ )))))
     (cons   #'(lambda (class instance slotd)
                (declare (ignore class instance slotd))
-               (not (eq (cdr index) *slot-unbound*))))))
+               (not (eq (cdr index) +slot-unbound+))))))
 
 (defun get-accessor-from-svuc-method-function (class slotd sdfun name)
   (macrolet ((emf-funcall (emf &rest args)
@@ -317,13 +317,13 @@
                                    (assq slot-name (wrapper-class-slots wrapper)))))
                    (typecase index
                      (fixnum   
-                      (let ((value (%instance-ref (get-slots instance) index)))
-                        (if (eq value *slot-unbound*)
+                      (let ((value (instance-ref (get-slots instance) index)))
+                        (if (eq value +slot-unbound+)
                             (slot-unbound (class-of instance) instance slot-name)
                             value)))
                      (cons
                       (let ((value (cdr index)))
-                        (if (eq value *slot-unbound*)
+                        (if (eq value +slot-unbound+)
                             (slot-unbound (class-of instance) instance slot-name)
                             value)))
                      (t
@@ -393,7 +393,7 @@
           (gf (ensure-generic-function name)))
       (unless (generic-function-methods gf)
        (add-writer-method *the-class-slot-object* gf slot-name))))
-  (when (and *optimize-slot-boundp*
+  (when (and +optimize-slot-boundp+
             (or (null type) (eq type 'boundp)))
     (let* ((name (slot-boundp-symbol slot-name))
           (gf (ensure-generic-function name)))