new instructions: make-int64, make-uint64

* doc/ref/vm.texi (Loading Instructions): Remove references to
  load-integer and load-unsigned-integer -- they're still in the VM but
  will be removed at some point.
  (Data Control Instructions): Add make-int64 and make-uint64.

* libguile/vm-i-loader.c (load-unsigned-integer): Allow 8-byte values.
  But this instruction is on its way out, yo.

* libguile/vm-i-system.c (make-int64, make-uint64): New instructions.

* module/language/assembly.scm (object->assembly): Write out make-int64
  and make-uint64 instructions, using bytevectors to do the endianness
  conversion.
  (assembly->object): And pretty-print them back, for disassembly.

* module/language/glil/compile-assembly.scm: Don't generate load-integer
  / load-unsigned-integer instructions.

diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index 8d7778c..fa65523 100644 (file)
--- a/doc/ref/vm.texi
+++ b/doc/ref/vm.texi
@@ -543,14 +543,8 @@ the instruction pointer to the next VM instruction.
 
 All of these loading instructions have a @code{length} parameter,
 indicating the size of the embedded data, in bytes. The length itself
-may be encoded in 1, 2, or 4 bytes.
+is encoded in 3 bytes.
 
-@deffn Instruction load-integer length
-@deffnx Instruction load-unsigned-integer length
-Load a 32-bit integer or unsigned integer from the instruction stream.
-The bytes of the integer are read in order of decreasing significance
-(i.e., big-endian).
-@end deffn
 @deffn Instruction load-number length
 Load an arbitrary number from the instruction stream. The number is
 embedded in the stream as a string.
@@ -743,6 +737,17 @@ Push the immediate value @code{1} onto the stack.
 Push @var{value}, a 16-bit integer, onto the stack.
 @end deffn
 
+@deffn Instruction make-uint64 value
+Push @var{value}, an unsigned 64-bit integer, onto the stack. The
+value is encoded in 8 bytes, most significant byte first (big-endian).
+@end deffn
+
+@deffn Instruction make-int64 value
+Push @var{value}, a signed 64-bit integer, onto the stack. The value
+is encoded in 8 bytes, most significant byte first (big-endian), in
+twos-complement arithmetic.
+@end deffn
+
 @deffn Instruction make-false
 Push @code{#f} onto the stack.
 @end deffn

diff --git a/libguile/vm-i-loader.c b/libguile/vm-i-loader.c
index 50569e0..e5bb35e 100644 (file)
--- a/libguile/vm-i-loader.c
+++ b/libguile/vm-i-loader.c
@@ -24,13 +24,13 @@ VM_DEFINE_LOADER (59, load_unsigned_integer, "load-unsigned-integer")
   size_t len;
 
   FETCH_LENGTH (len);
-  if (SCM_LIKELY (len <= 4))
+  if (SCM_LIKELY (len <= 8))
     {
-      unsigned int val = 0;
+      scm_t_uint64 val = 0;
       while (len-- > 0)
        val = (val << 8U) + FETCH ();
       SYNC_REGISTER ();
-      PUSH (scm_from_uint (val));
+      PUSH (scm_from_uint64 (val));
       NEXT;
     }
   else

diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 36ff5bd..6b130e7 100644 (file)
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -138,6 +138,36 @@ VM_DEFINE_INSTRUCTION (13, make_int16, "make-int16", 2, 0, 1)
   NEXT;
 }
 
+VM_DEFINE_INSTRUCTION (55, make_int64, "make-int64", 8, 0, 1)
+{
+  scm_t_uint64 v = 0;
+  v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  PUSH (scm_from_int64 ((scm_t_int64) v));
+  NEXT;
+}
+
+VM_DEFINE_INSTRUCTION (56, make_uint64, "make-uint64", 8, 0, 1)
+{
+  scm_t_uint64 v = 0;
+  v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  v <<= 8; v += FETCH ();
+  PUSH (scm_from_uint64 (v));
+  NEXT;
+}
+
 VM_DEFINE_INSTRUCTION (14, make_char8, "make-char8", 1, 0, 1)
 {
   PUSH (SCM_MAKE_CHAR (FETCH ()));

diff --git a/module/language/assembly.scm b/module/language/assembly.scm
index 3ffbf11..3f72cf6 100644 (file)
--- a/module/language/assembly.scm
+++ b/module/language/assembly.scm
@@ -114,6 +114,16 @@
               ((and (<= -32768 x) (< x 32768))
                (let ((n (if (< x 0) (+ x 65536) x)))
                  `(make-int16 ,(quotient n 256) ,(modulo n 256))))
+               ((and (<= 0 x #xffffffffffffffff))
+                `(make-uint64 ,@(bytevector->u8-list
+                                 (let ((bv (make-bytevector 8)))
+                                   (bytevector-u64-set! bv 0 x (endianness big))
+                                   bv))))
+              ((and (<= 0 (+ x #x8000000000000000) #x7fffffffffffffff))
+                `(make-int64 ,@(bytevector->u8-list
+                                (let ((bv (make-bytevector 8)))
+                                  (bytevector-s64-set! bv 0 x (endianness big))
+                                  bv))))
               (else #f)))
        ((char? x) `(make-char8 ,(char->integer x)))
        (else #f)))
@@ -128,6 +138,16 @@
     ((make-int16 ,n1 ,n2)
      (let ((n (+ (* n1 256) n2)))
        (if (< n 32768) n (- n 65536))))
+    ((make-uint64 ,n1 ,n2 ,n3 ,n4 ,n5 ,n6 ,n7 ,n8)
+     (bytevector-u64-ref
+      (u8-list->bytevector (list n1 n2 n3 n4 n5 n6 n7 n8))
+      0
+      (endianness big)))
+    ((make-int64 ,n1 ,n2 ,n3 ,n4 ,n5 ,n6 ,n7 ,n8)
+     (bytevector-s64-ref
+      (u8-list->bytevector (list n1 n2 n3 n4 n5 n6 n7 n8))
+      0
+      (endianness big)))
     ((make-char8 ,n)
      (integer->char n))
     ((load-string ,s) s)

diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm
index dcdbc51..96c6383 100644 (file)
--- a/module/language/glil/compile-assembly.scm
+++ b/module/language/glil/compile-assembly.scm
@@ -352,14 +352,6 @@
     `(,@(subprogram-table x)
       ,@(align-program (subprogram-prog x)
                        (addr+ addr (subprogram-table x)))))
-   ((and (integer? x) (exact? x))
-    (let ((str (do ((n x (quotient n 256))
-                    (l '() (cons (modulo n 256) l)))
-                   ((= n 0)
-                    (list->string (map integer->char l))))))
-      (if (< x 0)
-         `((load-integer ,str))
-         `((load-unsigned-integer ,str)))))
    ((number? x)
     `((load-number ,(number->string x))))
    ((string? x)