0.6.12.4:

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

diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp
index 49641bc..627b660 100644 (file)
--- a/src/pcl/cache.lisp
+++ b/src/pcl/cache.lisp
@@ -271,7 +271,8 @@
                      ;; default here. -- WHN 19991204
                      (invalid nil))
            (:conc-name %wrapper-)
-           (:constructor make-wrapper-internal))
+           (:constructor make-wrapper-internal)
+           (:copier nil))
   (instance-slots-layout nil :type list)
   (class-slots nil :type list))
 #-sb-fluid (declaim (sb-ext:freeze-type wrapper))
@@ -334,9 +335,9 @@
      (found
       (unless (sb-kernel:class-pcl-class found)
        (setf (sb-kernel:class-pcl-class found) class))
-      (assert (eq (sb-kernel:class-pcl-class found) class))
+      (aver (eq (sb-kernel:class-pcl-class found) class))
       (let ((layout (sb-kernel:class-layout found)))
-       (assert layout)
+       (aver layout)
        layout))
      (t
       (make-wrapper-internal
@@ -369,7 +370,7 @@
                     (let ((found (cl:find-class (slot-value class 'name))))
                       (unless (sb-kernel:class-pcl-class found)
                         (setf (sb-kernel:class-pcl-class found) class))
-                      (assert (eq (sb-kernel:class-pcl-class found) class))
+                      (aver (eq (sb-kernel:class-pcl-class found) class))
                       found))
                    (t
                     (sb-kernel:make-standard-class :pcl-class class))))
@@ -380,8 +381,8 @@
           (layout (sb-kernel:class-layout found)))
       (unless (sb-kernel:class-pcl-class found)
        (setf (sb-kernel:class-pcl-class found) class))
-      (assert (eq (sb-kernel:class-pcl-class found) class))
-      (assert layout)
+      (aver (eq (sb-kernel:class-pcl-class found) class))
+      (aver layout)
       layout))))
 
 ;;; FIXME: The immediately following macros could become inline functions.
@@ -578,7 +579,7 @@
        (values (logxor (the fixnum (1- cache-size)) (the fixnum (1- line-size)))
                cache-size
                line-size
-               (the fixnum (floor cache-size line-size))))
+               (the (values fixnum t) (floor cache-size line-size))))
       (let* ((line-size (power-of-two-ceiling (if valuep (1+ nkeys) nkeys)))
             (cache-size (if (typep nlines-or-cache-vector 'fixnum)
                             (the fixnum
@@ -591,7 +592,7 @@
        (values (logxor (the fixnum (1- cache-size)) (the fixnum (1- line-size)))
                (the fixnum (1+ cache-size))
                line-size
-               (the fixnum (floor cache-size line-size))))))
+               (the (values fixnum t) (floor cache-size line-size))))))
 \f
 ;;; the various implementations of computing a primary cache location from
 ;;; wrappers. Because some implementations of this must run fast there are
@@ -603,8 +604,6 @@
 ;;;  ENSURING  that the result is a fixnum
 ;;;  MASK      the result against the mask argument.
 
-;;; COMPUTE-PRIMARY-CACHE-LOCATION
-;;;
 ;;; The basic functional version. This is used by the cache miss code to
 ;;; compute the primary location of an entry.
 (defun compute-primary-cache-location (field mask wrappers)
@@ -633,8 +632,6 @@
          (incf i))
        (the fixnum (1+ (logand mask location))))))
 
-;;; COMPUTE-PRIMARY-CACHE-LOCATION-FROM-LOCATION
-;;;
 ;;; This version is called on a cache line. It fetches the wrappers
 ;;; from the cache line and determines the primary location. Various
 ;;; parts of the cache filling code call this to determine whether it