X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Flate-type-vops.lisp;h=4a9016be4f2449207cdd2f764f9c48bc25bc5966;hb=d6f9676ae94419cb5544c45821a8d31adbc1fbe8;hp=b782be549800dae5a3e2a674d02c307c29306dee;hpb=63817d29028c8551cda23f432a3328acd7fdd62f;p=sbcl.git diff --git a/src/compiler/generic/late-type-vops.lisp b/src/compiler/generic/late-type-vops.lisp index b782be5..4a9016b 100644 --- a/src/compiler/generic/late-type-vops.lisp +++ b/src/compiler/generic/late-type-vops.lisp @@ -11,7 +11,7 @@ (in-package "SB!VM") (!define-type-vops fixnump check-fixnum fixnum object-not-fixnum-error - (even-fixnum-lowtag odd-fixnum-lowtag) + #.fixnum-lowtags ;; we can save a register on the x86. :variant simple ;; we can save a couple of instructions and a branch on the ppc. @@ -29,6 +29,10 @@ (instance-pointer-lowtag) :mask lowtag-mask) +(!define-type-vops %other-pointer-p nil nil nil + (other-pointer-lowtag) + :mask lowtag-mask) + (!define-type-vops bignump check-bignum bignum object-not-bignum-error (bignum-widetag)) @@ -37,7 +41,7 @@ (!define-type-vops complexp check-complex complex object-not-complex-error (complex-widetag complex-single-float-widetag complex-double-float-widetag - #!+long-float complex-long-float-widetag)) + #!+long-float complex-long-float-widetag)) (!define-type-vops complex-rational-p check-complex-rational nil object-not-complex-rational-error @@ -46,7 +50,7 @@ (!define-type-vops complex-float-p check-complex-float nil object-not-complex-float-error (complex-single-float-widetag complex-double-float-widetag - #!+long-float complex-long-float-widetag)) + #!+long-float complex-long-float-widetag)) (!define-type-vops complex-single-float-p check-complex-single-float complex-single-float object-not-complex-single-float-error @@ -66,21 +70,22 @@ (!define-type-vops simple-string-p check-simple-string nil object-not-simple-string-error - (simple-base-string-widetag simple-array-nil-widetag)) + (#!+sb-unicode simple-character-string-widetag + simple-base-string-widetag simple-array-nil-widetag)) (macrolet ((define-simple-array-type-vops () - `(progn - ,@(map 'list - (lambda (saetp) - (let ((primtype (saetp-primitive-type-name saetp))) - `(!define-type-vops - ,(symbolicate primtype "-P") - ,(symbolicate "CHECK-" primtype) - ,primtype - ,(symbolicate "OBJECT-NOT-" primtype "-ERROR") - (,(saetp-typecode saetp))))) - *specialized-array-element-type-properties*)))) + `(progn + ,@(map 'list + (lambda (saetp) + (let ((primtype (saetp-primitive-type-name saetp))) + `(!define-type-vops + ,(symbolicate primtype "-P") + ,(symbolicate "CHECK-" primtype) + ,primtype + ,(symbolicate "OBJECT-NOT-" primtype "-ERROR") + (,(saetp-typecode saetp))))) + *specialized-array-element-type-properties*)))) (define-simple-array-type-vops)) (!define-type-vops characterp check-character character @@ -109,11 +114,15 @@ (funcallable-instance-header-widetag)) (!define-type-vops array-header-p nil nil nil - (simple-array-widetag complex-base-string-widetag complex-bit-vector-widetag + (simple-array-widetag + #!+sb-unicode complex-character-string-widetag + complex-base-string-widetag complex-bit-vector-widetag complex-vector-widetag complex-array-widetag complex-vector-nil-widetag)) (!define-type-vops stringp check-string nil object-not-string-error - (simple-base-string-widetag complex-base-string-widetag + (#!+sb-unicode simple-character-string-widetag + #!+sb-unicode complex-character-string-widetag + simple-base-string-widetag complex-base-string-widetag simple-array-nil-widetag complex-vector-nil-widetag)) (!define-type-vops base-string-p check-base-string nil object-not-base-string-error @@ -127,16 +136,21 @@ object-not-vector-nil-error (simple-array-nil-widetag complex-vector-nil-widetag)) +#!+sb-unicode +(!define-type-vops character-string-p check-character-string nil + object-not-character-string-error + (simple-character-string-widetag complex-character-string-widetag)) + (!define-type-vops vectorp check-vector nil object-not-vector-error (complex-vector-widetag . #.(append (map 'list - #'saetp-typecode - *specialized-array-element-type-properties*) + #'saetp-typecode + *specialized-array-element-type-properties*) (mapcan (lambda (saetp) - (when (saetp-complex-typecode saetp) - (list (saetp-complex-typecode saetp)))) - (coerce *specialized-array-element-type-properties* 'list))))) + (when (saetp-complex-typecode saetp) + (list (saetp-complex-typecode saetp)))) + (coerce *specialized-array-element-type-properties* 'list))))) ;;; Note that this "type VOP" is sort of an oddball; it doesn't so ;;; much test for a Lisp-level type as just expose a low-level type @@ -156,8 +170,8 @@ object-not-simple-array-error (simple-array-widetag . #.(map 'list - #'saetp-typecode - *specialized-array-element-type-properties*))) + #'saetp-typecode + *specialized-array-element-type-properties*))) (!define-type-vops arrayp check-array nil object-not-array-error (simple-array-widetag @@ -165,17 +179,15 @@ complex-vector-widetag . #.(append (map 'list - #'saetp-typecode - *specialized-array-element-type-properties*) + #'saetp-typecode + *specialized-array-element-type-properties*) (mapcan (lambda (saetp) - (when (saetp-complex-typecode saetp) - (list (saetp-complex-typecode saetp)))) - (coerce *specialized-array-element-type-properties* 'list))))) + (when (saetp-complex-typecode saetp) + (list (saetp-complex-typecode saetp)))) + (coerce *specialized-array-element-type-properties* 'list))))) (!define-type-vops numberp check-number nil object-not-number-error - (even-fixnum-lowtag - odd-fixnum-lowtag - bignum-widetag + (bignum-widetag ratio-widetag single-float-widetag double-float-widetag @@ -183,22 +195,22 @@ complex-widetag complex-single-float-widetag complex-double-float-widetag - #!+long-float complex-long-float-widetag)) + #!+long-float complex-long-float-widetag + . #.fixnum-lowtags)) (!define-type-vops rationalp check-rational nil object-not-rational-error - (even-fixnum-lowtag odd-fixnum-lowtag ratio-widetag bignum-widetag)) + (ratio-widetag bignum-widetag . #.fixnum-lowtags)) (!define-type-vops integerp check-integer nil object-not-integer-error - (even-fixnum-lowtag odd-fixnum-lowtag bignum-widetag)) + (bignum-widetag . #.fixnum-lowtags)) (!define-type-vops floatp check-float nil object-not-float-error (single-float-widetag double-float-widetag #!+long-float long-float-widetag)) (!define-type-vops realp check-real nil object-not-real-error - (even-fixnum-lowtag - odd-fixnum-lowtag - ratio-widetag + (ratio-widetag bignum-widetag single-float-widetag double-float-widetag - #!+long-float long-float-widetag)) + #!+long-float long-float-widetag + . #.fixnum-lowtags))