X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Fprimtype.lisp;h=6b8a396ce2c271bb4ce03c300d5ca4ab36995d1a;hb=77c80b85dc9ae9bde0692d4193187bfca507b936;hp=3e330395c5f1e31e1f29e2e2dc55ecf57f8d62e0;hpb=ce02ab2ecd9c6ae2e570abd8c93ebf3be55bbdad;p=sbcl.git diff --git a/src/compiler/generic/primtype.lisp b/src/compiler/generic/primtype.lisp index 3e33039..6b8a396 100644 --- a/src/compiler/generic/primtype.lisp +++ b/src/compiler/generic/primtype.lisp @@ -18,7 +18,7 @@ (!def-primitive-type t (descriptor-reg)) (/show0 "primtype.lisp 20") -(setf *backend-t-primitive-type* (primitive-type-or-lose 't)) +(setf *backend-t-primitive-type* (primitive-type-or-lose t)) ;;; primitive integer types that fit in registers (/show0 "primtype.lisp 24") @@ -100,6 +100,8 @@ ;;; primitive other-pointer array types (/show0 "primtype.lisp 96") +(!def-primitive-type simple-array-nil (descriptor-reg) + :type (simple-array nil (*))) (!def-primitive-type simple-string (descriptor-reg) :type simple-base-string) (!def-primitive-type simple-bit-vector (descriptor-reg)) @@ -137,8 +139,8 @@ (!def-primitive-type simple-array-complex-long-float (descriptor-reg) :type (simple-array (complex long-float) (*))) -;;; Note: The complex array types are not included, 'cause it is pointless to -;;; restrict VOPs to them. +;;; Note: The complex array types are not included, 'cause it is +;;; pointless to restrict VOPs to them. ;;; other primitive other-pointer types (!def-primitive-type system-area-pointer (sap-reg descriptor-reg)) @@ -149,7 +151,7 @@ ;;;; PRIMITIVE-TYPE-OF and friends -;;; Return the most restrictive primitive type that contains Object. +;;; Return the most restrictive primitive type that contains OBJECT. (/show0 "primtype.lisp 147") (!def-vm-support-routine primitive-type-of (object) (let ((type (ctype-of object))) @@ -160,7 +162,8 @@ *backend-t-primitive-type*)))) (defvar *simple-array-primitive-types* - '((base-char . simple-string) + '((nil . simple-array-nil) + (base-char . simple-string) (bit . simple-bit-vector) ((unsigned-byte 2) . simple-array-unsigned-byte-2) ((unsigned-byte 4) . simple-array-unsigned-byte-4) @@ -363,11 +366,11 @@ (ecase (named-type-name type) ((t *) (values *backend-t-primitive-type* t)) ((nil) (any)))) - (sb!xc:built-in-class - (case (sb!xc:class-name type) + (built-in-classoid + (case (classoid-name type) ((complex function instance system-area-pointer weak-pointer) - (values (primitive-type-or-lose (sb!xc:class-name type)) t)) + (values (primitive-type-or-lose (classoid-name type)) t)) (funcallable-instance (part-of function)) (base-char @@ -376,13 +379,15 @@ (part-of list)) (t (any)))) - (function-type + (fun-type (exactly function)) - (sb!xc:class + (classoid (if (csubtypep type (specifier-type 'function)) (part-of function) (part-of instance))) (ctype - (any)))))) + (if (csubtypep type (specifier-type 'function)) + (part-of function) + (any))))))) (/show0 "primtype.lisp end of file")