diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm
index 51938a018..edf338d08 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -476,13 +476,8 @@
         (#('fixnum? #f (a)) (unary emit-fixnum? a))
         (#('heap-object? #f (a)) (unary emit-heap-object? a))
         (#('char? #f (a)) (unary emit-char? a))
-        (#('eq-false? #f (a)) (unary emit-eq-false? a))
-        (#('eq-nil? #f (a)) (unary emit-eq-nil? a))
-        (#('eq-null? #f (a)) (unary emit-eq-null? a))
-        (#('eq-true? #f (a)) (unary emit-eq-true? a))
-        (#('unspecified? #f (a)) (unary emit-unspecified? a))
+        (#('eq-constant? imm (a)) (binary-test/imm emit-eq-immediate? a imm))
         (#('undefined? #f (a)) (unary emit-undefined? a))
-        (#('eof-object? #f (a)) (unary emit-eof-object? a))
         (#('null? #f (a)) (unary emit-null? a))
         (#('false? #f (a)) (unary emit-false? a))
         (#('nil? #f (a)) (unary emit-nil? a))
diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm
index 59f4191ca..f5021c86e 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -301,13 +301,8 @@ the LABELS that are clobbered by the effects of LABEL."
   ((equal? x y))
   ((fixnum? arg))
   ((char? arg))
-  ((eq-null? arg))
-  ((eq-nil? arg))
-  ((eq-false? arg))
-  ((eq-true? arg))
-  ((unspecified? arg))
+  ((eq-constant? arg))
   ((undefined? arg))
-  ((eof-object? arg))
   ((null? arg))
   ((false? arg))
   ((nil? arg))
diff --git a/module/language/cps/reify-primitives.scm b/module/language/cps/reify-primitives.scm
index 5fc86ccf5..494f1ca56 100644
--- a/module/language/cps/reify-primitives.scm
+++ b/module/language/cps/reify-primitives.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013-2019 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2020 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -557,8 +557,19 @@
          (define (u11? val) (<= 0 val #x7ff))
          (define (u12? val) (<= 0 val #xfff))
          (define (s12? val) (<= (- #x800) val #x7ff))
+         (define (imm16? val)
+           (and=> (scm->immediate-bits val)
+                  (lambda (bits)
+                    (truncate-bits bits 16 #t))))
+         (define (load-u64 k param)
+           (build-term ($continue k src ($primcall 'load-u64 param ()))))
+         (define (load-s64 k param)
+           (build-term ($continue k src ($primcall 'load-s64 param ()))))
+         (define (load-const k param)
+           (build-term ($continue k src ($const param))))
+
          (define-syntax-rule (reify-constants ((op (pred? c) in ...)
-                                               wrap-op (op* out ...))
+                                               wrap (op* out ...))
                                               ...
                                               (_ default))
            (match name
@@ -573,9 +584,7 @@
                              ($kargs ('c) (c)
                                ($branch kf kt src 'op* #f (out ...))))
                        (setk label
-                             ($kargs names vars
-                               ($continue kconst src
-                                 ($primcall 'wrap-op param ())))))))))
+                             ($kargs names vars ,(wrap kconst param))))))))
              ...
              (_ default)))
          (reify-constants
@@ -585,6 +594,7 @@
           ((s64-imm-= (s12? b) a) load-s64 (s64-= a b))
           ((s64-imm-< (s12? b) a) load-s64 (s64-< a b))
           ((imm-s64-< (s12? a) b) load-s64 (s64-< a b))
+          ((eq-constant? (imm16? b) a) load-const (eq? a b))
           (_ cps))))
       (($ $kargs names vars ($ $continue k src ($ $call proc args)))
        (with-cps cps
diff --git a/module/language/cps/type-fold.scm b/module/language/cps/type-fold.scm
index 7cefbd2e0..b87730c8d 100644
--- a/module/language/cps/type-fold.scm
+++ b/module/language/cps/type-fold.scm
@@ -43,6 +43,28 @@
 (define &scalar-types
   (logior &fixnum &bignum &flonum &char &special-immediate))
 
+(define (materialize-constant type min max kt kf)
+  (cond
+   ((zero? type) (kf))
+   ((not (and (zero? (logand type (1- type)))
+              (zero? (logand type (lognot &scalar-types)))
+              (eqv? min max))) (kf))
+   ((eqv? type &fixnum) (kt min))
+   ((eqv? type &bignum) (kt min))
+   ((eqv? type &flonum) (kt (exact->inexact min)))
+   ((eqv? type &char) (kt (integer->char min)))
+   ((eqv? type &special-immediate)
+    (cond
+     ((eqv? min &null) (kt '()))
+     ((eqv? min &nil) (kt #nil))
+     ((eqv? min &false) (kt #f))
+     ((eqv? min &true) (kt #t))
+     ((eqv? min &unspecified) (kt *unspecified*))
+     ;; FIXME: &undefined here
+     ((eqv? min &eof) (kt the-eof-object))
+     (else (kf))))
+   (else (kf))))
+
 (define *branch-folders* (make-hash-table))
 
 (define-syntax-rule (define-branch-folder op f)
@@ -63,7 +85,25 @@
                       body ...)
   (define-branch-folder op (lambda (param arg0 min0 max0 arg1 min1 max1) body ...)))
 
-(define-syntax-rule (define-special-immediate-predicate-folder op imin imax)
+(define (fold-eq-constant? ctype cval type min max)
+  (cond
+   ((zero? (logand type ctype)) (values #t #f))
+   ((eqv? type ctype)
+    (cond
+     ((or (< cval min) (< max cval)) (values #t #f))
+     ((= cval min max) (values #t #t))
+     (else (values #f #f))))
+   (else (values #f #f))))
+(define-unary-branch-folder* (eq-constant? param type min max)
+  (call-with-values (lambda () (constant-type param))
+    (lambda (ctype cval cval*)
+      ;; cval either equals cval* or is meaningless.
+      (fold-eq-constant? ctype cval type min max))))
+
+(define-unary-branch-folder (undefined? type min max)
+  (fold-eq-constant? &special-immediate &undefined type min max))
+
+(define-syntax-rule (define-nullish-predicate-folder op imin imax)
   (define-unary-branch-folder (op type min max)
     (let ((type* (logand type &special-immediate)))
       (cond
@@ -75,16 +115,9 @@
          (else (values #f #f))))
        (else (values #f #f))))))
 
-(define-special-immediate-predicate-folder eq-nil? &nil &nil)
-(define-special-immediate-predicate-folder eq-eol? &null &null)
-(define-special-immediate-predicate-folder eq-false? &false &false)
-(define-special-immediate-predicate-folder eq-true? &true &true)
-(define-special-immediate-predicate-folder unspecified? &unspecified &unspecified)
-(define-special-immediate-predicate-folder undefined? &undefined &undefined)
-(define-special-immediate-predicate-folder eof-object? &eof &eof)
-(define-special-immediate-predicate-folder null? &null &nil)
-(define-special-immediate-predicate-folder false? &nil &false)
-(define-special-immediate-predicate-folder nil? &null &false) ;; &nil in middle
+(define-nullish-predicate-folder null? &null &nil)
+(define-nullish-predicate-folder false? &nil &false)
+(define-nullish-predicate-folder nil? &null &false) ;; &nil in middle
 
 (define-syntax-rule (define-unary-type-predicate-folder op &type)
   (define-unary-branch-folder (op type min max)
@@ -217,6 +250,41 @@
 (define-branch-folder-alias s64-= u64-=)
 
 
+
+
+(define *branch-reducers* (make-hash-table))
+
+(define-syntax-rule (define-branch-reducer op f)
+  (hashq-set! *branch-reducers* 'op f))
+
+(define-syntax-rule (define-binary-branch-reducer
+                      (op cps kf kt src
+                          arg0 type0 min0 max0
+                          arg1 type1 min1 max1)
+                      body ...)
+  (define-branch-reducer op
+    (lambda (cps kf kt src param arg0 type0 min0 max0 arg1 type1 min1 max1)
+      body ...)))
+
+(define-binary-branch-reducer (eq? cps kf kt src
+                                   arg0 type0 min0 max0
+                                   arg1 type1 min1 max1)
+  (materialize-constant
+   type0 min0 max0
+   (lambda (const)
+     (with-cps cps
+       (build-term
+         ($branch kf kt src 'eq-constant? const (arg1)))))
+   (lambda ()
+     (materialize-constant
+      type1 min1 max1
+      (lambda (const)
+        (with-cps cps
+          (build-term
+            ($branch kf kt src 'eq-constant? const (arg0)))))
+      (lambda () (with-cps cps #f))))))
+
+
 
 
 ;; Convert e.g. rsh to rsh/immediate.
@@ -535,45 +603,24 @@
 
 
 
-;;
-
 (define (local-type-fold start end cps)
-  (define (scalar-value type val)
-    (cond
-     ((eqv? type &fixnum) val)
-     ((eqv? type &bignum) val)
-     ((eqv? type &flonum) (exact->inexact val))
-     ((eqv? type &char) (integer->char val))
-     ((eqv? type &special-immediate)
-      (cond
-       ((eqv? val &null) '())
-       ((eqv? val &nil) #nil)
-       ((eqv? val &false) #f)
-       ((eqv? val &true) #t)
-       ((eqv? val &unspecified) *unspecified*)
-       ;; FIXME: &undefined here
-       ((eqv? val &eof) the-eof-object)
-       (else (error "unhandled immediate" val))))
-     (else (error "unhandled type" type val))))
   (let ((types (infer-types cps start)))
     (define (fold-primcall cps label names vars k src op param args def)
       (call-with-values (lambda () (lookup-post-type types label def 0))
         (lambda (type min max)
-          (and (not (zero? type))
-               (zero? (logand type (1- type)))
-               (zero? (logand type (lognot &scalar-types)))
-               (eqv? min max)
-               (let ((val (scalar-value type min)))
-                 ;; (pk 'folded src op args val)
-                 (with-cps cps
-                   (letv v*)
-                   (letk k* ($kargs (#f) (v*)
-                              ($continue k src ($const val))))
-                   ;; Rely on DCE to elide this expression, if
-                   ;; possible.
-                   (setk label
-                         ($kargs names vars
-                           ($continue k* src ($primcall op param args))))))))))
+          (materialize-constant
+           type min max
+           (lambda (val)
+             ;; (pk 'folded src op args val)
+             (with-cps cps
+               (letv v*)
+               (letk k* ($kargs (#f) (v*)
+                          ($continue k src ($const val))))
+               ;; Rely on DCE to elide this expression, if possible.
+               (setk label
+                     ($kargs names vars
+                       ($continue k* src ($primcall op param args))))))
+           (lambda () #f)))))
     (define (transform-primcall f cps label names vars k src op param args)
       (and f
            (match args
@@ -611,6 +658,25 @@
        ((transform-primcall (hashq-ref *primcall-reducers* op)
                             cps label names vars k src op param args))
        (else cps)))
+    (define (reduce-branch cps label names vars kf kt src op param args)
+      (and=>
+       (hashq-ref *branch-reducers* op)
+       (lambda (reducer)
+         (match args
+           ((arg0 arg1)
+            (call-with-values (lambda () (lookup-pre-type types label arg0))
+              (lambda (type0 min0 max0)
+                (call-with-values (lambda () (lookup-pre-type types label arg1))
+                  (lambda (type1 min1 max1)
+                    (call-with-values (lambda ()
+                                        (reducer cps kf kt src param
+                                                 arg0 type0 min0 max0
+                                                 arg1 type1 min1 max1))
+                      (lambda (cps term)
+                        (and term
+                             (with-cps cps
+                               (setk label
+                                     ($kargs names vars ,term)))))))))))))))
     (define (fold-unary-branch cps label names vars kf kt src op param arg)
       (and=>
        (hashq-ref *branch-folders* op)
@@ -644,6 +710,12 @@
                                   ($kargs names vars
                                     ($continue (if v kt kf) src
                                       ($values ())))))))))))))))
+    (define (fold-branch cps label names vars kf kt src op param args)
+      (match args
+        ((x)
+         (fold-unary-branch cps label names vars kf kt src op param x))
+        ((x y)
+         (fold-binary-branch cps label names vars kf kt src op param x y))))
     (define (visit-primcall cps label names vars k src op param args)
       ;; We might be able to fold primcalls that define a value.
       (match (intmap-ref cps k)
@@ -654,13 +726,9 @@
          (reduce-primcall cps label names vars k src op param args))))
     (define (visit-branch cps label names vars kf kt src op param args)
       ;; We might be able to fold primcalls that branch.
-      (match args
-        ((x)
-         (or (fold-unary-branch cps label names vars kf kt src op param x)
-             cps))
-        ((x y)
-         (or (fold-binary-branch cps label names vars kf kt src op param x y)
-             cps))))
+      (or (fold-branch cps label names vars kf kt src op param args)
+          (reduce-branch cps label names vars kf kt src op param args)
+          cps))
     (let lp ((label start) (cps cps))
       (if (<= label end)
           (lp (1+ label)
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 88301ba4b..1c85da112 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -127,6 +127,7 @@
             type<=?
 
             ;; Interface for type inference.
+            constant-type
             infer-types
             lookup-pre-type
             lookup-post-type
@@ -342,8 +343,8 @@
 minimum, and maximum."
   (define (return type val)
     (if val
-        (make-type-entry type val val)
-        (make-type-entry type -inf.0 +inf.0)))
+        (values type val val)
+        (values type -inf.0 +inf.0)))
   (cond
    ((number? val)
     (cond
@@ -356,8 +357,8 @@ minimum, and maximum."
               val))
      ((eqv? (imag-part val) 0)
       (if (nan? val)
-          (make-type-entry &flonum -inf.0 +inf.0)
-          (make-type-entry
+          (values &flonum -inf.0 +inf.0)
+          (values
            (if (exact? val) &fraction &flonum)
            (if (rational? val) (inexact->exact (floor val)) val)
            (if (rational? val) (inexact->exact (ceiling val)) val))))
@@ -382,6 +383,13 @@ minimum, and maximum."
 
    (else (error "unhandled constant" val))))
 
+(define (constant-type-entry val)
+  "Compute the type and range of VAL.  Return three values: the type,
+minimum, and maximum."
+  (call-with-values (lambda () (constant-type val))
+    (lambda (type min max)
+      (make-type-entry type min max))))
+
 (define *type-checkers* (make-hash-table))
 (define *type-inferrers* (make-hash-table))
 
@@ -570,25 +578,28 @@ minimum, and maximum."
 ;;; Generic effect-free predicates.
 ;;;
 
-(define-syntax-rule (define-special-immediate-predicate-inferrer pred imm)
-  (define-predicate-inferrer (pred val true?)
+(define-syntax-rule (infer-constant-comparison ctype cval val true?)
+  (let ()
     (define (range-subtract lo hi x)
       (values (if (eqv? lo x) (1+ lo) lo)
               (if (eqv? hi x) (1- hi) hi)))
-    (cond
-     (true? (restrict! val &special-immediate imm imm))
-     (else
-      (when (eqv? (&type val) &special-immediate)
-        (let-values (((lo hi) (range-subtract (&min val) (&max val) imm)))
-          (restrict! val &special-immediate lo hi)))))))
+   (cond
+    (true? (restrict! val ctype cval cval))
+    (else
+     (when (eqv? (&type val) ctype)
+       (let-values (((lo hi) (range-subtract (&min val) (&max val) cval)))
+         (restrict! val ctype lo hi)))))))
 
-(define-special-immediate-predicate-inferrer eq-nil? &nil)
-(define-special-immediate-predicate-inferrer eq-eol? &null)
-(define-special-immediate-predicate-inferrer eq-false? &false)
-(define-special-immediate-predicate-inferrer eq-true? &true)
-(define-special-immediate-predicate-inferrer unspecified? &unspecified)
-(define-special-immediate-predicate-inferrer undefined? &undefined)
-(define-special-immediate-predicate-inferrer eof-object? &eof)
+(define-predicate-inferrer/param (eq-constant? c val true?)
+  (call-with-values (lambda () (constant-type c))
+    (lambda (ctype cval cval*)
+      ;; Either (= cval cval*), or the value is meaningless for this type.
+      (infer-constant-comparison ctype cval val true?))))
+
+;; Can't usefully pass undefined as a parameter to eq-constant?, so we
+;; keep its special predicate.
+(define-predicate-inferrer (undefined? val true?)
+  (infer-constant-comparison &special-immediate &undefined val true?))
 
 ;; Various inferrers rely on these having contiguous values starting from 0.
 (eval-when (expand)
@@ -702,7 +713,7 @@ minimum, and maximum."
 
 
 (define-type-inferrer/param (load-const/unlikely param result)
-  (let ((ent (constant-type param)))
+  (let ((ent (constant-type-entry param)))
     (define! result (type-entry-type ent)
       (type-entry-min ent) (type-entry-max ent))))
 
@@ -1099,7 +1110,7 @@ minimum, and maximum."
                          (+ (&min a) (&min b))
                          (+ (&max a) (&max b))))
 (define-type-inferrer/param (add/immediate param a result)
-  (let ((b-type (type-entry-type (constant-type param))))
+  (let ((b-type (type-entry-type (constant-type-entry param))))
     (define-binary-result! (&type a) b-type result #t
       (+ (&min a) param)
       (+ (&max a) param))))
@@ -1143,7 +1154,7 @@ minimum, and maximum."
                          (- (&min a) (&max b))
                          (- (&max a) (&min b))))
 (define-type-inferrer/param (sub/immediate param a result)
-  (let ((b-type (type-entry-type (constant-type param))))
+  (let ((b-type (type-entry-type (constant-type-entry param))))
     (define-binary-result! (&type a) b-type result #t
       (- (&min a) param)
       (- (&max a) param))))
@@ -2027,7 +2038,7 @@ maximum, where type is a bitset as a fixnum."
          (($ $kargs (_) (var))
           (let ((entry (match exp
                          (($ $const val)
-                          (constant-type val))
+                          (constant-type-entry val))
                          ((or ($ $prim) ($ $fun) ($ $const-fun) ($ $code))
                           ;; Could be more precise here.
                           (make-type-entry &procedure -inf.0 +inf.0)))))
diff --git a/module/language/tree-il/compile-bytecode.scm b/module/language/tree-il/compile-bytecode.scm
index b6569c7dd..419f5c8d3 100644
--- a/module/language/tree-il/compile-bytecode.scm
+++ b/module/language/tree-il/compile-bytecode.scm
@@ -300,7 +300,7 @@
                                             (and=>
                                              (scm->immediate-bits x)
                                              (lambda (bits)
-                                               (truncate-bits bits 16 x))))
+                                               (truncate-bits bits 16 #t))))
                     #:emit/immediate (lambda (asm a b kf)
                                        (emit-eq-immediate? asm a b)
                                        (emit-jne asm kf)))
@@ -326,9 +326,12 @@
        #`(lambda (asm a kf)
            (#,(id-prepend 'emit- #'pred) asm a)
            (emit-jne asm kf))))))
-(define-syntax-rule (define-immediate-type-predicate name pred mask tag)
-  (define-primitive pred #:nargs 1 #:predicate? #t
-    #:emit (predicate-emitter pred)))
+(define-syntax define-immediate-type-predicate
+  (syntax-rules ()
+    ((_ name #f mask tag) #f)
+    ((_ name pred mask tag)
+     (define-primitive pred #:nargs 1 #:predicate? #t
+       #:emit (predicate-emitter pred)))))
 (define-syntax-rule (define-heap-type-predicate name pred mask tag)
   (define-primitive pred #:nargs 1 #:predicate? #t
     #:emit (lambda (asm a kf)
diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm
index 9484e84dc..f0c7de609 100644
--- a/module/language/tree-il/compile-cps.scm
+++ b/module/language/tree-il/compile-cps.scm
@@ -2107,6 +2107,18 @@
     (($ <conditional> src test consequent alternate)
      (define (convert-test cps test kt kf)
        (match test
+         (($ <primcall> src 'eq? (a ($ <const> _ b)))
+          (convert-arg cps a
+            (lambda (cps a)
+              (with-cps cps
+                (build-term ($branch kf kt src 'eq-constant? b (a)))))))
+
+         (($ <primcall> src 'eq? (($ <const> _ a) b))
+          (convert-arg cps b
+            (lambda (cps b)
+              (with-cps cps
+                (build-term ($branch kf kt src 'eq-constant? a (b)))))))
+
          (($ <primcall> src (? branching-primitive? name) args)
           (convert-args cps args
             (lambda (cps args)
@@ -2365,25 +2377,6 @@ integer."
                           (make-const src #t)
                           (make-const src #f)))
 
-       ;; Specialize eq?.
-       (($ <primcall> src 'eq? (a b))
-        (define (reify-branch test args)
-          ;; No need to reduce as test is a branching primitive.
-          (make-conditional src (make-primcall src test args)
-                            (make-const src #t)
-                            (make-const src #f)))
-        (let ((a (if (const? b) a b))
-              (b (if (const? b) b a)))
-          (define (simplify test) (reify-branch test (list a)))
-          (match b
-            (($ <const> _ '()) (simplify 'eq-null?))
-            (($ <const> _ #f) (simplify 'eq-false?))
-            (($ <const> _ #t) (simplify 'eq-true?))
-            (($ <const> _ #nil) (simplify 'eq-nil?))
-            (($ <const> _ (? unspecified?)) (simplify 'unspecified?))
-            (($ <const> _ (? eof-object?)) (simplify 'eof-object?))
-            (_ (reify-branch 'eq? (list a b))))))
-
        (($ <primcall> src (? branching-primitive? name) args)
         ;; No need to reduce because test is not reducible: reifying
         ;; #t/#f is the right thing.
diff --git a/module/language/tree-il/cps-primitives.scm b/module/language/tree-il/cps-primitives.scm
index 8534599fa..196461904 100644
--- a/module/language/tree-il/cps-primitives.scm
+++ b/module/language/tree-il/cps-primitives.scm
@@ -1,6 +1,6 @@
 ;;; Continuation-passing style (CPS) intermediate language (IL)
 
-;; Copyright (C) 2013-2015, 2017-2019 Free Software Foundation, Inc.
+;; Copyright (C) 2013-2015, 2017-2020 Free Software Foundation, Inc.
 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -160,8 +160,11 @@
 (define-syntax-rule (define-branching-primitive name nargs)
   (hashq-set! *branching-primitive-arities* 'name '(0 . nargs)))
 
-(define-syntax-rule (define-immediate-type-predicate name pred mask tag)
-  (define-branching-primitive pred 1))
+(define-syntax define-immediate-type-predicate
+  (syntax-rules ()
+    ((_ name #f mask tag) #f)
+    ((_ name pred mask tag)
+     (define-branching-primitive pred 1))))
 (define *heap-type-predicates* (make-hash-table))
 (define-syntax-rule (define-heap-type-predicate name pred mask tag)
   (begin
diff --git a/module/system/base/types/internal.scm b/module/system/base/types/internal.scm
index 768deae92..c75ca3bf6 100644
--- a/module/system/base/types/internal.scm
+++ b/module/system/base/types/internal.scm
@@ -103,13 +103,16 @@
   (fixnum           fixnum?                     #b11            #b10)
   (heap-object      heap-object?               #b111           #b000)
   (char             char?                 #b11111111      #b00001100)
-  (false            eq-false?         #b111111111111  #b000000000100)
-  (nil              eq-nil?           #b111111111111  #b000100000100)
-  (null             eq-null?          #b111111111111  #b001100000100)
-  (true             eq-true?          #b111111111111  #b010000000100)
-  (unspecified      unspecified?      #b111111111111  #b100000000100)
   (undefined        undefined?        #b111111111111  #b100100000100)
-  (eof              eof-object?       #b111111111111  #b101000000100)
+
+  ;; To check for these values from Scheme, use eq?.  From assembler,
+  ;; use eq-immediate?.
+  (false            #f                #b111111111111  #b000000000100)
+  (nil              #f                #b111111111111  #b000100000100)
+  (null             #f                #b111111111111  #b001100000100)
+  (true             #f                #b111111111111  #b010000000100)
+  (unspecified      #f                #b111111111111  #b100000000100)
+  (eof              #f                #b111111111111  #b101000000100)
 
   ;;(nil            eq-nil?           #b111111111111  #b000100000100)
   ;;(eol            eq-null?          #b111111111111  #b001100000100)
@@ -200,24 +203,24 @@ may not fit into a word on the target platform."
    ((eq? x #t)         %tc16-true)
    ((unspecified? x)   %tc16-unspecified)
    ;; FIXME: %tc16-undefined.
-   ((eof-object? x)  %tc16-eof)
+   ((eof-object? x)    %tc16-eof)
    (else #f)))
 
 (define (immediate-bits->scm imm)
   "Return the SCM object corresponding to the immediate encoding
 @code{imm}.  Note that this value should be sign-extended already."
   (define-syntax-rule (define-predicate name pred mask tag)
-    (define (pred) (eqv? (logand imm mask) tag)))
+    (define (name) (eqv? (logand imm mask) tag)))
   (visit-immediate-tags define-predicate)
   (cond
-   ((fixnum?)      (ash imm -2))
-   ((char?)        (integer->char (ash imm -8)))
-   ((eq-false?)    #f)
-   ((eq-nil?)      #nil)
-   ((eq-null?)     '())
-   ((eq-true?)     #t)
-   ((unspecified?) (if #f #f))
-   ((eof-object?)  the-eof-object)
+   ((fixnum)      (ash imm -2))
+   ((char)        (integer->char (ash imm -8)))
+   ((false)       #f)
+   ((nil)         #nil)
+   ((null)        '())
+   ((true)        #t)
+   ((unspecified) (if #f #f))
+   ((eof)         the-eof-object)
    (else (error "invalid immediate" imm))) )
 
 (define (sign-extend x bits)
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 8f67cac51..698d44dac 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -95,14 +95,7 @@
             emit-fixnum?
             emit-heap-object?
             emit-char?
-            emit-eq-null?
-            emit-eq-nil?
-            emit-eq-false?
-            emit-eq-true?
-            emit-unspecified?
             emit-undefined?
-            emit-eof-object?
-
             emit-null?
             emit-false?
             emit-nil?
@@ -1390,9 +1383,12 @@ returned instead."
   (let ((loc (intern-constant asm (make-static-procedure label))))
     (emit-make-non-immediate asm dst loc)))
 
-(define-syntax-rule (define-immediate-tag=?-macro-assembler name pred mask tag)
-  (define-macro-assembler (pred asm slot)
-    (emit-immediate-tag=? asm slot mask tag)))
+(define-syntax define-immediate-tag=?-macro-assembler
+  (syntax-rules ()
+    ((_ name #f mask tag) #f)
+    ((_ name pred mask tag)
+     (define-macro-assembler (pred asm slot)
+       (emit-immediate-tag=? asm slot mask tag)))))
 
 (visit-immediate-tags define-immediate-tag=?-macro-assembler)
 
diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm
index 28f4338d6..cc055491d 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -195,7 +195,11 @@ address of that offset."
 (define immediate-tag-annotations '())
 (define-syntax-rule (define-immediate-tag-annotation name pred mask tag)
   (set! immediate-tag-annotations
-        (cons `((,mask ,tag) ,(symbol->string 'pred)) immediate-tag-annotations)))
+        (cons `((,mask ,tag)
+                ,(cond
+                  ('pred => symbol->string)
+                  (else (string-append "eq-" (symbol->string 'name) "?"))))
+              immediate-tag-annotations)))
 (visit-immediate-tags define-immediate-tag-annotation)
 
 (define heap-tag-annotations '())