diff --git a/pcl/boot.lisp b/pcl/boot.lisp index 1c4e2bd65d6077f73ab2641346a772084c53f19d..c98ac0655ee33e22470d786836803ec4b9879536 100644 --- a/pcl/boot.lisp +++ b/pcl/boot.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.36 2002/10/19 01:13:27 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/boot.lisp,v 1.37 2002/10/19 14:32:42 pmai Exp $") (in-package :pcl) @@ -746,7 +746,7 @@ work during bootstrapping. (let* ((.slots. (get-slots-or-nil ,(car required-args+rest-arg))) (value (when .slots. (%instance-ref .slots. ,emf)))) - (if (eq value ',*slot-unbound*) + (if (eq value +slot-unbound+) (slot-unbound-internal ,(car required-args+rest-arg) ,emf) value))))) @@ -765,7 +765,7 @@ work during bootstrapping. (and .slots. (not (eq (%instance-ref .slots. (fast-instance-boundp-index ,emf)) - ',*slot-unbound*))))))) + +slot-unbound+))))))) ||# (t (etypecase ,emf @@ -816,7 +816,7 @@ work during bootstrapping. (cond ((null args) (error "1 or 2 args expected")) ((null (cdr args)) (let ((value (%instance-ref (get-slots (car args)) emf))) - (if (eq value *slot-unbound*) + (if (eq value +slot-unbound+) (slot-unbound-internal (car args) emf) value))) ((null (cddr args)) @@ -828,7 +828,7 @@ work during bootstrapping. (error "1 arg expected") (not (eq (%instance-ref (get-slots (car args)) (fast-instance-boundp-index emf)) - *slot-unbound*)))) + +slot-unbound+)))) (function (apply emf args)))) @@ -1308,11 +1308,11 @@ work during bootstrapping. (defvar *sgf-slots-init* (mapcar (lambda (canonical-slot) (if (memq (getf canonical-slot :name) '(arg-info source)) - *slot-unbound* + +slot-unbound+ (let ((initfunction (getf canonical-slot :initfunction))) (if initfunction (funcall initfunction) - *slot-unbound*)))) + +slot-unbound+)))) (early-collect-inheritance 'standard-generic-function))) (defvar *sgf-method-class-index* @@ -1321,7 +1321,7 @@ work during bootstrapping. (defun early-gf-p (x) (and (fsc-instance-p x) (eq (instance-ref (get-slots x) *sgf-method-class-index*) - *slot-unbound*))) + +slot-unbound+))) (defvar *sgf-methods-index* (bootstrap-slot-index 'standard-generic-function 'methods)) diff --git a/pcl/braid.lisp b/pcl/braid.lisp index c94352e109a158e6a81ca3e11e54b3ae20367a47..14611ea7246ac00dac9d2ba4248742b923228199 100644 --- a/pcl/braid.lisp +++ b/pcl/braid.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.23 2002/08/27 19:01:37 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/braid.lisp,v 1.24 2002/10/19 14:32:43 pmai Exp $") ;;; ;;; Bootstrapping the meta-braid. ;;; @@ -57,7 +57,7 @@ slots)) (t (make-array no-of-slots - :initial-element pcl::*slot-unbound*)))) + :initial-element pcl::+slot-unbound+)))) instance)) (defmacro allocate-funcallable-instance-slots (wrapper &optional @@ -66,8 +66,8 @@ ,(if slots-init-p `(if ,slots-init-p (make-array no-of-slots :initial-contents ,slots-init) - (make-array no-of-slots :initial-element *slot-unbound*)) - `(make-array no-of-slots :initial-element *slot-unbound*)))) + (make-array no-of-slots :initial-element +slot-unbound+)) + `(make-array no-of-slots :initial-element +slot-unbound+)))) (defun allocate-funcallable-instance (wrapper &optional (slots-init nil slots-init-p)) (let ((fin (allocate-funcallable-instance-1))) diff --git a/pcl/construct.lisp b/pcl/construct.lisp index 4edbaf6681f7780d65a97e5966b78101fcac8640..b9d5e6bec08bdeed6186da95eab919172427b9c7 100644 --- a/pcl/construct.lisp +++ b/pcl/construct.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/construct.lisp,v 1.13 2002/08/26 02:23:11 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/construct.lisp,v 1.14 2002/10/19 14:32:43 pmai Exp $") ;;; ;;; This file defines the defconstructor and other make-instance optimization ;;; mechanisms. @@ -558,12 +558,12 @@ (initfn (slot-definition-initfunction slotd))) (cond ((null (memq name layout))) ((null initfn) - (push (cons name *slot-unbound*) constants)) + (push (cons name +slot-unbound+) constants)) ((constantp initform) (push (cons name (eval initform)) constants) (when (eq flag :unsupplied) (setq flag :constants))) (t - (push (cons name *slot-unbound*) constants) + (push (cons name +slot-unbound+) constants) (setq flag t))))) (let* ((constants-alist (sort constants (lambda (x y) (memq (car y) diff --git a/pcl/dlisp.lisp b/pcl/dlisp.lisp index 98b71584835817aee5d4a4440f140394851c73ea..045e88c4b01e8635c2399930d93a05d582390bb1 100644 --- a/pcl/dlisp.lisp +++ b/pcl/dlisp.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dlisp.lisp,v 1.8 2002/08/26 02:23:13 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/dlisp.lisp,v 1.9 2002/10/19 14:32:43 pmai Exp $") ;;; (in-package :pcl) @@ -166,7 +166,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)))))) @@ -178,7 +178,7 @@ (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))) diff --git a/pcl/extensions.lisp b/pcl/extensions.lisp index d3ce3c9c22d5fee5021f15ff64cd09969d81387a..fbd3ed5f89921e14530444442bc87f46055fa01c 100644 --- a/pcl/extensions.lisp +++ b/pcl/extensions.lisp @@ -18,7 +18,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/extensions.lisp,v 1.6 2002/08/27 19:01:38 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/extensions.lisp,v 1.7 2002/10/19 14:32:43 pmai Exp $") ;;; (in-package 'pcl) @@ -86,7 +86,7 @@ (ext:once-only ((index index)) `(if ,index (let ((val (%svref ,slots ,index))) - (if (eq val ',*slot-unbound*) + (if (eq val +slot-unbound+) (slot-unbound (wrapper-class ,wrapper) ,instance ,slot-name) val)) (if *safe-to-use-slot-value-wrapper-optimizations-p* diff --git a/pcl/fast-init.lisp b/pcl/fast-init.lisp index 20627ade349b9a091781a3bbc4765fcb7810537f..c526ba3db3d10fd33e581ab8e64c913b053aa485 100644 --- a/pcl/fast-init.lisp +++ b/pcl/fast-init.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/fast-init.lisp,v 1.11 2002/10/18 23:31:03 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/fast-init.lisp,v 1.12 2002/10/19 14:32:44 pmai Exp $") ;;; ;;; This file defines the optimized make-instance functions. ;;; @@ -615,7 +615,7 @@ (wrapper (class-wrapper class)) (constants (when simple-p (make-list (wrapper-no-of-instance-slots wrapper) - :initial-element *slot-unbound*))) + :initial-element +slot-unbound+))) (slots (class-slots class)) (slot-names (mapcar #'slot-definition-name slots)) (slots-key (mapcar (lambda (slot) @@ -867,8 +867,8 @@ `((unless ,(if *inline-iis-instance-locations-p* (typecase location (fixnum `(not (eq (%instance-ref slots ,(const location)) - ',*slot-unbound*))) - (cons `(not (eq (cdr ,(const location)) ',*slot-unbound*))) + +slot-unbound+))) + (cons `(not (eq (cdr ,(const location)) +slot-unbound+))) (t default)) `(instance-boundp-internal pv slots ,(const pv-offset) ,default diff --git a/pcl/low.lisp b/pcl/low.lisp index 58f86f6177c167bf472319bfb9525da8b19b8fd7..39d85cb50484dc926c0d75eb0afe86ea5f8f5d39 100644 --- a/pcl/low.lisp +++ b/pcl/low.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/low.lisp,v 1.18 2002/09/09 15:02:56 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/low.lisp,v 1.19 2002/10/19 14:32:44 pmai Exp $") ;;; ;;; This file contains optimized low-level constructs for PCL. @@ -286,14 +286,9 @@ the compiler as completely as possible. Currently this means that ;;; It may seem gross, but for performance reasons, we make this an interned ;;; symbol. That means that the fast check to see if a slot is unbound is to ;;; say (EQ <val> '..SLOT-UNBOUND..). That is considerably faster than looking -;;; at the value of a special variable. Be careful, there are places in the -;;; code which actually use ..slot-unbound.. rather than this variable. So -;;; much for modularity. +;;; at the value of a special variable. ;;; -;;; Actually at the current point in time it seems that all code now -;;; uses *slot-unbound* instead of ..slot-unbound.. itself. -;;; -(defconstant *slot-unbound* '..slot-unbound..) +(defconstant +slot-unbound+ '..slot-unbound..) ;;;; Structure-instance stuff: diff --git a/pcl/slots-boot.lisp b/pcl/slots-boot.lisp index cbf37af37defd3daa456764cbb6cbe13b4d20fc2..fc416c9643bcfc534cce2dfbbcfc71cd06badb15 100644 --- a/pcl/slots-boot.lisp +++ b/pcl/slots-boot.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots-boot.lisp,v 1.10 2002/08/26 02:23:15 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots-boot.lisp,v 1.11 2002/10/19 14:32:44 pmai Exp $") ;;; (in-package :pcl) @@ -86,7 +86,7 @@ (defun make-structure-slot-boundp-function (slotd) (let* ((reader (slot-definition-internal-reader-function slotd)) (fun (lambda (object) - (not (eq (funcall reader object) *slot-unbound*))))) + (not (eq (funcall reader object) +slot-unbound+))))) (declare (type function reader)) fun)) @@ -122,17 +122,17 @@ (fixnum (if fsc-p (lambda (instance) (let ((value (%instance-ref (fsc-instance-slots instance) index))) - (if (eq value *slot-unbound*) + (if (eq value +slot-unbound+) (slot-unbound (class-of instance) instance slot-name) value))) (lambda (instance) (let ((value (%instance-ref (std-instance-slots instance) index))) - (if (eq value *slot-unbound*) + (if (eq value +slot-unbound+) (slot-unbound (class-of instance) instance slot-name) value))))) (cons (lambda (instance) (let ((value (cdr index))) - (if (eq value *slot-unbound*) + (if (eq value +slot-unbound+) (slot-unbound (class-of instance) instance slot-name) value))))) `(reader ,slot-name))) @@ -159,21 +159,21 @@ (lambda (instance) (not (eq (%instance-ref (fsc-instance-slots instance) index) - *slot-unbound*))) + +slot-unbound+))) (lambda (instance) (not (eq (%instance-ref (std-instance-slots instance) index) - *slot-unbound*))))) + +slot-unbound+))))) (cons (lambda (instance) (declare (ignore instance)) - (not (eq (cdr index) *slot-unbound*))))) + (not (eq (cdr index) +slot-unbound+))))) `(boundp ,slot-name))) (defun make-optimized-structure-slot-value-using-class-method-function (function) (declare (type function function)) (lambda (class object slotd) (let ((value (funcall function object))) - (if (eq value *slot-unbound*) + (if (eq value +slot-unbound+) (slot-unbound class object (slot-definition-name slotd)) value)))) @@ -187,7 +187,7 @@ (declare (type function function)) (lambda (class object slotd) (declare (ignore class slotd)) - (not (eq (funcall function object) *slot-unbound*)))) + (not (eq (funcall function object) +slot-unbound+)))) (defun get-optimized-std-slot-value-using-class-method-function (class slotd name) (if (structure-class-p class) @@ -223,20 +223,20 @@ (declare (ignore slotd)) (unless (fsc-instance-p instance) (error "not fsc")) (let ((value (%instance-ref (fsc-instance-slots instance) index))) - (if (eq value *slot-unbound*) + (if (eq value +slot-unbound+) (slot-unbound class instance slot-name) value))) (lambda (class instance slotd) (declare (ignore slotd)) (unless (std-instance-p instance) (error "not std")) (let ((value (%instance-ref (std-instance-slots instance) index))) - (if (eq value *slot-unbound*) + (if (eq value +slot-unbound+) (slot-unbound class instance slot-name) value))))) (cons (lambda (class instance slotd) (declare (ignore slotd)) (let ((value (cdr index))) - (if (eq value *slot-unbound*) + (if (eq value +slot-unbound+) (slot-unbound class instance slot-name) value)))))) @@ -266,15 +266,15 @@ (declare (ignore class slotd)) (not (eq (%instance-ref (fsc-instance-slots instance) index) - *slot-unbound* ))) + +slot-unbound+))) (lambda (class instance slotd) (declare (ignore class slotd)) (not (eq (%instance-ref (std-instance-slots instance) index) - *slot-unbound* ))))) + +slot-unbound+))))) (cons (lambda (class instance slotd) (declare (ignore class instance slotd)) - (not (eq (cdr index) *slot-unbound*)))))) + (not (eq (cdr index) +slot-unbound+)))))) (defun get-accessor-from-svuc-method-function (class slotd sdfun name) (macrolet ((emf-funcall (emf &rest args) @@ -298,12 +298,12 @@ (typecase index (fixnum (let ((value (%instance-ref (get-slots instance) index))) - (if (eq value *slot-unbound*) + (if (eq value +slot-unbound+) (slot-unbound (class-of instance) instance slot-name) value))) (cons (let ((value (cdr index))) - (if (eq value *slot-unbound*) + (if (eq value +slot-unbound+) (slot-unbound (class-of instance) instance slot-name) value))) (t diff --git a/pcl/slots.lisp b/pcl/slots.lisp index 76ce6e71ec357ef845a0146eb371c7e9ac36c04b..275362d744dadd38b9de5b7fbb22d62c161d5961 100644 --- a/pcl/slots.lisp +++ b/pcl/slots.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots.lisp,v 1.13 2002/09/07 13:28:46 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/slots.lisp,v 1.14 2002/10/19 14:32:44 pmai Exp $") ;;; (in-package :pcl) @@ -95,7 +95,7 @@ (let ((entry (assoc slot-name (wrapper-class-slots wrapper)))) (if (null entry) (slot-missing (wrapper-class wrapper) object slot-name 'slot-value) - (if (eq (cdr entry) *slot-unbound*) + (if (eq (cdr entry) +slot-unbound+) (slot-unbound (wrapper-class wrapper) object slot-name) (cdr entry))))) @@ -228,7 +228,7 @@ (error "The slot ~s has neither :instance nor :class allocation, ~@ so it can't be read by the default ~s method." slotd 'slot-value-using-class))))) - (if (eq value *slot-unbound*) + (if (eq value +slot-unbound+) (slot-unbound class object (slot-definition-name slotd)) value))) @@ -277,7 +277,7 @@ (error "The slot ~s has neither :instance nor :class allocation, ~@ so it can't be read by the default ~s method." slotd 'slot-boundp-using-class))))) - (not (eq value *slot-unbound*)))) + (not (eq value +slot-unbound+)))) (defmethod slot-makunbound-using-class ((class std-class) @@ -289,14 +289,14 @@ (cond ((std-instance-p object) (unless (eq 't (wrapper-state (std-instance-wrapper object))) (check-wrapper-validity object)) - (setf (%instance-ref (std-instance-slots object) location) *slot-unbound*)) + (setf (%instance-ref (std-instance-slots object) location) +slot-unbound+)) ((fsc-instance-p object) (unless (eq 't (wrapper-state (fsc-instance-wrapper object))) (check-wrapper-validity object)) - (setf (%instance-ref (fsc-instance-slots object) location) *slot-unbound*)) + (setf (%instance-ref (fsc-instance-slots object) location) +slot-unbound+)) (t (error "What kind of instance is this?")))) (cons - (setf (cdr location) *slot-unbound*)) + (setf (cdr location) +slot-unbound+)) (t (error "The slot ~s has neither :instance nor :class allocation, ~@ so it can't be written by the default ~s method." @@ -310,7 +310,7 @@ (let* ((function (slot-definition-internal-reader-function slotd)) (value (funcall function object))) (declare (type function function)) - (if (eq value *slot-unbound*) + (if (eq value +slot-unbound+) (slot-unbound class object (slot-definition-name slotd)) value))) diff --git a/pcl/std-class.lisp b/pcl/std-class.lisp index bd7572025b1eefd231cf03c329bd992a8b93c1ef..59edd0d249a997f4adf23ec0b0f9eceb5db06620 100644 --- a/pcl/std-class.lisp +++ b/pcl/std-class.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.34 2002/09/07 13:28:46 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/std-class.lisp,v 1.35 2002/10/19 14:32:44 pmai Exp $") ;;; (in-package :pcl) @@ -480,7 +480,7 @@ (push (cons (slot-definition-name dslotd) (if initfunction (funcall initfunction) - *slot-unbound*)) + +slot-unbound+)) collected)))))) (setq predicate-name (if predicate-name-p (setf (slot-value class 'predicate-name) @@ -555,7 +555,7 @@ (:constructor ,constructor ())) ,@(mapcar (lambda (slot) `(,(slot-definition-name slot) - *slot-unbound*)) + +slot-unbound+)) direct-slots))) (reader-names (mapcar (lambda (slotd) (intern (format nil "~A~A reader" conc-name @@ -1184,7 +1184,7 @@ (instance-ref oslots opos)) else do (push name discarded) - (unless (eq (instance-ref oslots opos) *slot-unbound*) + (unless (eq (instance-ref oslots opos) +slot-unbound+) (setf (getf plist name) (instance-ref oslots opos)))) ;; @@ -1196,7 +1196,7 @@ (setf (instance-ref nslots npos) val) else do (push name discarded) - (unless (eq val *slot-unbound*) + (unless (eq val +slot-unbound+) (setf (getf plist name) val))) ;; ;; Go through all the new local slots to compute the added slots. diff --git a/pcl/user-instances.lisp b/pcl/user-instances.lisp index f8943d80d224fcfcb9c67d98007da9106b9eaea2..0a3a701f9335d1b930801f36ff4547adb2cf0236 100644 --- a/pcl/user-instances.lisp +++ b/pcl/user-instances.lisp @@ -20,7 +20,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/user-instances.lisp,v 1.5 2002/08/27 19:01:40 pmai Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/Attic/user-instances.lisp,v 1.6 2002/10/19 14:32:45 pmai Exp $") ;;; (in-package 'pcl) @@ -219,7 +219,7 @@ "The slot ~s has neither :instance nor :class allocation, ~@ so it can't be read by the default ~s method." slotd 'slot-value-using-class))))) - (if (eq value *slot-unbound*) + (if (eq value +slot-unbound+) (slot-unbound class object (slot-definition-name slotd)) value))) @@ -254,7 +254,7 @@ "The slot ~s has neither :instance nor :class allocation, ~@ so it can't be read by the default ~s method." slotd 'slot-boundp-using-class))))) - (not (eq value *slot-unbound*)))) + (not (eq value +slot-unbound+)))) @@ -303,7 +303,7 @@ (progn slot-name) (lambda (instance) (let ((value (%svref (user-vector-instance-slots instance) index))) - (if (eq value *slot-unbound*) + (if (eq value +slot-unbound+) (slot-unbound (class-of instance) instance slot-name) value)))) @@ -316,7 +316,7 @@ (declare #.*optimize-speed*) (lambda (instance) (not (eq (%svref (user-vector-instance-slots instance) index) - *slot-unbound*)))) + +slot-unbound+)))) diff --git a/pcl/vector.lisp b/pcl/vector.lisp index 2c0fc2936f7aa2db7ccd8fe6cf3655823dc99926..6b417511c3d7c21e5cef5f3b62d6a5400633b5fe 100644 --- a/pcl/vector.lisp +++ b/pcl/vector.lisp @@ -26,7 +26,7 @@ ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/vector.lisp,v 1.19 2002/10/02 17:26:12 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/pcl/vector.lisp,v 1.20 2002/10/19 14:32:45 pmai Exp $") ;;; ;;; Permutation vectors. ;;; @@ -672,8 +672,8 @@ `((fixnum (%instance-ref ,slots ,index)))) ,@(when (or (null type) (eq type :class)) `((cons (cdr ,index)))) - (t ',*slot-unbound*))) - (if (eq ,value ',*slot-unbound*) + (t +slot-unbound+))) + (if (eq ,value +slot-unbound+) ,default ,value)))))) @@ -735,9 +735,9 @@ (let ((,index (pvref ,pv ,pv-offset))) (typecase ,index ,@(when (or (null type) (eq type :instance)) - `((fixnum (not (eq (%instance-ref ,slots ,index) ',*slot-unbound*))))) + `((fixnum (not (eq (%instance-ref ,slots ,index) +slot-unbound+))))) ,@(when (or (null type) (eq type :class)) - `((cons (not (eq (cdr ,index) ',*slot-unbound*))))) + `((cons (not (eq (cdr ,index) +slot-unbound+))))) (t ,default))))))) (defmacro instance-boundp (pv-offset parameter position slot-name class)