Add low-level support for unboxed 64-bit unsigned ints

* libguile/frames.c (enum stack_item_representation)
* libguile/frames.c (scm_to_stack_item_representation):
  (scm_frame_local_ref, scm_frame_local_set_x): Support 'u64 slots.
* libguile/frames.h (union scm_vm_stack_element): Add as_u64 member.

* libguile/vm-engine.c (SP_REF_U64, SP_SET_U64): New helpers.
  (scm->u64, u64->scm): New instructions.

* module/language/cps/cse.scm (compute-equivalent-subexpressions):
  Scalar replacement for u64->scm and scm->u64.

* module/language/cps/effects-analysis.scm (scm->u64, u64->scm): Add
  cases.

* module/language/cps/slot-allocation.scm (compute-var-representations):
  (allocate-slots): Represent the result of scm->u64 as a "u64" slot.

* module/language/cps/types.scm (&u64): New type.
  (scm->u64, u64->scm): Add support for these ops.

* module/system/vm/assembler.scm (write-arities):
* module/system/vm/debug.scm (arity-definitions): Support u64
  representations.

module/language/cps/cse.scm

@@ -307,6 +307,14 @@ false.  It could be that both true and false proofs are available."
              (match defs
                ((scm)
                 (add-def! `(primcall scm->f64 ,scm) f64))))
+            (('primcall 'scm->u64 scm)
+             (match defs
+               ((u64)
+                (add-def! `(primcall u64->scm ,u64) scm))))
+            (('primcall 'u64->scm u64)
+             (match defs
+               ((scm)
+                (add-def! `(primcall scm->u64 ,scm) u64))))
             (_ #t))))
 
       (define (visit-label label equiv-labels var-substs)

module/language/cps/effects-analysis.scm

@@ -351,10 +351,12 @@ is or might be a read or a write to the same location as A."
   ((string->number _)              (&read-object &string)      &type-check)
   ((string-length s)                                           &type-check))
 
-;; Unboxed floats.
+;; Unboxed floats and integers.
 (define-primitive-effects
   ((scm->f64 _)                                                &type-check)
-  ((f64->scm _)))
+  ((f64->scm _))
+  ((scm->u64 _)                                                &type-check)
+  ((u64->scm _)))
 
 ;; Bytevectors.
 (define-primitive-effects

module/language/cps/slot-allocation.scm

@@ -53,8 +53,8 @@
   ;;
   (slots allocation-slots)
 
-  ;; A map of VAR to representation.  A representation is either 'scm or
-  ;; 'f64.
+  ;; A map of VAR to representation.  A representation is 'scm, 'f64, or
+  ;; 'u64.
   ;;
   (representations allocation-representations)
 
@@ -793,6 +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))
+              (intmap-add representations var 'u64))
              (_
               (intmap-add representations var 'scm))))
           (vars
@@ -874,7 +876,7 @@ are comparable with eqv?.  A tmp slot may be used."
            (#f slot-map)
            (slot
             (let ((desc (match (intmap-ref representations var)
-                          ('f64 slot-desc-live-raw)
+                          ((or 'u64 'f64) slot-desc-live-raw)
                           ('scm slot-desc-live-scm))))
               (logior slot-map (ash desc (* 2 slot)))))))
        live-vars 0))

module/language/cps/types.scm

@@ -119,6 +119,7 @@
 
             ;; Untagged types.
             &f64
+            &u64
 
             infer-types
             lookup-pre-type
@@ -169,7 +170,8 @@
   &array
   &hash-table
 
-  &f64)
+  &f64
+  &u64)
 
 (define-syntax &no-type (identifier-syntax 0))
 
@@ -678,7 +680,7 @@ minimum, and maximum."
 
 
 ;;;
-;;; Unboxed double-precision floating-point numbers.
+;;; Unboxed numbers.
 ;;;
 
 (define-type-checker (scm->f64 scm)
@@ -692,6 +694,17 @@ minimum, and maximum."
 (define-type-inferrer (f64->scm f64 result)
   (define! result &flonum (&min f64) (&max f64)))
 
+(define-type-checker (scm->u64 scm)
+  (check-type scm &exact-integer 0 +inf.0))
+(define-type-inferrer (scm->u64 scm result)
+  (restrict! scm &exact-integer 0 +inf.0)
+  (define! result &u64 (&min scm) (&max scm)))
+
+(define-type-checker (u64->scm u64)
+  #t)
+(define-type-inferrer (u64->scm u64 result)
+  (define! result &exact-integer (&min u64) (&max u64)))
+
 
 
 

module/system/vm/assembler.scm

@@ -1895,6 +1895,7 @@ procedure with label @var{rw-init}.  @var{rw-init} may be false.  If
            (let ((tag (case representation
                         ((scm) 0)
                         ((f64) 1)
+                        ((u64) 2)
                         (else (error "what!" representation)))))
              (put-uleb128 names-port (logior (ash slot 2) tag)))
            (lp definitions))))))

module/system/vm/debug.scm

@@ -386,6 +386,7 @@ section of the ELF image.  Returns an ELF symbol, or @code{#f}."
                          (representation (case (logand slot+representation #x3)
                                            ((0) 'scm)
                                            ((1) 'f64)
+                                           ((2) 'u64)
                                            (else 'unknown))))
                      (cons (vector name def-offset slot representation)
                            (lp pos names)))))))))))