#+sb-xc cl:class
(:make-load-form-fun class-make-load-form-fun)
(:include ctype
- (:class-info (type-class-or-lose #-sb-xc 'sb!xc:class
+ (class-info (type-class-or-lose #-sb-xc 'sb!xc:class
#+sb-xc 'cl:class)))
(:constructor nil)
#-no-ansi-print-object
;; that CL:CLASS-NAME is a generic function.)
(%name nil :type symbol)
;; the current layout for this class, or NIL if none assigned yet
- (layout nil :type (or sb!kernel::layout null))
+ (layout nil :type (or layout null))
;; How sure are we that this class won't be redefined?
;; :READ-ONLY = We are committed to not changing the effective
;; slots or superclasses.
;;; Note: This bound is set somewhat less than MOST-POSITIVE-FIXNUM
;;; in order to guarantee that several hash values can be added without
;;; overflowing into a bignum.
-(defconstant layout-clos-hash-max (ash most-positive-fixnum -3)
+(def!constant layout-clos-hash-max (ash most-positive-fixnum -3)
#!+sb-doc
"the inclusive upper bound on LAYOUT-CLOS-HASH values")
(clos-hash-6 (random-layout-clos-hash) :type index)
(clos-hash-7 (random-layout-clos-hash) :type index)
;; the class that this is a layout for
- (class (required-argument)
+ (class (missing-arg)
;; FIXME: Do we really know this is a CL:CLASS? Mightn't it
;; be a SB-PCL:CLASS under some circumstances? What goes here
;; when the LAYOUT is in fact a PCL::WRAPPER?
:type #-sb-xc sb!xc:class #+sb-xc cl:class)
- ;; The value of this slot can be
+ ;; The value of this slot can be:
;; * :UNINITIALIZED if not initialized yet;
;; * NIL if this is the up-to-date layout for a class; or
;; * T if this layout has been invalidated (by being replaced by
;; * something else (probably a list) if the class is a PCL wrapper
;; and PCL has made it invalid and made a note to itself about it
(invalid :uninitialized :type (or cons (member nil t :uninitialized)))
- ;; The layouts for all classes we inherit. If hierarchical these are
- ;; in order from most general down to (but not including) this
- ;; class.
+ ;; the layouts for all classes we inherit. If hierarchical, i.e. if
+ ;; DEPTHOID >= 0, then these are ordered by ORDER-LAYOUT-INHERITS,
+ ;; so that each inherited layout appears at its expected depth,
+ ;; i.e. at its LAYOUT-DEPTHOID value.
;;
- ;; FIXME: Couldn't this be (SIMPLE-ARRAY LAYOUT 1) instead of
- ;; SIMPLE-VECTOR?
+ ;; Remaining elements are filled by the non-hierarchical layouts or,
+ ;; if they would otherwise be empty, by copies of succeeding layouts.
(inherits #() :type simple-vector)
- ;; If inheritance is hierarchical, this is -1. If inheritance is not
+ ;; If inheritance is not hierarchical, this is -1. If inheritance is
;; hierarchical, this is the inheritance depth, i.e. (LENGTH INHERITS).
;; Note:
;; (1) This turns out to be a handy encoding for arithmetically
;; renamed because some of us find it confusing to call something
;; a depth when it isn't quite.
(depthoid -1 :type layout-depthoid)
- ;; The number of top-level descriptor cells in each instance.
+ ;; the number of top level descriptor cells in each instance
(length 0 :type index)
;; If this layout has some kind of compiler meta-info, then this is
;; it. If a structure, then we store the DEFSTRUCT-DESCRIPTION here.
\f
;;;; support for the hash values used by CLOS when working with LAYOUTs
-(defconstant layout-clos-hash-length 8)
+(def!constant layout-clos-hash-length 8)
#!-sb-fluid (declaim (inline layout-clos-hash))
(defun layout-clos-hash (layout i)
;; FIXME: Either this I should be declared to be `(MOD
(let ((old-length (layout-length old-layout)))
(unless (= old-length length)
(warn "change in instance length of class ~S:~% ~
- ~A length: ~D~% ~
- ~A length: ~D"
+ ~A length: ~W~% ~
+ ~A length: ~W"
name
old-context old-length
context length)
(declaim (ftype (function (symbol index simple-vector layout-depthoid) layout)
find-and-init-or-check-layout))
(defun find-and-init-or-check-layout (name length inherits depthoid)
- (/show0 "entering FIND-AND-INIT-OR-CHECK-LAYOUT")
(let ((layout (find-layout name)))
(init-or-check-layout layout
(or (sb!xc:find-class name nil)
); EVAL-WHEN
;;; Arrange the inherited layouts to appear at their expected depth,
-;;; ensuring that hierarchical type tests succeed. Layouts with a
-;;; specific depth are placed first, then the non- hierarchical
-;;; layouts fill remaining elements. Any empty elements are filled
-;;; with layout copies ensuring that all elements have a valid layout.
-;;; This re-ordering may destroy CPL ordering so the inherits should
-;;; not be read as being in CPL order, and further duplicates may be
-;;; introduced.
+;;; ensuring that hierarchical type tests succeed. Layouts with
+;;; DEPTHOID >= 0 (i.e. hierarchical classes) are placed first,
+;;; at exactly that index in the INHERITS vector. Then, non-hierarchical
+;;; layouts are placed in remaining elements. Then, any still-empty
+;;; elements are filled with their successors, ensuring that each
+;;; element contains a valid layout.
+;;;
+;;; This reordering may destroy CPL ordering, so the inherits should
+;;; not be read as being in CPL order.
(defun order-layout-inherits (layouts)
(declare (simple-vector layouts))
(let ((length (length layouts))
#-sb-xc (declare (type sb!xc:class new-value))
(ecase (info :type :kind name)
((nil))
+ (:forthcoming-defclass-type
+ ;; XXX Currently, nothing needs to be done in this case. Later, when
+ ;; PCL is integrated tighter into SBCL, this might need more work.
+ nil)
(:instance
(let ((old (class-of (sb!xc:find-class name)))
(new (class-of new-value)))
(character :enumerable t :translation base-char)
(base-char :enumerable t
:inherits (character)
- :codes (#.sb!vm:base-char-type))
- (symbol :codes (#.sb!vm:symbol-header-type))
+ :codes (#.sb!vm:base-char-widetag))
+ (symbol :codes (#.sb!vm:symbol-header-widetag))
(instance :state :read-only)
- (system-area-pointer :codes (#.sb!vm:sap-type))
- (weak-pointer :codes (#.sb!vm:weak-pointer-type))
- (code-component :codes (#.sb!vm:code-header-type))
- #!-gengc (lra :codes (#.sb!vm:return-pc-header-type))
- (fdefn :codes (#.sb!vm:fdefn-type))
+ (system-area-pointer :codes (#.sb!vm:sap-widetag))
+ (weak-pointer :codes (#.sb!vm:weak-pointer-widetag))
+ (code-component :codes (#.sb!vm:code-header-widetag))
+ (lra :codes (#.sb!vm:return-pc-header-widetag))
+ (fdefn :codes (#.sb!vm:fdefn-widetag))
(random-class) ; used for unknown type codes
(function
- :codes (#.sb!vm:byte-code-closure-type
- #.sb!vm:byte-code-function-type
- #.sb!vm:closure-header-type
- #.sb!vm:function-header-type)
+ :codes (#.sb!vm:closure-header-widetag
+ #.sb!vm:simple-fun-header-widetag)
:state :read-only)
(funcallable-instance
:inherits (function)
:state :read-only)
;; FIXME: Are COLLECTION and MUTABLE-COLLECTION used for anything
- ;; any more? COLLECTION is not defined in ANSI Common Lisp..
+ ;; any more? COLLECTION is not defined in ANSI Common Lisp.
+ ;; (Zhivago in #lisp IRC 2002-08-14 said that these things, and
+ ;; also GENERIC-FOO, are related to Dylan functionality and so
+ ;; truly are irrelevant these days.)
(collection :hierarchical-p nil :state :read-only)
(mutable-collection :state :read-only
:inherits (collection))
:inherits (generic-array
mutable-sequence mutable-collection
generic-sequence collection))
- (array :translation array :codes (#.sb!vm:complex-array-type)
+ (array :translation array :codes (#.sb!vm:complex-array-widetag)
:inherits (generic-array mutable-sequence mutable-collection
generic-sequence collection))
(simple-array
- :translation simple-array :codes (#.sb!vm:simple-array-type)
+ :translation simple-array :codes (#.sb!vm:simple-array-widetag)
:inherits (array generic-array mutable-sequence mutable-collection
generic-sequence collection))
(sequence
:inherits (mutable-sequence mutable-collection generic-sequence
collection))
(vector
- :translation vector :codes (#.sb!vm:complex-vector-type)
+ :translation vector :codes (#.sb!vm:complex-vector-widetag)
:direct-superclasses (array sequence generic-vector)
:inherits (array sequence generic-vector generic-array
mutable-sequence mutable-collection generic-sequence
collection))
(simple-vector
- :translation simple-vector :codes (#.sb!vm:simple-vector-type)
+ :translation simple-vector :codes (#.sb!vm:simple-vector-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array
sequence generic-vector generic-array
mutable-sequence mutable-collection
generic-sequence collection))
(bit-vector
- :translation bit-vector :codes (#.sb!vm:complex-bit-vector-type)
+ :translation bit-vector :codes (#.sb!vm:complex-bit-vector-widetag)
:inherits (vector array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-bit-vector
- :translation simple-bit-vector :codes (#.sb!vm:simple-bit-vector-type)
+ :translation simple-bit-vector :codes (#.sb!vm:simple-bit-vector-widetag)
:direct-superclasses (bit-vector simple-array)
:inherits (bit-vector vector simple-array
array sequence
mutable-collection generic-sequence collection))
(simple-array-unsigned-byte-2
:translation (simple-array (unsigned-byte 2) (*))
- :codes (#.sb!vm:simple-array-unsigned-byte-2-type)
+ :codes (#.sb!vm:simple-array-unsigned-byte-2-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-unsigned-byte-4
:translation (simple-array (unsigned-byte 4) (*))
- :codes (#.sb!vm:simple-array-unsigned-byte-4-type)
+ :codes (#.sb!vm:simple-array-unsigned-byte-4-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-unsigned-byte-8
:translation (simple-array (unsigned-byte 8) (*))
- :codes (#.sb!vm:simple-array-unsigned-byte-8-type)
+ :codes (#.sb!vm:simple-array-unsigned-byte-8-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-unsigned-byte-16
:translation (simple-array (unsigned-byte 16) (*))
- :codes (#.sb!vm:simple-array-unsigned-byte-16-type)
+ :codes (#.sb!vm:simple-array-unsigned-byte-16-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-unsigned-byte-32
:translation (simple-array (unsigned-byte 32) (*))
- :codes (#.sb!vm:simple-array-unsigned-byte-32-type)
+ :codes (#.sb!vm:simple-array-unsigned-byte-32-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-signed-byte-8
:translation (simple-array (signed-byte 8) (*))
- :codes (#.sb!vm:simple-array-signed-byte-8-type)
+ :codes (#.sb!vm:simple-array-signed-byte-8-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-signed-byte-16
:translation (simple-array (signed-byte 16) (*))
- :codes (#.sb!vm:simple-array-signed-byte-16-type)
+ :codes (#.sb!vm:simple-array-signed-byte-16-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-signed-byte-30
:translation (simple-array (signed-byte 30) (*))
- :codes (#.sb!vm:simple-array-signed-byte-30-type)
+ :codes (#.sb!vm:simple-array-signed-byte-30-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-signed-byte-32
:translation (simple-array (signed-byte 32) (*))
- :codes (#.sb!vm:simple-array-signed-byte-32-type)
+ :codes (#.sb!vm:simple-array-signed-byte-32-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-single-float
:translation (simple-array single-float (*))
- :codes (#.sb!vm:simple-array-single-float-type)
+ :codes (#.sb!vm:simple-array-single-float-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-double-float
:translation (simple-array double-float (*))
- :codes (#.sb!vm:simple-array-double-float-type)
+ :codes (#.sb!vm:simple-array-double-float-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
#!+long-float
(simple-array-long-float
:translation (simple-array long-float (*))
- :codes (#.sb!vm:simple-array-long-float-type)
+ :codes (#.sb!vm:simple-array-long-float-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-complex-single-float
:translation (simple-array (complex single-float) (*))
- :codes (#.sb!vm:simple-array-complex-single-float-type)
+ :codes (#.sb!vm:simple-array-complex-single-float-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
mutable-collection generic-sequence collection))
(simple-array-complex-double-float
:translation (simple-array (complex double-float) (*))
- :codes (#.sb!vm:simple-array-complex-double-float-type)
+ :codes (#.sb!vm:simple-array-complex-double-float-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
#!+long-float
(simple-array-complex-long-float
:translation (simple-array (complex long-float) (*))
- :codes (#.sb!vm:simple-array-complex-long-float-type)
+ :codes (#.sb!vm:simple-array-complex-long-float-widetag)
:direct-superclasses (vector simple-array)
:inherits (vector simple-array array sequence
generic-vector generic-array mutable-sequence
collection))
(string
:translation string
- :codes (#.sb!vm:complex-string-type)
+ :codes (#.sb!vm:complex-string-widetag)
:direct-superclasses (vector generic-string)
:inherits (vector array sequence
generic-vector generic-array generic-string
generic-sequence collection))
(simple-string
:translation simple-string
- :codes (#.sb!vm:simple-string-type)
+ :codes (#.sb!vm:simple-string-widetag)
:direct-superclasses (string simple-array)
:inherits (string vector simple-array
array sequence
:inherits (sequence mutable-sequence mutable-collection
generic-sequence collection))
(cons
- :codes (#.sb!vm:list-pointer-type)
+ :codes (#.sb!vm:list-pointer-lowtag)
:translation cons
:inherits (list sequence
mutable-sequence mutable-collection
generic-sequence collection))
(null
:translation (member nil)
- :inherits (list sequence
+ :inherits (symbol list sequence
mutable-sequence mutable-collection
- generic-sequence collection symbol)
- :direct-superclasses (list symbol))
+ generic-sequence collection)
+ :direct-superclasses (symbol list))
(generic-number :state :read-only)
(number :translation number :inherits (generic-number))
(complex
:translation complex
:inherits (number generic-number)
- :codes (#.sb!vm:complex-type))
+ :codes (#.sb!vm:complex-widetag))
(complex-single-float
:translation (complex single-float)
:inherits (complex number generic-number)
- :codes (#.sb!vm:complex-single-float-type))
+ :codes (#.sb!vm:complex-single-float-widetag))
(complex-double-float
:translation (complex double-float)
:inherits (complex number generic-number)
- :codes (#.sb!vm:complex-double-float-type))
+ :codes (#.sb!vm:complex-double-float-widetag))
#!+long-float
(complex-long-float
:translation (complex long-float)
:inherits (complex number generic-number)
- :codes (#.sb!vm:complex-long-float-type))
+ :codes (#.sb!vm:complex-long-float-widetag))
(real :translation real :inherits (number generic-number))
(float
:translation float
(single-float
:translation single-float
:inherits (float real number generic-number)
- :codes (#.sb!vm:single-float-type))
+ :codes (#.sb!vm:single-float-widetag))
(double-float
:translation double-float
:inherits (float real number generic-number)
- :codes (#.sb!vm:double-float-type))
+ :codes (#.sb!vm:double-float-widetag))
#!+long-float
(long-float
:translation long-float
:inherits (float real number generic-number)
- :codes (#.sb!vm:long-float-type))
+ :codes (#.sb!vm:long-float-widetag))
(rational
:translation rational
:inherits (real number generic-number))
(ratio
:translation (and rational (not integer))
:inherits (rational real number generic-number)
- :codes (#.sb!vm:ratio-type))
+ :codes (#.sb!vm:ratio-widetag))
(integer
:translation integer
:inherits (rational real number generic-number))
(fixnum
- :translation (integer #.sb!vm:*target-most-negative-fixnum*
- #.sb!vm:*target-most-positive-fixnum*)
+ :translation (integer #.sb!xc:most-negative-fixnum
+ #.sb!xc:most-positive-fixnum)
:inherits (integer rational real number
generic-number)
- :codes (#.sb!vm:even-fixnum-type #.sb!vm:odd-fixnum-type))
+ :codes (#.sb!vm:even-fixnum-lowtag #.sb!vm:odd-fixnum-lowtag))
(bignum
:translation (and integer (not fixnum))
:inherits (integer rational real number
generic-number)
- :codes (#.sb!vm:bignum-type))
+ :codes (#.sb!vm:bignum-widetag))
(stream
:state :read-only
:depth 3
(if (eq name t)
nil
(mapcar #'sb!xc:find-class direct-superclasses)))))
- (setf (info :type :kind name) :primitive
+ (setf (info :type :kind name) #+sb-xc-host :defined #-sb-xc-host :primitive
(class-cell-class (find-class-cell name)) class)
(unless trans-p
(setf (info :type :builtin name) class))
;;; is loaded and the class defined.
(!cold-init-forms
(/show0 "about to define temporary STANDARD-CLASSes")
- (dolist (x '(;; FIXME: The mysterious duplication of STREAM in the
- ;; list here here was introduced in sbcl-0.6.12.33, in
- ;; MNA's port of DTC's inline-type-tests patches for
- ;; CMU CL. I'm guessing that it has something to do
- ;; with preallocating just enough space in a table
- ;; later used by the final definition of
- ;; FUNDAMENTAL-STREAM (perhaps for Gray stream stuff?).
- ;; It'd be good to document this weirdness both here
- ;; and in the REGISTER-LAYOUT code which has to do the
- ;; right thing with the duplicates-containing
- ;; INHERITS-LIST.
+ (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
+ ;; 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
+ ;; filled, so STREAM is duplicated there (as
+ ;; ORDER-LAYOUTS-INHERITS would do). Maybe the
+ ;; duplicate definition could be removed (removing a
+ ;; STREAM element), because FUNDAMENTAL-STREAM is
+ ;; 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))))
(/show0 "defining temporary STANDARD-CLASS")
(let* ((name (first x))
;;; FIXME: It would be good to arrange for this to be called when the
;;; cross-compiler is being built, not just when the target Lisp is
;;; being cold loaded. Perhaps this could be moved to its own file
-;;; late in the stems-and-flags.lisp-expr sequence, and be put in
+;;; late in the build-order.lisp-expr sequence, and be put in
;;; !COLD-INIT-FORMS there?
(defun !class-finalize ()
(dohash (name layout *forward-referenced-layouts*)