diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 33d2b7b52..99ff7804f 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -3503,12 +3503,112 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       RETURN_EXP (scm_logand (x, scm_lognot (y)));
     }
 
-  VM_DEFINE_OP (162, unused_162, NULL, NOP)
-  VM_DEFINE_OP (163, unused_163, NULL, NOP)
-  VM_DEFINE_OP (164, unused_164, NULL, NOP)
-  VM_DEFINE_OP (165, unused_165, NULL, NOP)
-  VM_DEFINE_OP (166, unused_166, NULL, NOP)
-  VM_DEFINE_OP (167, unused_167, NULL, NOP)
+  /* ulogand dst:8 a:8 b:8
+   *
+   * Place the bitwise AND of the u64 values in A and B into DST.
+   */
+  VM_DEFINE_OP (162, ulogand, "ulogand", OP1 (X8_S8_S8_S8) | OP_DST)
+    {
+      scm_t_uint8 dst, a, b;
+
+      UNPACK_8_8_8 (op, dst, a, b);
+
+      SP_SET_U64 (dst, SP_REF_U64 (a) & SP_REF_U64 (b));
+
+      NEXT (1);
+    }
+
+  /* ulogior dst:8 a:8 b:8
+   *
+   * Place the bitwise inclusive OR of the u64 values in A and B into
+   * DST.
+   */
+  VM_DEFINE_OP (163, ulogior, "ulogior", OP1 (X8_S8_S8_S8) | OP_DST)
+    {
+      scm_t_uint8 dst, a, b;
+
+      UNPACK_8_8_8 (op, dst, a, b);
+
+      SP_SET_U64 (dst, SP_REF_U64 (a) | SP_REF_U64 (b));
+
+      NEXT (1);
+    }
+
+  /* ulogsub dst:8 a:8 b:8
+   *
+   * Place the (A & ~B) of the u64 values A and B into DST.
+   */
+  VM_DEFINE_OP (164, ulogsub, "ulogsub", OP1 (X8_S8_S8_S8) | OP_DST)
+    {
+      scm_t_uint8 dst, a, b;
+
+      UNPACK_8_8_8 (op, dst, a, b);
+
+      SP_SET_U64 (dst, SP_REF_U64 (a) & ~SP_REF_U64 (b));
+
+      NEXT (1);
+    }
+
+  /* ursh dst:8 a:8 b:8
+   *
+   * Shift the u64 value in A right by B bits, and place the result in
+   * DST.  Only the lower 6 bits of B are used.
+   */
+  VM_DEFINE_OP (165, ursh, "ursh", OP1 (X8_S8_S8_S8) | OP_DST)
+    {
+      scm_t_uint8 dst, a, b;
+
+      UNPACK_8_8_8 (op, dst, a, b);
+
+      SP_SET_U64 (dst, SP_REF_U64 (a) >> (SP_REF_U64 (b) & 63));
+
+      NEXT (1);
+    }
+
+  /* ulsh dst:8 a:8 b:8
+   *
+   * Shift the u64 value in A left by B bits, and place the result in
+   * DST.  Only the lower 6 bits of B are used.
+   */
+  VM_DEFINE_OP (166, ulsh, "ulsh", OP1 (X8_S8_S8_S8) | OP_DST)
+    {
+      scm_t_uint8 dst, a, b;
+
+      UNPACK_8_8_8 (op, dst, a, b);
+
+      SP_SET_U64 (dst, SP_REF_U64 (a) << (SP_REF_U64 (b) & 63));
+
+      NEXT (1);
+    }
+
+  /* scm->u64/truncate dst:12 src:12
+   *
+   * Unpack an exact integer from SRC and place it in the unsigned
+   * 64-bit register DST, truncating any high bits.  If the number in
+   * SRC is negative, all the high bits will be set.
+   */
+  VM_DEFINE_OP (167, scm_to_u64_truncate, "scm->u64/truncate", OP1 (X8_S12_S12) | OP_DST)
+    {
+      scm_t_uint16 dst, src;
+      SCM x;
+
+      UNPACK_12_12 (op, dst, src);
+      SYNC_IP ();
+      x = SP_REF (src);
+
+      if (SCM_I_INUMP (x))
+        SP_SET_U64 (dst, (scm_t_uint64) SCM_I_INUM (x));
+      else
+        {
+          SYNC_IP ();
+          SP_SET_U64 (dst,
+                      scm_to_uint64
+                      (scm_logand (x, scm_from_uint64 ((scm_t_uint64) -1))));
+        }
+
+      NEXT (1);
+    }
+
   VM_DEFINE_OP (168, unused_168, NULL, NOP)
   VM_DEFINE_OP (169, unused_169, NULL, NOP)
   VM_DEFINE_OP (170, unused_170, NULL, NOP)
diff --git a/module/language/cps/compile-bytecode.scm b/module/language/cps/compile-bytecode.scm
index 8d1c8ee6f..d4a534598 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -204,6 +204,8 @@
          (emit-f64->scm asm (from-sp dst) (from-sp (slot src))))
         (($ $primcall 'scm->u64 (src))
          (emit-scm->u64 asm (from-sp dst) (from-sp (slot src))))
+        (($ $primcall 'scm->u64/truncate (src))
+         (emit-scm->u64/truncate asm (from-sp dst) (from-sp (slot src))))
         (($ $primcall 'load-u64 (src))
          (emit-load-u64 asm (from-sp dst) (constant src)))
         (($ $primcall 'u64->scm (src))
diff --git a/module/language/cps/effects-analysis.scm b/module/language/cps/effects-analysis.scm
index 7018a11f2..fb64cac21 100644
--- a/module/language/cps/effects-analysis.scm
+++ b/module/language/cps/effects-analysis.scm
@@ -367,6 +367,7 @@ is or might be a read or a write to the same location as A."
   ((load-f64 _))
   ((f64->scm _))
   ((scm->u64 _)                                                &type-check)
+  ((scm->u64/truncate _)                                       &type-check)
   ((load-u64 _))
   ((u64->scm _))
   ((scm->s64 _)                                                &type-check)
@@ -467,6 +468,11 @@ is or might be a read or a write to the same location as A."
   ((logxor . _)                    &type-check)
   ((logsub . _)                    &type-check)
   ((lognot . _)                    &type-check)
+  ((ulogand . _))
+  ((ulogior . _))
+  ((ulogsub . _))
+  ((ursh . _))
+  ((ulsh . _))
   ((logtest a b)                   &type-check)
   ((logbit? a b)                   &type-check)
   ((sqrt _)                        &type-check)
diff --git a/module/language/cps/slot-allocation.scm b/module/language/cps/slot-allocation.scm
index 0f5a43d43..dd860bea7 100644
--- a/module/language/cps/slot-allocation.scm
+++ b/module/language/cps/slot-allocation.scm
@@ -800,9 +800,10 @@ are comparable with eqv?.  A tmp slot may be used."
                                'bv-f32-ref 'bv-f64-ref
                                'fadd 'fsub 'fmul 'fdiv))
               (intmap-add representations var 'f64))
-             (($ $primcall (or 'scm->u64 'load-u64
+             (($ $primcall (or 'scm->u64 'scm->u64/truncate 'load-u64
                                'bv-length 'vector-length 'string-length
                                'uadd 'usub 'umul
+                               'ulogand 'ulogior 'ulogsub 'ursh 'ulsh
                                'uadd/immediate 'usub/immediate 'umul/immediate
                                'bv-u8-ref 'bv-u16-ref 'bv-u32-ref 'bv-u64-ref))
               (intmap-add representations var 'u64))
diff --git a/module/language/cps/specialize-primcalls.scm b/module/language/cps/specialize-primcalls.scm
index 59c3055c3..710cc32a1 100644
--- a/module/language/cps/specialize-primcalls.scm
+++ b/module/language/cps/specialize-primcalls.scm
@@ -66,6 +66,7 @@
         (('umul (? u8? x) y) (build-exp ($primcall 'umul/immediate (y x))))
         (('scm->f64 (? f64?)) (rename 'load-f64))
         (('scm->u64 (? u64?)) (rename 'load-u64))
+        (('scm->u64/truncate (? u64?)) (rename 'load-u64))
         (('scm->s64 (? s64?)) (rename 'load-s64))
         (_ #f)))
     (intmap-map
diff --git a/module/language/cps/types.scm b/module/language/cps/types.scm
index 3f13d92f5..6b035dc41 100644
--- a/module/language/cps/types.scm
+++ b/module/language/cps/types.scm
@@ -733,9 +733,15 @@ minimum, and maximum."
   (check-type scm &exact-integer 0 #xffffffffffffffff))
 (define-type-inferrer (scm->u64 scm result)
   (restrict! scm &exact-integer 0 #xffffffffffffffff)
-  (define! result &u64 (max (&min scm) 0) (min (&max scm) #xffffffffffffffff)))
+  (define! result &u64 (max (&min scm) 0) (min (&max scm) &u64-max)))
 (define-type-aliases scm->u64 load-u64)
 
+(define-type-checker (scm->u64/truncate scm)
+  (check-type scm &exact-integer &range-min &range-max))
+(define-type-inferrer (scm->u64/truncate scm result)
+  (restrict! scm &exact-integer &range-min &range-max)
+  (define! result &u64 0 &u64-max))
+
 (define-type-checker (u64->scm u64)
   #t)
 (define-type-inferrer (u64->scm u64 result)
@@ -1190,6 +1196,25 @@ minimum, and maximum."
              (min -- -+ ++ +-)
              (max -- -+ ++ +-))))
 
+(define-simple-type-checker (ursh &u64 &u64))
+(define-type-inferrer (ursh a b result)
+  (restrict! a &u64 0 &u64-max)
+  (restrict! b &u64 0 &u64-max)
+  (define! result &u64
+    (ash (&min a) (- (&max b)))
+    (ash (&max a) (- (&min b)))))
+
+(define-simple-type-checker (ulsh &u64 &u64))
+(define-type-inferrer (ulsh a b result)
+  (restrict! a &u64 0 &u64-max)
+  (restrict! b &u64 0 &u64-max)
+  (if (and (< (&max b) 64)
+           (<= (ash (&max a) (&max b)) &u64-max))
+      ;; No overflow; we can be precise.
+      (define! result &u64 (ash (&min a) (&min b)) (ash (&max a) (&max b)))
+      ;; Otherwise assume the whole range.
+      (define! result &u64 0 &u64-max)))
+
 (define (next-power-of-two n)
   (let lp ((out 1))
     (if (< n out)
@@ -1212,6 +1237,12 @@ minimum, and maximum."
            (logand-min (&min a) (&min b))
            (logand-max (&max a) (&max b))))
 
+(define-simple-type-checker (ulogand &u64 &u64))
+(define-type-inferrer (ulogand a b result)
+  (restrict! a &u64 0 &u64-max)
+  (restrict! b &u64 0 &u64-max)
+  (define! result &u64 0 (max (&max a) (&max b))))
+
 (define-simple-type-checker (logsub &exact-integer &exact-integer))
 (define-type-inferrer (logsub a b result)
   (define (logsub-bounds min-a max-a min-b max-b)
@@ -1237,6 +1268,12 @@ minimum, and maximum."
     (lambda (min max)
       (define! result &exact-integer min max))))
 
+(define-simple-type-checker (ulogsub &u64 &u64))
+(define-type-inferrer (ulogsub a b result)
+  (restrict! a &u64 0 &u64-max)
+  (restrict! b &u64 0 &u64-max)
+  (define! result &u64 0 (&max a)))
+
 (define-simple-type-checker (logior &exact-integer &exact-integer))
 (define-type-inferrer (logior a b result)
   ;; Saturate all bits of val.
@@ -1258,6 +1295,14 @@ minimum, and maximum."
            (logior-min (&min a) (&min b))
            (logior-max (&max a) (&max b))))
 
+(define-simple-type-checker (ulogior &u64 &u64))
+(define-type-inferrer (ulogior a b result)
+  (restrict! a &u64 0 &u64-max)
+  (restrict! b &u64 0 &u64-max)
+  (define! result &u64
+    (max (&min a) (&min b))
+    (1- (next-power-of-two (logior (&max a) (&max b))))))
+
 ;; For our purposes, treat logxor the same as logior.
 (define-type-aliases logior logxor)
 
diff --git a/module/language/cps/utils.scm b/module/language/cps/utils.scm
index 750fd17b1..64b403dbc 100644
--- a/module/language/cps/utils.scm
+++ b/module/language/cps/utils.scm
@@ -214,7 +214,7 @@ disjoint, an error will be signalled."
              (if (and f64 (number? f64) (inexact? f64) (real? f64))
                  (intmap-add! out var f64)
                  out)))
-          (($ $primcall 'scm->u64 (val))
+          (($ $primcall (or 'scm->u64 'scm->u64/truncate) (val))
            (let ((u64 (intmap-ref out val (lambda (_) #f))))
              (if (and u64 (number? u64) (exact-integer? u64)
                       (<= 0 u64 #xffffFFFFffffFFFF))
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index 3f08d7e68..f94d0f0a9 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -153,6 +153,11 @@
             (emit-logior* . emit-logior)
             (emit-logxor* . emit-logxor)
             (emit-logsub* . emit-logsub)
+            (emit-ulogand* . emit-ulogand)
+            (emit-ulogior* . emit-ulogior)
+            (emit-ulogsub* . emit-ulogsub)
+            (emit-ursh* . emit-ursh)
+            (emit-ulsh* . emit-ulsh)
             (emit-make-vector* . emit-make-vector)
             (emit-make-vector/immediate* . emit-make-vector/immediate)
             (emit-vector-length* . emit-vector-length)
@@ -173,6 +178,7 @@
             emit-load-f64
             (emit-f64->scm* . emit-f64->scm)
             (emit-scm->u64* . emit-scm->u64)
+            (emit-scm->u64/truncate* . emit-scm->u64/truncate)
             emit-load-u64
             (emit-u64->scm* . emit-u64->scm)
             (emit-scm->s64* . emit-scm->s64)