Add bv-length instruction

* libguile/vm-engine.c (bv-length): New instruction.
* module/language/cps/compile-bytecode.scm (compile-function):
* module/language/cps/effects-analysis.scm (bv-length):
* module/language/cps/primitives.scm (*instruction-aliases*):
* module/language/cps/slot-allocation.scm (compute-var-representations):
* module/language/cps/types.scm (bv-length):
* module/language/tree-il/compile-cps.scm (convert): Add support for
  bv-length.
* module/system/vm/assembler.scm: Export emit-bv-length.

libguile/vm-engine.c

@@ -3341,7 +3341,19 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
       NEXT (1);
     }
 
-  VM_DEFINE_OP (145, unused_145, NULL, NOP)
+  /* bv-length dst:12 src:12
+   *
+   * Store the length of the bytevector in SRC in DST, as an untagged
+   * 64-bit integer.
+   */
+  VM_DEFINE_OP (145, bv_length, "bv-length", OP1 (X8_S12_S12) | OP_DST)
+    {
+      ARGS1 (bv);
+      VM_VALIDATE_BYTEVECTOR (bv, "bytevector-length");
+      SP_SET_U64 (dst, SCM_BYTEVECTOR_LENGTH (bv));
+      NEXT (1);
+    }
+
   VM_DEFINE_OP (146, unused_146, NULL, NOP)
   VM_DEFINE_OP (147, unused_147, NULL, NOP)
   VM_DEFINE_OP (148, unused_148, NULL, NOP)

module/language/cps/compile-bytecode.scm

@@ -185,6 +185,8 @@
          (emit-scm->f64 asm (from-sp dst) (from-sp (slot src))))
         (($ $primcall 'f64->scm (src))
          (emit-f64->scm asm (from-sp dst) (from-sp (slot src))))
+        (($ $primcall 'bv-length (bv))
+         (emit-bv-length asm (from-sp dst) (from-sp (slot bv))))
         (($ $primcall 'bv-u8-ref (bv idx))
          (emit-bv-u8-ref asm (from-sp dst) (from-sp (slot bv))
                          (from-sp (slot idx))))

module/language/cps/effects-analysis.scm

@@ -360,7 +360,7 @@ is or might be a read or a write to the same location as A."
 
 ;; Bytevectors.
 (define-primitive-effects
-  ((bytevector-length _)                                       &type-check)
+  ((bv-length _)                                               &type-check)
 
   ((bv-u8-ref bv n)                (&read-object &bytevector)  &type-check)
   ((bv-s8-ref bv n)                (&read-object &bytevector)  &type-check)

module/language/cps/primitives.scm

@@ -41,6 +41,7 @@
     (modulo . mod)
     (variable-ref . box-ref)
     (variable-set! . box-set!)
+    (bytevector-length . bv-length)
     (bytevector-u8-ref . bv-u8-ref)
     (bytevector-u16-native-ref . bv-u16-ref)
     (bytevector-u32-native-ref . bv-u32-ref)

module/language/cps/slot-allocation.scm

@@ -793,7 +793,7 @@ 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))
+             (($ $primcall (or 'scm->u64 'bv-length))
               (intmap-add representations var 'u64))
              (_
               (intmap-add representations var 'scm))))

module/language/cps/types.scm

@@ -713,8 +713,8 @@ minimum, and maximum."
 ;;; Bytevectors.
 ;;;
 
-(define-simple-type-checker (bytevector-length &bytevector))
+(define-simple-type-checker (bv-length &bytevector))
-(define-type-inferrer (bytevector-length bv result)
+(define-type-inferrer (bv-length bv result)
   (restrict! bv &bytevector 0 +inf.0)
   (define! result &exact-integer (max (&min bv) 0) (&max bv)))
 

module/language/tree-il/compile-cps.scm

@@ -576,6 +576,13 @@
                    (letk kbox ($kargs ('f64) (f64)
                                 ($continue k src ($primcall 'f64->scm (f64)))))
                    kbox))
+                ((bv-length)
+                 (with-cps cps
+                   (letv u64)
+                   (let$ k (adapt-arity k src out))
+                   (letk kbox ($kargs ('u64) (u64)
+                                ($continue k src ($primcall 'u64->scm (u64)))))
+                   kbox))
                 (else
                  (adapt-arity cps k src out))))
             (define (unbox-arg cps arg have-arg)

module/system/vm/assembler.scm

@@ -160,6 +160,7 @@
             emit-make-array
             (emit-scm->f64* . emit-scm->f64)
             (emit-f64->scm* . emit-f64->scm)
+            (emit-bv-length* . emit-bv-length)
             (emit-bv-u8-ref* . emit-bv-u8-ref)
             (emit-bv-s8-ref* . emit-bv-s8-ref)
             (emit-bv-u16-ref* . emit-bv-u16-ref)