diff options
-rw-r--r-- | doc/ref/vm.texi | 19 | ||||
-rw-r--r-- | libguile/vm-i-loader.c | 6 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 30 | ||||
-rw-r--r-- | module/language/assembly.scm | 20 | ||||
-rw-r--r-- | module/language/glil/compile-assembly.scm | 8 |
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) |