X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fgeneric%2Flate-type-vops.lisp;h=c9a9602607087bd8d86ca96434ac5fa034dc9c46;hb=2a71a27c55ad98e36f2886017d45ca2ae986296d;hp=42bf1086805999ec71b79416ff91de052d77827b;hpb=51cf665f514935c8067f86f3850fd917731cada0;p=sbcl.git diff --git a/src/compiler/generic/late-type-vops.lisp b/src/compiler/generic/late-type-vops.lisp index 42bf108..c9a9602 100644 --- a/src/compiler/generic/late-type-vops.lisp +++ b/src/compiler/generic/late-type-vops.lisp @@ -15,8 +15,7 @@ ;; we can save a register on the x86. :variant simple ;; we can save a couple of instructions and a branch on the ppc. - ;; FIXME: make this be FIXNUM-MASK - :mask 3) + :mask fixnum-tag-mask) (!define-type-vops functionp check-fun function object-not-fun-error (fun-pointer-lowtag) @@ -57,11 +56,6 @@ object-not-complex-double-float-error (complex-double-float-widetag)) -#!+long-float -(!define-type-vops complex-long-float-p check-complex-long-float complex-long-float - object-not-complex-long-float-error - (complex-long-float-widetag)) - (!define-type-vops single-float-p check-single-float single-float object-not-single-float-error (single-float-widetag)) @@ -70,14 +64,10 @@ object-not-double-float-error (double-float-widetag)) -#!+long-float -(!define-type-vops long-float-p check-long-float long-float - object-not-long-float-error - (long-float-widetag)) - (!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 () @@ -94,9 +84,9 @@ *specialized-array-element-type-properties*)))) (define-simple-array-type-vops)) -(!define-type-vops base-char-p check-base-char base-char - object-not-base-char-error - (base-char-widetag)) +(!define-type-vops characterp check-character character + object-not-character-error + (character-widetag)) (!define-type-vops system-area-pointer-p check-system-area-pointer system-area-pointer @@ -120,11 +110,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 @@ -138,6 +132,11 @@ 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