Implement unsigned-byte-x-p for x86-64.

3 files changed, 67 insertions, 3 deletions

diff --git a/src/compiler/arm64/type-vops.lisp b/src/compiler/arm64/type-vops.lisp
index 8e29b0866..6e7c90db6 100644
--- a/src/compiler/arm64/type-vops.lisp
+++ b/src/compiler/arm64/type-vops.lisp
@@ -371,9 +371,16 @@
           (inst lsr temp temp n-widetag-bits)
           (inst cmp temp (add-sub-immediate (1+ (/ x n-word-bits))))
           (inst b :gt nope)
-          (inst b :lt fixnum)
+          (inst b :lt (if unsigned-p
+                          yep
+                          fixnum))
           ;; Is it a sign-extended sign bit
-          (inst cbnz last-digit nope)
+          (cond ((not unsigned-p)
+                 (inst cbnz last-digit nope))
+                (not-p
+                 (inst cbnz last-digit target))
+                (t
+                 (inst cbz last-digit target)))
 
           fixnum
           (unless unsigned-p
diff --git a/src/compiler/generic/utils.lisp b/src/compiler/generic/utils.lisp
index 33a1840b9..118ba1b60 100644
--- a/src/compiler/generic/utils.lisp
+++ b/src/compiler/generic/utils.lisp
@@ -441,7 +441,7 @@
 
 ;;; Convert # of "big digits" (= words, sometimes called "limbs") to a header value.
 (defmacro bignum-header-for-length (n)
-  (logior (ash n n-widetag-bits) bignum-widetag))
+  `(logior (ash ,n n-widetag-bits) bignum-widetag))
 
 (defmacro id-bits-offset ()
   (let ((slot (get-dsd-index layout sb-kernel::id-word0)))
diff --git a/src/compiler/x86-64/type-vops.lisp b/src/compiler/x86-64/type-vops.lisp
index 0ef38c967..eea9bad12 100644
--- a/src/compiler/x86-64/type-vops.lisp
+++ b/src/compiler/x86-64/type-vops.lisp
@@ -463,6 +463,63 @@
 
         (emit-label not-target)))))
 
+(define-vop (unsigned-byte-x-p type-predicate)
+  (:arg-types * (:constant (integer 1)))
+  (:translate sb-c::unsigned-byte-x-p)
+  (:info target not-p x)
+  (:temporary (:sc unsigned-reg) last-digit)
+  (:generator 10
+    (let* ((type (tn-ref-type args))
+           (fixnum-p (types-equal-or-intersect type (specifier-type 'fixnum)))
+           (integer-p (csubtypep type (specifier-type 'integer)))
+           (unsigned-p (not (types-equal-or-intersect type (specifier-type '(integer * -1))))))
+      (multiple-value-bind (yep nope)
+          (if not-p
+              (values not-target target)
+              (values target not-target))
+        (assemble ()
+          (when fixnum-p
+            (cond (unsigned-p
+                   (inst test :byte value fixnum-tag-mask)
+                   (inst jmp :z yep))
+                  (t ;; Is it a fixnum with the sign bit clear?
+                   (inst test (ea non-negative-fixnum-mask-constant-wired-address) value)
+                   (inst jmp :z yep))))
+          (cond ((fixnum-or-other-pointer-tn-ref-p args t)
+                 (when (and fixnum-p
+                            (not unsigned-p))
+                   (inst test :byte value fixnum-tag-mask)
+                   (inst jmp :z nope)))
+                (t
+                 (%lea-for-lowtag-test temp value other-pointer-lowtag)
+                 (inst test :byte temp lowtag-mask)
+                 (inst jmp :ne nope)))
+          ;; Get the header.
+          (loadw temp value 0 other-pointer-lowtag)
+          (unless integer-p
+            (inst cmp :byte temp bignum-widetag)
+            (inst jmp :ne nope))
+          (inst shr temp n-widetag-bits)
+          (inst cmp :dword temp (1+ (/ x n-word-bits)))
+          (inst jmp :g nope)
+          ;; Is it a sign-extended sign bit
+          (cond (unsigned-p
+                 (inst jmp :l yep)
+                 (inst cmp :dword (ea (+ (- other-pointer-lowtag) (/ n-word-bytes 2))
+                                      value temp n-word-bytes)
+                       0)
+                 (inst jmp (if not-p :nz :z) target))
+                (t
+                 (inst mov last-digit (ea (- other-pointer-lowtag) value temp n-word-bytes))
+                 (inst jmp :l fixnum)
+                 (inst test last-digit last-digit)
+                 (inst jmp :nz nope)))
+          fixnum
+          (unless unsigned-p
+            (inst test last-digit last-digit)
+            (inst jmp (if not-p :s :ns) target)))))
+    not-target))
+
 ;;; SINGLE-FLOAT-P, CHARACTERP, UNBOUND-MARKER-P produce a flag result
 ;;; and never need a temporary.
 (macrolet ((define (name widetag)