X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdlisp.lisp;h=2639eb635639c32f61b64a411f8e88a017e9e8ac;hb=ed7ba4dad8a79726fdfeba5aa12e276ea852c540;hp=0f4d06b357379c96253120e8c0189e77392d36bb;hpb=475c832b081651e66ad9446d4852c62086f5e740;p=sbcl.git

diff --git a/src/pcl/dlisp.lisp b/src/pcl/dlisp.lisp
index 0f4d06b..2639eb6 100644
--- a/src/pcl/dlisp.lisp
+++ b/src/pcl/dlisp.lisp
@@ -23,11 +23,11 @@
 
 (in-package "SB-PCL")
 
-;;; 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