Add unsigned 64-bit arithmetic operators: uadd, usub, umul

* libguile/vm-engine.c (uadd, usub, umul): New ops.
* module/language/cps/effects-analysis.scm (uadd, usub, umul): Add
  effects analysis.
* module/language/cps/slot-allocation.scm (compute-var-representations):
  The new ops define 'u64 values.
* module/language/cps/types.scm (uadd, usub, umul): Add type checkers
  and inferrers.
* module/system/vm/assembler.scm (emit-uadd, emit-usub, emit-umul): New
  assemblers.

libguile/vm-engine.c

@@ -3402,9 +3402,48 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       BR_U64_ARITHMETIC (<=, scm_leq_p);
     }
 
-  VM_DEFINE_OP (149, unused_149, NULL, NOP)
+  /* uadd dst:8 a:8 b:8
-  VM_DEFINE_OP (150, unused_150, NULL, NOP)
+   *
-  VM_DEFINE_OP (151, unused_151, NULL, NOP)
+   * Add A to B, and place the result in DST.  The operands and the
+   * result are unboxed unsigned 64-bit integers.  Overflow will wrap
+   * around.
+   */
+  VM_DEFINE_OP (149, uadd, "uadd", 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);
+    }
+
+  /* usub dst:8 a:8 b:8
+   *
+   * Subtract B from A, and place the result in DST.  The operands and
+   * the result are unboxed unsigned 64-bit integers.  Overflow will
+   * wrap around.
+   */
+  VM_DEFINE_OP (150, usub, "usub", 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);
+    }
+
+  /* umul dst:8 a:8 b:8
+   *
+   * Multiply A and B, and place the result in DST.  The operands and
+   * the result are unboxed unsigned 64-bit integers.  Overflow will
+   * wrap around.
+   */
+  VM_DEFINE_OP (151, umul, "umul", 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);
+    }
+
   VM_DEFINE_OP (152, unused_152, NULL, NOP)
   VM_DEFINE_OP (153, unused_153, NULL, NOP)
   VM_DEFINE_OP (154, unused_154, NULL, NOP)

module/language/cps/effects-analysis.scm

@@ -425,6 +425,9 @@ is or might be a read or a write to the same location as A."
   ((fsub . _))
   ((fmul . _))
   ((fdiv . _))
+  ((uadd . _))
+  ((usub . _))
+  ((umul . _))
   ((sub1 . _)                      &type-check)
   ((add1 . _)                      &type-check)
   ((quo . _)                       &type-check)

module/language/cps/slot-allocation.scm

@@ -793,7 +793,8 @@ are comparable with eqv?.  A tmp slot may be used."
              (($ $primcall (or 'scm->f64 'bv-f32-ref 'bv-f64-ref
                                'fadd 'fsub 'fmul 'fdiv))
               (intmap-add representations var 'f64))
-             (($ $primcall (or 'scm->u64 'bv-length))
+             (($ $primcall (or 'scm->u64 'bv-length
+                               'uadd 'usub 'umul))
               (intmap-add representations var 'u64))
              (_
               (intmap-add representations var 'scm))))

module/language/cps/types.scm

@@ -916,6 +916,7 @@ minimum, and maximum."
 
 (define-simple-type-checker (add &number &number))
 (define-type-checker (fadd a b) #t)
+(define-type-checker (uadd a b) #t)
 (define-type-inferrer (add a b result)
   (define-binary-result! a b result #t
                          (+ (&min a) (&min b))
@@ -924,9 +925,16 @@ minimum, and maximum."
   (define! result &f64
     (+ (&min a) (&min b))
     (+ (&max a) (&max b))))
+(define-type-inferrer (uadd a b result)
+  ;; Handle wraparound.
+  (let ((max (+ (&max a) (&max b))))
+    (if (<= max #xffffffffffffffff)
+        (define! result &u64 (+ (&min a) (&min b)) max)
+        (define! result &u64 0 #xffffffffffffffff))))
 
 (define-simple-type-checker (sub &number &number))
 (define-type-checker (fsub a b) #t)
+(define-type-checker (usub a b) #t)
 (define-type-inferrer (sub a b result)
   (define-binary-result! a b result #t
                          (- (&min a) (&max b))
@@ -935,9 +943,16 @@ minimum, and maximum."
   (define! result &f64
     (- (&min a) (&max b))
     (- (&max a) (&min b))))
+(define-type-inferrer (usub a b result)
+  ;; Handle wraparound.
+  (let ((min (- (&min a) (&max b))))
+    (if (< min 0)
+        (define! result &u64 0 #xffffffffffffffff)
+        (define! result &u64 min (- (&max a) (&min b))))))
 
 (define-simple-type-checker (mul &number &number))
 (define-type-checker (fmul a b) #t)
+(define-type-checker (umul a b) #t)
 (define (mul-result-range same? nan-impossible? min-a max-a min-b max-b)
   (define (nan* a b)
     (if (and (or (and (inf? a) (zero? b))
@@ -980,6 +995,12 @@ minimum, and maximum."
                                           min-a max-a min-b max-b))
       (lambda (min max)
         (define! result &f64 min max)))))
+(define-type-inferrer (umul a b result)
+  ;; Handle wraparound.
+  (let ((max (* (&max a) (&max b))))
+    (if (<= max #xffffffffffffffff)
+        (define! result &u64 (* (&min a) (&min b)) max)
+        (define! result &u64 0 #xffffffffffffffff))))
 
 (define-type-checker (div a b)
   (and (check-type a &number -inf.0 +inf.0)

module/system/vm/assembler.scm

@@ -142,6 +142,9 @@
             (emit-fsub* . emit-fsub)
             (emit-fmul* . emit-fmul)
             (emit-fdiv* . emit-fdiv)
+            (emit-uadd* . emit-uadd)
+            (emit-usub* . emit-usub)
+            (emit-umul* . emit-umul)
             (emit-logand* . emit-logand)
             (emit-logior* . emit-logior)
             (emit-logxor* . emit-logxor)