X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fdefstruct.lisp;h=6508d2c8e8526141eba4dd9133662dd1a9578351;hb=f78c1fecf191e147ca081026cc11f2683ee80905;hp=8a72c68ce7612bbe214bdcb502b00e673cf09f42;hpb=af141fe8d840aeb9011e3c6d2d6492216a12304c;p=sbcl.git diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp index 8a72c68..6508d2c 100644 --- 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 @@ -822,8 +822,8 @@ modified (copy-structure included-slot)))) (when (and (neq (dsd-type new-slot) (dsd-type included-slot)) - (not (subtypep (dsd-type included-slot) - (dsd-type new-slot))) + (not (sb!xc:subtypep (dsd-type included-slot) + (dsd-type new-slot))) (dsd-safe-p included-slot)) (setf (dsd-safe-p new-slot) nil) ;; XXX: notify? @@ -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