summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/ref/vm.texi19
-rw-r--r--libguile/vm-i-loader.c6
-rw-r--r--libguile/vm-i-system.c30
-rw-r--r--module/language/assembly.scm20
-rw-r--r--module/language/glil/compile-assembly.scm8
5 files changed, 65 insertions, 18 deletions
diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi
index 8d7778c1c..fa655238f 100644
--- 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 50569e01a..e5bb35e6e 100644
--- 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 36ff5bde8..6b130e7e1 100644
--- 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 3ffbf11f1..3f72cf6aa 100644
--- 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 dcdbc5133..96c6383c0 100644
--- 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)