projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.pre7.80:
[sbcl.git]
/
src
/
pcl
/
dlisp.lisp
diff --git
a/src/pcl/dlisp.lisp
b/src/pcl/dlisp.lisp
index
da57d57
..
a8400de
100644
(file)
--- a/
src/pcl/dlisp.lisp
+++ b/
src/pcl/dlisp.lisp
@@
-23,11
+23,11
@@
(in-package "SB-PCL")
\f
(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))
(defun emit-one-class-reader (class-slot-p)
(emit-reader/writer :reader 1 class-slot-p))
@@
-106,7
+106,7
@@
,form)))))
(values (if *precompiling-lap*
`#',lambda
,form)))))
(values (if *precompiling-lap*
`#',lambda
- (compile-lambda lambda))
+ (compile nil lambda))
nil)))
;;; note on implementation for CMU 17 and later (including SBCL):
nil)))
;;; note on implementation for CMU 17 and later (including SBCL):
@@
-163,7
+163,12
@@
(defun emit-slot-read-form (class-slot-p index slots)
(if class-slot-p
`(cdr ,index)
(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))
(defun emit-boundp-check (value-form miss-fn arglist)
`(let ((value ,value-form))
@@
-172,10
+177,12
@@
value)))
(defun emit-slot-access (reader/writer class-slot-p slots index 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))
(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)
(defmacro emit-reader/writer-macro (reader/writer 1-or-2-class class-slot-p)
(let ((*emit-function-p* nil)
@@
-247,7
+254,7
@@
(defun emit-dlap (args metatypes hit miss value-reg &optional slot-regs)
(let* ((index -1)
(wrapper-bindings (mapcan #'(lambda (arg mt)
(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"
(incf index)
`((,(intern (format nil
"WRAPPER-~D"