;; LAYOUT-CLOS-HASH-MAX by the doc string of that constant,
;; generated as strictly positive in RANDOM-LAYOUT-CLOS-HASH..)
;;
+ ;; [ CSR notes, several years later (2005-11-30) that the value 0 is
+ ;; special for these hash slots, indicating that the wrapper is
+ ;; obsolete. ]
+ ;;
;; KLUDGE: The fact that the slots here start at offset 1 is known
;; to the LAYOUT-CLOS-HASH function and to the LAYOUT-dumping code
;; in GENESIS.
(pure nil :type (member t nil 0))
;; Number of raw words at the end.
;; This slot is known to the C runtime support code.
- (n-untagged-slots 0 :type index))
+ (n-untagged-slots 0 :type index)
+ ;; Definition location
+ (source-location nil))
(def!method print-object ((layout layout) stream)
(print-unreadable-object (layout stream :type t :identity t)
;; They're declared as INDEX.. Or is this a hack to try to avoid
;; having to use bignum arithmetic? Or what? An explanation would be
;; nice.
+ ;;
+ ;; an explanation is provided in Kiczales and Rodriguez, "Efficient
+ ;; Method Dispatch in PCL", 1990. -- CSR, 2005-11-30
(1+ (random layout-clos-hash-max
(if (boundp '*layout-clos-hash-random-state*)
*layout-clos-hash-random-state*
;; during cold-load.
(translation nil :type (or ctype (member nil :initializing))))
-;;; FIXME: In CMU CL, this was a class with a print function, but not
-;;; necessarily a structure class (e.g. CONDITIONs). In SBCL,
-;;; we let CLOS handle our print functions, so that is no longer needed.
-;;; Is there any need for this class any more?
-(def!struct (slot-classoid (:include classoid)
- (:constructor nil)))
-
;;; STRUCTURE-CLASS represents what we need to know about structure
;;; classes. Non-structure "typed" defstructs are a special case, and
;;; don't have a corresponding class.
-(def!struct (basic-structure-classoid (:include slot-classoid)
- (:constructor nil)))
-
-(def!struct (structure-classoid (:include basic-structure-classoid)
+(def!struct (structure-classoid (:include classoid)
(:constructor make-structure-classoid))
;; If true, a default keyword constructor for this structure.
(constructor nil :type (or function null)))
-
-;;; FUNCALLABLE-STRUCTURE-CLASS is used to represent funcallable
-;;; structures, which are used to implement generic functions.
-(def!struct (funcallable-structure-classoid
- (:include basic-structure-classoid)
- (:constructor make-funcallable-structure-classoid)))
\f
;;;; classoid namespace
;; Otherwise, we can't in general be sure that the
;; intersection is empty, since a subclass of both might be
;; defined. But we can eliminate it for some special cases.
- ((or (basic-structure-classoid-p class1)
- (basic-structure-classoid-p class2))
+ ((or (structure-classoid-p class1)
+ (structure-classoid-p class2))
;; No subclass of both can be defined.
*empty-type*)
((eq (classoid-state class1) :sealed)
;; uncertain, since a subclass of both might be defined
nil)))
+;;; KLUDGE: we need this to deal with the special-case INSTANCE and
+;;; FUNCALLABLE-INSTANCE types (which used to be CLASSOIDs until CSR
+;;; discovered that this was incompatible with the MOP class
+;;; hierarchy). See NAMED :COMPLEX-SUBTYPEP-ARG2
+(defvar *non-instance-classoid-types*
+ '(symbol system-area-pointer weak-pointer code-component
+ lra fdefn random-class))
+
;;; KLUDGE: we need this because of the need to represent
;;; intersections of two classes, even when empty at a given time, as
;;; uncanonicalized intersections because of the possibility of later
(symbol :codes (#.sb!vm:symbol-header-widetag)
:prototype-form '#:mu)
- (instance :state :read-only)
-
(system-area-pointer :codes (#.sb!vm:sap-widetag)
:prototype-form (sb!sys:int-sap 42))
(weak-pointer :codes (#.sb!vm:weak-pointer-widetag)
#.sb!vm:simple-fun-header-widetag)
:state :read-only
:prototype-form (function (lambda () 42)))
- (funcallable-instance
- :inherits (function)
- :state :read-only)
(number :translation number)
(complex
:prototype-form 'nil)
(stream
:state :read-only
- :depth 3
- :inherits (instance))
+ :depth 2)
(file-stream
:state :read-only
- :depth 5
+ :depth 4
:inherits (stream))
(string-stream
:state :read-only
- :depth 5
+ :depth 4
:inherits (stream)))))
;;; See also src/code/class-init.lisp where we finish setting up the
(dolist (x '(;; Why is STREAM duplicated in this list? Because, when
;; the inherits-vector of FUNDAMENTAL-STREAM is set up,
;; a vector containing the elements of the list below,
- ;; i.e. '(T INSTANCE STREAM STREAM), is created, and
+ ;; i.e. '(T STREAM STREAM), is created, and
;; this is what the function ORDER-LAYOUT-INHERITS
;; would do, too.
;;
;; So, the purpose is to guarantee a valid layout for
;; the FUNDAMENTAL-STREAM class, matching what
;; ORDER-LAYOUT-INHERITS would do.
- ;; ORDER-LAYOUT-INHERITS would place STREAM at index 3
- ;; in the INHERITS(-VECTOR). Index 2 would not be
+ ;; ORDER-LAYOUT-INHERITS would place STREAM at index 2
+ ;; in the INHERITS(-VECTOR). Index 1 would not be
;; filled, so STREAM is duplicated there (as
;; ORDER-LAYOUTS-INHERITS would do). Maybe the
;; duplicate definition could be removed (removing a
;; redefined after PCL is set up, anyway. But to play
;; it safely, we define the class with a valid INHERITS
;; vector.
- (fundamental-stream (t instance stream stream))))
+ (fundamental-stream (t stream stream))))
(/show0 "defining temporary STANDARD-CLASS")
(let* ((name (first x))
(inherits-list (second x))
;;; Mark LAYOUT as invalid. Setting DEPTHOID -1 helps cause unsafe
;;; structure type tests to fail. Remove class from all superclasses
;;; too (might not be registered, so might not be in subclasses of the
-;;; nominal superclasses.)
+;;; nominal superclasses.) We set the layout-clos-hash slots to 0 to
+;;; invalidate the wrappers for specialized dispatch functions, which
+;;; use those slots as indexes into tables.
(defun invalidate-layout (layout)
(declare (type layout layout))
(setf (layout-invalid layout) t
(layout-depthoid layout) -1)
+ (dotimes (i layout-clos-hash-length)
+ (setf (layout-clos-hash layout i) 0))
(let ((inherits (layout-inherits layout))
(classoid (layout-classoid layout)))
(modify-classoid classoid)
projects / sbcl.git / blobdiff