0.pre7.126:

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

diff --git a/src/pcl/dlisp.lisp b/src/pcl/dlisp.lisp
index 0f4d06b..2639eb6 100644 (file)
--- a/src/pcl/dlisp.lisp
+++ b/src/pcl/dlisp.lisp
@@ -23,11 +23,11 @@
 
 (in-package "SB-PCL")
 \f
-;;; This file is (almost) functionally equivalent to dlap.lisp, but easier to
-;;; read.
+;;; This file is (almost) functionally equivalent to dlap.lisp, but
+;;; easier to read.
 
-;;; Might generate faster code, too, depending on the compiler and whether an
-;;; implementation-specific lap assembler was used.
+;;; Might generate faster code, too, depending on the compiler and
+;;; whether an implementation-specific lap assembler was used.
 
 (defun emit-one-class-reader (class-slot-p)
   (emit-reader/writer :reader 1 class-slot-p))
@@ -163,12 +163,12 @@
 (defun emit-slot-read-form (class-slot-p index slots)
   (if class-slot-p
       `(cdr ,index)
-      `(instance-ref ,slots ,index)))
+      `(clos-slots-ref ,slots ,index)))
 
 (defun emit-slot-write-form (class-slot-p index slots value)
   (if class-slot-p
       `(setf (cdr ,index) ,value)
-      `(and ,slots (setf (instance-ref ,slots ,index) ,value))))
+      `(and ,slots (setf (clos-slots-ref ,slots ,index) ,value))))
 
 (defun emit-boundp-check (value-form miss-fn arglist)
   `(let ((value ,value-form))
@@ -253,15 +253,15 @@
 
 (defun emit-dlap (args metatypes hit miss value-reg &optional slot-regs)
   (let* ((index -1)
-        (wrapper-bindings (mapcan #'(lambda (arg mt)
-                                      (unless (eq mt 't)
-                                        (incf index)
-                                        `((,(intern (format nil
-                                                            "WRAPPER-~D"
-                                                            index)
-                                                    *pcl-package*)
-                                           ,(emit-fetch-wrapper mt arg 'miss
-                                             (pop slot-regs))))))
+        (wrapper-bindings (mapcan (lambda (arg mt)
+                                    (unless (eq mt t)
+                                      (incf index)
+                                      `((,(intern (format nil
+                                                          "WRAPPER-~D"
+                                                          index)
+                                                  *pcl-package*)
+                                         ,(emit-fetch-wrapper
+                                           mt arg 'miss (pop slot-regs))))))
                                   args metatypes))
         (wrappers (mapcar #'car wrapper-bindings)))
     (declare (fixnum index))
@@ -341,13 +341,15 @@
         (let ((location primary) (next-location 0))
           (declare (fixnum location next-location))
           (block search
-            (loop (setq next-location (the fixnum (+ location ,cache-line-size)))
+            (loop (setq next-location
+                        (the fixnum (+ location ,cache-line-size)))
                   (when (and ,@(mapcar
-                                #'(lambda (wrapper)
-                                    `(eq ,wrapper
-                                      (cache-vector-ref cache-vector
-                                       (setq location
-                                        (the fixnum (+ location 1))))))
+                                (lambda (wrapper)
+                                  `(eq ,wrapper
+                                       (cache-vector-ref
+                                        cache-vector
+                                        (setq location
+                                              (the fixnum (+ location 1))))))
                                 wrappers))
                     ,@(when value
                         `((setq location (the fixnum (+ location 1)))
@@ -359,8 +361,9 @@
                   (when (= location primary)
                     (dolist (entry overflow)
                       (let ((entry-wrappers (car entry)))
-                        (when (and ,@(mapcar #'(lambda (wrapper)
-                                                 `(eq ,wrapper (pop entry-wrappers)))
+                        (when (and ,@(mapcar (lambda (wrapper)
+                                               `(eq ,wrapper
+                                                    (pop entry-wrappers)))
                                              wrappers))
                           ,@(when value
                               `((setq ,value (cdr entry))))
@@ -383,19 +386,20 @@
   `(progn
      ,@(let ((adds 0) (len (length wrappers)))
         (declare (fixnum adds len))
-        (mapcar #'(lambda (wrapper)
-                    `(let ((wrapper-cache-no (wrapper-cache-number-vector-ref
-                                              ,wrapper field)))
-                       (declare (fixnum wrapper-cache-no))
-                       (when (zerop wrapper-cache-no) (go ,miss-label))
-                       (setq primary (the fixnum (+ primary wrapper-cache-no)))
-                       ,@(progn
-                           (incf adds)
-                           (when (or (zerop (mod adds wrapper-cache-number-adds-ok))
-                                     (eql adds len))
-                             `((setq primary
-                                     ,(let ((form `(logand primary mask)))
-                                        `(the fixnum ,form))))))))
+        (mapcar (lambda (wrapper)
+                  `(let ((wrapper-cache-no (wrapper-cache-number-vector-ref
+                                            ,wrapper field)))
+                     (declare (fixnum wrapper-cache-no))
+                     (when (zerop wrapper-cache-no) (go ,miss-label))
+                     (setq primary (the fixnum (+ primary wrapper-cache-no)))
+                     ,@(progn
+                         (incf adds)
+                         (when (or (zerop (mod adds
+                                               wrapper-cache-number-adds-ok))
+                                   (eql adds len))
+                           `((setq primary
+                                   ,(let ((form `(logand primary mask)))
+                                      `(the fixnum ,form))))))))
                 wrappers))))
 
 ;;; CMU17 (and SBCL) note: Since STD-INSTANCE-P is weakened in the CMU/SBCL