diff --git a/general-info/release-19a.txt b/general-info/release-19a.txt index 0258e2e22ef8c0726b7f9fb319e5e8246c5b3b3f..1560a622777d27aa0dbf892b4ab0444103524b54 100644 --- a/general-info/release-19a.txt +++ b/general-info/release-19a.txt @@ -117,6 +117,9 @@ New in this release: - DEFCLASS redefining a class with the given name only if the name is the proper name of an existing class. - KEYWORD package no longer having nickname "". + - SLOT-VALUE, (SETF SLOT-VALUE), SLOT-BOUNDP, SLOT-MAKUNBOUND + returning values specified by the standard when SLOT-UNBOUND + or SLOT-MISSING are called and return. * Numerous bugfixes: - NSET-EXCLUSIVE-OR returns the same results as SET-EXCLUSIVE-OR diff --git a/pcl/method-slot-access-optimization.lisp b/pcl/method-slot-access-optimization.lisp index 2a534311470e1f8984ece1038588261f76fb71b9..564669c67f89d76c93cb539bb2837610bf259c68 100644 --- a/pcl/method-slot-access-optimization.lisp +++ b/pcl/method-slot-access-optimization.lisp @@ -52,7 +52,7 @@ ;;; (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/method-slot-access-optimization.lisp,v 1.4 2003/05/08 11:21:33 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/method-slot-access-optimization.lisp,v 1.5 2003/06/15 14:06:26 gerd Exp $") (in-package "PCL") @@ -364,7 +364,7 @@ `(the ,slot-type ,read-form)))) (defun inline-slot-unbound (instance slot-name) - (slot-unbound (class-of instance) instance slot-name)) + (values (slot-unbound (class-of instance) instance slot-name))) (defmacro inline-slot-boundp (class slot-name slots-variable) (multiple-value-bind (read-form slot-type) diff --git a/pcl/slots-boot.lisp b/pcl/slots-boot.lisp index 773acd5c16ea11248f2ec4545eba4c9f35acbb73..8da01df708644982633199a5ceff3fb7eba9a67d 100644 --- a/pcl/slots-boot.lisp +++ b/pcl/slots-boot.lisp @@ -26,7 +26,7 @@ ;;; (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots-boot.lisp,v 1.23 2003/05/11 11:30:34 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots-boot.lisp,v 1.24 2003/06/15 14:06:26 gerd Exp $") ;;; (in-package :pcl) @@ -51,19 +51,19 @@ (slot-value (make-method-function (lambda (obj) - (slot-missing (class-of obj) obj slot-name - 'slot-value)))) + (values (slot-missing (class-of obj) obj slot-name + 'slot-value))))) (slot-boundp (make-method-function (lambda (obj) - (slot-missing (class-of obj) obj slot-name - 'slot-boundp)))) + (not (not (slot-missing (class-of obj) obj slot-name + 'slot-boundp)))))) (setf (make-method-function (lambda (val obj) - (declare (ignore val)) (slot-missing (class-of obj) obj slot-name - 'setf)))))) + 'setf) + val))))) (initargs (copy-tree initargs))) (setf (getf (getf initargs :plist) :slot-name-lists) (list (list nil slot-name))) @@ -127,9 +127,12 @@ (setq object object-var))))) (writer-name (slot-writer-name slot-name)) (form `(let ((.ignore. (load-time-value - (ensure-accessor 'writer ',writer-name ',slot-name)))) + (ensure-accessor 'writer ',writer-name + ',slot-name))) + (.new-value. ,new-value)) (declare (ignore .ignore.)) - (funcall #',writer-name ,new-value ,object)))) + (funcall #',writer-name .new-value. ,object) + .new-value.))) (if bindings `(let ,bindings ,form) form))) @@ -182,19 +185,19 @@ (check-obsolete-instance instance) (let ((value (%slot-ref (fsc-instance-slots instance) index))) (if (eq value +slot-unbound+) - (slot-unbound (class-of instance) instance slot-name) + (values (slot-unbound (class-of instance) instance slot-name)) value))) (lambda (instance) (check-obsolete-instance instance) (let ((value (%slot-ref (std-instance-slots instance) index))) (if (eq value +slot-unbound+) - (slot-unbound (class-of instance) instance slot-name) + (values (slot-unbound (class-of instance) instance slot-name)) value))))) (cons (lambda (instance) (check-obsolete-instance instance) (let ((value (cdr index))) (if (eq value +slot-unbound+) - (slot-unbound (class-of instance) instance slot-name) + (values (slot-unbound (class-of instance) instance slot-name)) value))))) `(reader ,slot-name))) @@ -304,21 +307,21 @@ (check-obsolete-instance instance) (let ((value (%slot-ref (fsc-instance-slots instance) index))) (if (eq value +slot-unbound+) - (slot-unbound class instance slot-name) + (values (slot-unbound class instance slot-name)) value))) (lambda (class instance slotd) (declare (ignore slotd)) (check-obsolete-instance instance) (let ((value (%slot-ref (std-instance-slots instance) index))) (if (eq value +slot-unbound+) - (slot-unbound class instance slot-name) + (values (slot-unbound class instance slot-name)) value))))) (cons (lambda (class instance slotd) (declare (ignore slotd)) (check-obsolete-instance instance) (let ((value (cdr index))) (if (eq value +slot-unbound+) - (slot-unbound class instance slot-name) + (values (slot-unbound class instance slot-name)) value)))))) (defun make-optimized-std-setf-slot-value-using-class-method-function @@ -374,12 +377,12 @@ (fixnum (let ((value (%slot-ref (get-slots instance) index))) (if (eq value +slot-unbound+) - (slot-unbound (class-of instance) instance slot-name) + (values (slot-unbound (class-of instance) instance slot-name)) value))) (cons (let ((value (cdr index))) (if (eq value +slot-unbound+) - (slot-unbound (class-of instance) instance slot-name) + (values (slot-unbound (class-of instance) instance slot-name)) value))) (t (error "~@<The wrapper for class ~S does not have ~ diff --git a/pcl/slots.lisp b/pcl/slots.lisp index 4cb2fbfc0950b445c79812e1c1cf8d4fe226805e..f51d302bf62247e771de747e482f2ce5fe340d0e 100644 --- a/pcl/slots.lisp +++ b/pcl/slots.lisp @@ -26,7 +26,7 @@ ;;; (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots.lisp,v 1.25 2003/06/12 09:06:30 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots.lisp,v 1.26 2003/06/15 14:06:26 gerd Exp $") ;;; (in-package :pcl) @@ -87,7 +87,7 @@ (let* ((class (class-of object)) (slot-definition (find-slot-definition class slot-name))) (if (null slot-definition) - (slot-missing class object slot-name 'slot-value) + (values (slot-missing class object slot-name 'slot-value)) (slot-value-using-class class object slot-definition)))) (defun set-slot-value (object slot-name new-value) @@ -96,7 +96,8 @@ (if (null slot-definition) (slot-missing class object slot-name 'setf new-value) (setf (slot-value-using-class class object slot-definition) - new-value)))) + new-value)) + new-value)) (define-compiler-macro slot-value (&whole form object slot-name) (if (and (constantp slot-name) @@ -114,7 +115,7 @@ (let* ((class (class-of object)) (slot-definition (find-slot-definition class slot-name))) (if (null slot-definition) - (slot-missing class object slot-name 'slot-boundp) + (not (not (slot-missing class object slot-name 'slot-boundp))) (slot-boundp-using-class class object slot-definition)))) (define-compiler-macro slot-boundp (&whole form object slot-name) @@ -128,7 +129,8 @@ (slot-definition (find-slot-definition class slot-name))) (if (null slot-definition) (slot-missing class object slot-name 'slot-makunbound) - (slot-makunbound-using-class class object slot-definition)))) + (slot-makunbound-using-class class object slot-definition)) + object)) (defun slot-exists-p (object slot-name) (let ((class (class-of object))) @@ -173,7 +175,7 @@ method.~@:>" slotd :instance :class 'slot-value-using-class))))) (if (eq value +slot-unbound+) - (slot-unbound class object (slot-definition-name slotd)) + (values (slot-unbound class object (slot-definition-name slotd))) value))) (defmethod (setf slot-value-using-class) @@ -316,13 +318,14 @@ (error 'unbound-slot :name slot-name :slot slot-name :instance instance)) (defun slot-unbound-internal (instance position) - (slot-unbound (class-of instance) instance - (etypecase position - (fixnum - (nth position - (wrapper-instance-slots-layout (wrapper-of instance)))) - (cons - (car position))))) + (values + (slot-unbound (class-of instance) instance + (etypecase position + (fixnum + (nth position + (wrapper-instance-slots-layout (wrapper-of instance)))) + (cons + (car position)))))) (defmethod allocate-instance ((class standard-class) &rest initargs &key) diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp index 71e6a93e4d6ce08f6f7bb487111155f6c2cd51d3..d8dd2dc3f84551504ca4ce60841c0b7084605ad3 100644 --- a/pcl/std-class.lisp +++ b/pcl/std-class.lisp @@ -26,7 +26,7 @@ ;;; (file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.69 2003/06/10 09:20:43 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.70 2003/06/15 14:06:26 gerd Exp $") (in-package :pcl) @@ -1644,7 +1644,7 @@ (lambda (x) (handler-case (conditions::condition-reader-function x slot-name) - (error () (slot-unbound class x slot-name))))) + (error () (values (slot-unbound class x slot-name)))))) (setf (slot-definition-writer-function slotd) (lambda (v x) (conditions::condition-writer-function x v slot-name)))