diff options
-rw-r--r-- | doc/ref/vm.texi | 4 | ||||
-rw-r--r-- | libguile/vm-i-loader.c | 20 | ||||
-rw-r--r-- | module/language/assembly.scm | 4 | ||||
-rw-r--r-- | module/language/assembly/compile-bytecode.scm | 3 | ||||
-rw-r--r-- | module/language/glil/compile-assembly.scm | 6 | ||||
-rw-r--r-- | testsuite/Makefile.am | 1 | ||||
-rw-r--r-- | testsuite/t-literal-integers.scm | 5 |
7 files changed, 37 insertions, 6 deletions
diff --git a/doc/ref/vm.texi b/doc/ref/vm.texi index 56a2cefdf..042645200 100644 --- a/doc/ref/vm.texi +++ b/doc/ref/vm.texi @@ -549,7 +549,9 @@ indicating the size of the embedded data, in bytes. The length itself may be encoded in 1, 2, or 4 bytes. @deffn Instruction load-integer length -Load a 32-bit integer from the instruction stream. +@deffnx Instruction load-unsigned-integer length +Load a 32-bit integer (respectively unsigned integer) from the +instruction stream. @end deffn @deffn Instruction load-number length Load an arbitrary number from the instruction stream. The number is diff --git a/libguile/vm-i-loader.c b/libguile/vm-i-loader.c index 66b07b1f5..bba4f4b9c 100644 --- a/libguile/vm-i-loader.c +++ b/libguile/vm-i-loader.c @@ -18,12 +18,30 @@ /* This file is included in vm_engine.c */ +VM_DEFINE_LOADER (59, load_unsigned_integer, "load-unsigned-integer") +{ + size_t len; + + FETCH_LENGTH (len); + if (SCM_LIKELY (len <= 4)) + { + unsigned int val = 0; + while (len-- > 0) + val = (val << 8U) + FETCH (); + SYNC_REGISTER (); + PUSH (scm_from_uint (val)); + NEXT; + } + else + SCM_MISC_ERROR ("load-unsigned-integer: not implemented yet", SCM_EOL); +} + VM_DEFINE_LOADER (60, load_integer, "load-integer") { size_t len; FETCH_LENGTH (len); - if (len <= 4) + if (SCM_LIKELY (len <= 4)) { int val = 0; while (len-- > 0) diff --git a/module/language/assembly.scm b/module/language/assembly.scm index 42fd5f0e1..28dde1e1a 100644 --- a/module/language/assembly.scm +++ b/module/language/assembly.scm @@ -1,6 +1,6 @@ ;;; Guile Virtual Machine Assembly -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009 Free Software Foundation, Inc. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -38,6 +38,8 @@ (pmatch assembly (,label (guard (not (pair? label))) 0) + ((load-unsigned-integer ,str) + (+ 1 *len-len* (string-length str))) ((load-integer ,str) (+ 1 *len-len* (string-length str))) ((load-number ,str) diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm index a96b56147..6e7e34efc 100644 --- a/module/language/assembly/compile-bytecode.scm +++ b/module/language/assembly/compile-bytecode.scm @@ -1,6 +1,6 @@ ;;; Guile VM assembler -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009 Free Software Foundation, Inc. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -107,6 +107,7 @@ (if (> i 0) (write-byte x)))) (get-addr (lambda () i))) (write-bytecode meta write get-addr '())))) + ((load-unsigned-integer ,str) (write-loader str)) ((load-integer ,str) (write-loader str)) ((load-number ,str) (write-loader str)) ((load-string ,str) (write-loader str)) diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm index 797c59653..1b1d2dfba 100644 --- a/module/language/glil/compile-assembly.scm +++ b/module/language/glil/compile-assembly.scm @@ -1,6 +1,6 @@ ;;; Guile VM assembler -;; Copyright (C) 2001 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009 Free Software Foundation, Inc. ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -343,7 +343,9 @@ (l '() (cons (modulo n 256) l))) ((= n 0) (list->string (map integer->char l)))))) - `((load-integer ,str)))) + (if (< x 0) + `((load-integer ,str)) + `((load-unsigned-integer ,str))))) ((number? x) `((load-number ,(number->string x)))) ((string? x) diff --git a/testsuite/Makefile.am b/testsuite/Makefile.am index 8545d86e4..f509348fb 100644 --- a/testsuite/Makefile.am +++ b/testsuite/Makefile.am @@ -13,6 +13,7 @@ vm_test_files = \ t-closure3.scm \ t-closure4.scm \ t-do-loop.scm \ + t-literal-integers.scm \ t-macros.scm \ t-macros2.scm \ t-map.scm \ diff --git a/testsuite/t-literal-integers.scm b/testsuite/t-literal-integers.scm new file mode 100644 index 000000000..bf015a4ff --- /dev/null +++ b/testsuite/t-literal-integers.scm @@ -0,0 +1,5 @@ +;; Check whether literal integers are correctly signed. + +(and (= 4294967295 (- (expt 2 32) 1)) ;; unsigned + (= -2147483648 (- (expt 2 31))) ;; signed + (= 2147483648 (expt 2 31))) ;; unsigned |