0.7.6.20:

[sbcl.git] / src / code / class.lisp

diff --git a/src/code/class.lisp b/src/code/class.lisp
index 4b87df7..0733b25 100644 (file)
--- a/src/code/class.lisp
+++ b/src/code/class.lisp
@@ -29,7 +29,7 @@
             #+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
@@ -52,7 +52,7 @@
   ;; 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.
@@ -96,7 +96,7 @@
 ;;; 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")
 
@@ -175,7 +175,7 @@
   (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?
@@ -207,7 +207,7 @@
   ;;      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.
@@ -233,7 +233,7 @@
 \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
@@ -394,8 +394,8 @@
        (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)
@@ -441,7 +441,6 @@
 (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)
@@ -736,6 +735,10 @@
   #-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)))
@@ -1131,10 +1134,10 @@
                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
@@ -1182,8 +1185,8 @@
      :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-lowtag #.sb!vm:odd-fixnum-lowtag))
@@ -1228,7 +1231,7 @@
                    (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))
@@ -1336,7 +1339,7 @@
 ;;; 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*)