0.8.20.6:

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

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index 8a72c68..ef5559c 100644 (file)
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -698,7 +698,7 @@
 ;;;
 ;;; FIXME: This should use the data in *RAW-SLOT-DATA-LIST*.
 (defun structure-raw-slot-type-and-size (type)
-  (cond ((and (sb!xc:subtypep type '(unsigned-byte 32))
+  (cond ((and (sb!xc:subtypep type 'sb!vm:word)
              (multiple-value-bind (fixnum? fixnum-certain?)
                  (sb!xc:subtypep type 'fixnum)
                ;; (The extra test for FIXNUM-CERTAIN? here is
@@ -843,15 +843,26 @@
              (classoid-layout (find-classoid
                                (or (first superclass-opt)
                                    'structure-object))))))
-    (if (eq (dd-name info) 'ansi-stream)
-       ;; a hack to add the CL:STREAM class as a mixin for ANSI-STREAMs
-       (concatenate 'simple-vector
-                    (layout-inherits super)
-                    (vector super
-                            (classoid-layout (find-classoid 'stream))))
-       (concatenate 'simple-vector
-                    (layout-inherits super)
-                    (vector super)))))
+    (case (dd-name info)
+      ((ansi-stream)
+       (concatenate 'simple-vector
+                   (layout-inherits super)
+                   (vector super (classoid-layout (find-classoid 'stream)))))
+      ((fd-stream)
+       (concatenate 'simple-vector
+                   (layout-inherits super)
+                   (vector super 
+                           (classoid-layout (find-classoid 'file-stream)))))
+      ((sb!impl::string-input-stream 
+       sb!impl::string-output-stream
+       sb!impl::fill-pointer-output-stream)
+       (concatenate 'simple-vector
+                   (layout-inherits super)
+                   (vector super
+                           (classoid-layout (find-classoid 'string-stream)))))
+      (t (concatenate 'simple-vector 
+                     (layout-inherits super)
+                     (vector super))))))
 
 ;;; Do miscellaneous (LOAD EVAL) time actions for the structure
 ;;; described by DD. Create the class and LAYOUT, checking for
@@ -914,8 +925,9 @@
                          ;; FIXME: when the 64-bit world rolls
                          ;; around, this will need to be reviewed,
                          ;; along with the whole RAW-SLOT thing.
-                         `(truly-the (simple-array (unsigned-byte 32) (*))
-                                     ,raw-vector-bare-form))
+                         `(truly-the
+                           (simple-array sb!vm:word (*))
+                           ,raw-vector-bare-form))
                        raw-vector-bare-form)))
              `(,raw-slot-accessor ,raw-vector-form ,scaled-dsd-index)))))))
 
@@ -1167,12 +1179,16 @@
                                     (sb!xc:typep x (find-classoid class))))
                               (fdefinition constructor)))
     (setf (classoid-direct-superclasses class)
-         (if (eq (dd-name info) 'ansi-stream)
-             ;; a hack to add CL:STREAM as a superclass mixin to ANSI-STREAMs
-             (list (layout-classoid (svref inherits (1- (length inherits))))
-                   (layout-classoid (svref inherits (- (length inherits) 2))))
-             (list (layout-classoid
-                    (svref inherits (1- (length inherits)))))))
+         (case (dd-name info)
+           ((ansi-stream 
+             fd-stream 
+             sb!impl::string-input-stream sb!impl::string-output-stream
+             sb!impl::fill-pointer-output-stream)
+            (list (layout-classoid (svref inherits (1- (length inherits))))
+                  (layout-classoid (svref inherits (- (length inherits) 2)))))
+           (t
+            (list (layout-classoid
+                   (svref inherits (1- (length inherits))))))))
     (let ((new-layout (make-layout :classoid class
                                   :inherits inherits
                                   :depthoid (length inherits)
@@ -1314,7 +1330,7 @@
         ,@(when raw-index
             `((setf (%instance-ref ,instance ,raw-index)
                     (make-array ,(dd-raw-length dd)
-                                :element-type '(unsigned-byte 32)))))
+                                :element-type 'sb!vm:word))))
         ,@(mapcar (lambda (dsd value)
                     ;; (Note that we can't in general use the
                     ;; ordinary named slot setter function here