diff --git a/src/code/room.lisp b/src/code/room.lisp
index 08bc585324..19964bc1bf 100644
--- a/src/code/room.lisp
+++ b/src/code/room.lisp
@@ -1058,20 +1058,8 @@ We could try a few things to mitigate this:
                ;;        do (,functoid (%code-entry-point ,obj .i.) ,@more)))
                ;; and/or visit the slots of each simple-fun but not the fun per se.
                )
-            ,.(make-case '(or float #+sb-simd-pack simd-pack
+            ,.(make-case '(or float bignum #+sb-simd-pack simd-pack
                               system-area-pointer)) ; nothing to do
-            ;; FIXME: (TYPEP x 'BIGNUM) is correctly implemented as a test of
-            ;; lowtag and widetag, but (TYPEP x '(OR BIGNUM ANYTHING-ELSE))
-            ;; is "mildly incorrectly" implemented as
-            ;;   `(OR (INTEGER * ,(1- most-negative-fixnum))
-            ;;        (INTEGER (1+ most-positive-fixnum))
-            ;;        anything-else)
-            ;; And this has busted semantics for our purposes here.
-            ;; Uncanonical bignums (which would normalize to a fixnum)
-            ;; do not satisy the range test.
-            ;; So in order to avoid reaching the T case, we have to split out
-            ;; BIGNUM all by itself, which becomes a pointer test.
-            ,.(make-case 'bignum)
             ,.(make-case 'weak-pointer `(weak-pointer-value ,obj))
             ,.(make-case 'ratio `(%numerator ,obj) `(%denominator ,obj))
             ;; Use the non-primitive slot readers because we don't know
diff --git a/src/compiler/generic/vm-type.lisp b/src/compiler/generic/vm-type.lisp
index c4427c8d7a..3a32ec2c69 100644
--- a/src/compiler/generic/vm-type.lisp
+++ b/src/compiler/generic/vm-type.lisp
@@ -286,6 +286,15 @@
     (unless (and info (sb!c::fun-info-templates info))
       (return-from widetags-from-union-type (values nil types))))
   (let (widetags remainder)
+    ;; A little optimization for (OR BIGNUM other). Without this, there would
+    ;; be a two-sided GENERIC-{<,>} test plus whatever test(s) "other" entails.
+    (let ((neg-bignum (specifier-type `(integer * (,most-negative-fixnum))))
+          (pos-bignum (specifier-type `(integer (,most-positive-fixnum) *))))
+      (when (and (member neg-bignum types :test #'type=)
+                 (member pos-bignum types :test #'type=))
+        (push sb!vm:bignum-widetag widetags)
+        (setf types (remove-if (lambda (x) (or (type= x neg-bignum) (type= x pos-bignum)))
+                               types))))
     (dolist (x types)
       (let ((adjunct
              (cond
diff --git a/tests/compiler-2.pure.lisp b/tests/compiler-2.pure.lisp
index 5f02db8de3..70db45af5b 100644
--- a/tests/compiler-2.pure.lisp
+++ b/tests/compiler-2.pure.lisp
@@ -1425,3 +1425,8 @@
       ()
       `(lambda (x y)
          (write-sequence nil (the standard-object x) y nil))))
+
+(with-test (:name :or-bignum-single-float-no-warn)
+  (checked-compile
+   '(lambda (x) (declare (optimize speed)) (typep x '(or bignum single-float)))
+   :allow-notes nil))