0.7.3.9:

	merged NJF "PCL question" patch (sbcl-devel 2002-05-02)
	merged NJF "PCL cleanups" patch (sbcl-devel 2002-05-02)
	problem: CACHE-NUMBER-VECTOR-REF (converted from macro to
		inline function in NJF patches above) needs to be
		SETFable, so it'd need two functions, not just one,
		which is a little too much trouble, so I just reverted
		that part of the patch.
	deleted apparently-unused CLASS-NO-OF-INSTANCE-SLOTS

diff --git a/src/pcl/cache.lisp b/src/pcl/cache.lisp
index 829a4b6..62fccf5 100644 (file)
--- a/src/pcl/cache.lisp
+++ b/src/pcl/cache.lisp
@@ -364,29 +364,37 @@
       (aver layout)
       layout))))
 
-;;; FIXME: The immediately following macros could become inline functions.
+(defconstant +first-wrapper-cache-number-index+ 0)
 
-(defmacro first-wrapper-cache-number-index ()
-  0)
-
-(defmacro next-wrapper-cache-number-index (field-number)
-  `(and (< ,field-number #.(1- wrapper-cache-number-vector-length))
-       (1+ ,field-number)))
+(declaim (inline next-wrapper-cache-number-index))
+(defun next-wrapper-cache-number-index (field-number)
+  (and (< field-number #.(1- wrapper-cache-number-vector-length))
+       (1+ field-number)))
 
+;;; FIXME: Why are there two layers here, with one operator trivially
+;;; defined in terms of the other? It'd be nice either to have a
+;;; comment explaining why the separation is valuable, or to collapse
+;;; it into a single layer.
+;;;
+;;; FIXME (?): These are logically inline functions, but they need to
+;;; be SETFable, and for now it seems not worth the trouble to DEFUN
+;;; both inline FOO and inline (SETF FOO) for each one instead of a
+;;; single macro. Perhaps the best thing would be to make them
+;;; immutable (since it seems sort of surprising and gross to be able
+;;; to modify hash values) so that they can become inline functions
+;;; with no muss or fuss. I (WHN) didn't do this only because I didn't
+;;; know whether any code anywhere depends on the values being
+;;; modified.
 (defmacro cache-number-vector-ref (cnv n)
   `(wrapper-cache-number-vector-ref ,cnv ,n))
-
 (defmacro wrapper-cache-number-vector-ref (wrapper n)
   `(sb-kernel:layout-clos-hash ,wrapper ,n))
 
-(defmacro class-no-of-instance-slots (class)
-  `(wrapper-no-of-instance-slots (class-wrapper ,class)))
-
-(defmacro wrapper-class* (wrapper)
-  `(let ((wrapper ,wrapper))
-     (or (wrapper-class wrapper)
-        (find-structure-class
-         (cl:class-name (sb-kernel:layout-class wrapper))))))
+(declaim (inline wrapper-class*))
+(defun wrapper-class* (wrapper)
+  (or (wrapper-class wrapper)
+      (find-structure-class
+       (cl:class-name (sb-kernel:layout-class wrapper)))))
 
 ;;; The wrapper cache machinery provides general mechanism for
 ;;; trapping on the next access to any instance of a given class. This
@@ -401,9 +409,9 @@
 ;;; SLOT-VALUE-USING-CLASS check the wrapper validity as well. This is
 ;;; done by calling CHECK-WRAPPER-VALIDITY.
 
-;;; FIXME: could become inline function
-(defmacro invalid-wrapper-p (wrapper)
-  `(neq (wrapper-state ,wrapper) t))
+(declaim (inline invalid-wrapper-p))
+(defun invalid-wrapper-p (wrapper)
+  (neq (wrapper-state wrapper) t))
 
 (defvar *previous-nwrappers* (make-hash-table))
 
@@ -479,7 +487,7 @@
       (setf (cache-nkeys cache) nkeys
            (cache-valuep cache) valuep
            (cache-nlines cache) nlines
-           (cache-field cache) (first-wrapper-cache-number-index)
+           (cache-field cache) +first-wrapper-cache-number-index+
            (cache-limit-fn cache) limit-fn
            (cache-mask cache) cache-mask
            (cache-size cache) actual-size
@@ -493,7 +501,7 @@
       cache)))
 
 (defun get-cache-from-cache (old-cache new-nlines
-                            &optional (new-field (first-wrapper-cache-number-index)))
+                            &optional (new-field +first-wrapper-cache-number-index+))
   (let ((nkeys (cache-nkeys old-cache))
        (valuep (cache-valuep old-cache))
        (cache (or (sb-sys:without-interrupts (pop *free-caches*))
@@ -1359,12 +1367,3 @@
       (mapcar #'free-cache-vector
              (mapcar #'get-cache-vector
                      (make-list n :initial-element size))))))
-
-(defun caches-to-allocate ()
-  (sort (let ((l nil))
-         (maphash (lambda (size entry)
-                    (push (list (car entry) size) l))
-                  sb-pcl::*free-caches*)
-         l)
-       #'>
-       :key #'cadr))

diff --git a/src/pcl/dlisp.lisp b/src/pcl/dlisp.lisp
index a182810..482256e 100644 (file)
--- a/src/pcl/dlisp.lisp
+++ b/src/pcl/dlisp.lisp
@@ -121,7 +121,7 @@
   (let ((instance nil)
        (arglist  ())
        (closure-variables ())
-       (field (first-wrapper-cache-number-index))
+       (field +first-wrapper-cache-number-index+)
        (readp (eq reader/writer :reader))
        (read-form (emit-slot-read-form class-slot-p 'index 'slots)))
     ;;we need some field to do the fast obsolete check

diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index 37155ae..a52b2b3 100644 (file)
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -1151,17 +1151,6 @@
                                             plist)
        nwrapper)))
 \f
-(defmacro copy-instance-internal (instance)
-  `(progn
-     (let* ((class (class-of instance))
-           (copy (allocate-instance class)))
-       (if (std-instance-p ,instance)
-          (setf (std-instance-slots ,instance)
-                (std-instance-slots ,instance))
-        (setf (fsc-instance-slots ,instance)
-              (fsc-instance-slots ,instance)))
-       copy)))
-
 (defun change-class-internal (instance new-class)
   (let* ((old-class (class-of instance))
         (copy (allocate-instance new-class))