X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fcache.lisp;h=f8f0f354095e0efe8eeb99cc45e853de167338b2;hb=5ec8d0c1c8b7939818b75118b472fac1af554f9a;hp=b41ab589903140a3ceb27fa31ef6b8ca4885adad;hpb=0b5610d8a220a4b20cbeac958953ca4d67c00038;p=sbcl.git

diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp
index b41ab58..f8f0f35 100644
--- a/src/pcl/cache.lisp
+++ b/src/pcl/cache.lisp
@@ -256,27 +256,6 @@
 (unless (boundp '*the-class-t*)
   (setq *the-class-t* nil))
 
-;;; Note that for SBCL, as for CMU CL, the WRAPPER of a built-in or
-;;; structure class will be some other kind of SB-KERNEL:LAYOUT, but
-;;; this shouldn't matter, since the only two slots that WRAPPER adds
-;;; are meaningless in those cases.
-(defstruct (wrapper
-	    (:include sb-kernel:layout
-		      ;; KLUDGE: In CMU CL, the initialization default
-		      ;; for LAYOUT-INVALID was NIL. In SBCL, that has
-		      ;; changed to :UNINITIALIZED, but PCL code might
-		      ;; still expect NIL for the initialization
-		      ;; default of WRAPPER-INVALID. Instead of trying
-		      ;; to find out, I just overrode the LAYOUT
-		      ;; default here. -- WHN 19991204
-		      (invalid nil))
-	    (:conc-name %wrapper-)
-	    (: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))
-
 (defmacro wrapper-class (wrapper)
   `(sb-kernel:class-pcl-class (sb-kernel:layout-class ,wrapper)))
 (defmacro wrapper-no-of-instance-slots (wrapper)
@@ -335,25 +314,25 @@
      (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
        :length length
        :class (sb-kernel:make-standard-class :name name :pcl-class class))))))
 
-;;; The following variable may be set to a standard-class that has
+;;; The following variable may be set to a STANDARD-CLASS that has
 ;;; already been created by the lisp code and which is to be redefined
-;;; by PCL. This allows standard-classes to be defined and used for
+;;; by PCL. This allows STANDARD-CLASSes to be defined and used for
 ;;; type testing and dispatch before PCL is loaded.
 (defvar *pcl-class-boot* nil)
 
 ;;; In SBCL, as in CMU CL, the layouts (a.k.a wrappers) for built-in
 ;;; and structure classes already exist when PCL is initialized, so we
 ;;; don't necessarily always make a wrapper. Also, we help maintain
-;;; the mapping between cl:class and pcl::class objects.
+;;; the mapping between CL:CLASS and PCL::CLASS objects.
 (defun make-wrapper (length class)
   (cond
    ((typep class 'std-class)
@@ -370,7 +349,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))))
@@ -381,8 +360,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.
@@ -579,7 +558,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
@@ -592,7 +571,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))))))
 
 ;;; the various implementations of computing a primary cache location from
 ;;; wrappers. Because some implementations of this must run fast there are
@@ -604,8 +583,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)
@@ -634,8 +611,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