X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fpcl%2Fdlisp.lisp;h=a8400de9216ddde6f2a4daaa6fa154fc44400dd9;hb=416152f084604094445a758ff399871132dff2bd;hp=8e769f36d2ca2fbd2e40bb957f50d0fa4c6f6d38;hpb=a530bbe337109d898d5b4a001fc8f1afa3b5dc39;p=sbcl.git

diff --git a/src/pcl/dlisp.lisp b/src/pcl/dlisp.lisp
index 8e769f3..a8400de 100644
--- a/src/pcl/dlisp.lisp
+++ b/src/pcl/dlisp.lisp
@@ -22,15 +22,12 @@
 ;;;; specification.
 
 (in-package "SB-PCL")
-
-(sb-int:file-comment
-  "$Header$")
 
-;;; 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))
@@ -109,7 +106,7 @@
 			  ,form)))))
     (values (if *precompiling-lap*
 		`#',lambda
-		(compile-lambda lambda))
+		(compile nil lambda))
 	    nil)))
 
 ;;; note on implementation for CMU 17 and later (including SBCL):
@@ -158,7 +155,7 @@
 				   (eq wrapper wrapper-1)))))
 	      ,@(if readp
 		    `((let ((value ,read-form))
-			(unless (eq value *slot-unbound*)
+			(unless (eq value +slot-unbound+)
 			  (return-from access value))))
 		    `((return-from access (setf ,read-form ,(car arglist))))))
 	    (funcall miss-fn ,@arglist))))))
@@ -166,19 +163,26 @@
 (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 (clos-slots-ref ,slots ,index) ,value))))
 
 (defun emit-boundp-check (value-form miss-fn arglist)
   `(let ((value ,value-form))
-     (if (eq value *slot-unbound*)
+     (if (eq value +slot-unbound+)
 	 (funcall ,miss-fn ,@arglist)
 	 value)))
 
 (defun emit-slot-access (reader/writer class-slot-p slots index miss-fn arglist)
-  (let ((read-form (emit-slot-read-form class-slot-p index slots)))
+  (let ((read-form (emit-slot-read-form class-slot-p index slots))
+        (write-form (emit-slot-write-form
+                     class-slot-p index slots (car arglist))))
     (ecase reader/writer
       (:reader (emit-boundp-check read-form miss-fn arglist))
-      (:writer `(setf ,read-form ,(car arglist))))))
+      (:writer write-form))))
 
 (defmacro emit-reader/writer-macro (reader/writer 1-or-2-class class-slot-p)
   (let ((*emit-function-p* nil)
@@ -250,7 +254,7 @@
 (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)
+				       (unless (eq mt t)
 					 (incf index)
 					 `((,(intern (format nil
 							     "WRAPPER-~D"