mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-12 14:50:19 +02:00
Add `load-unsigned-integer' instruction.
* libguile/vm-i-loader.c (load_unsigned_integer): New loader. * module/language/assembly.scm (byte-length): Handle `load-unsigned-integer'. * module/language/assembly/compile-bytecode.scm (write-bytecode): Likewise. * module/language/glil/compile-assembly.scm (dump-object): Emit a `load-unsigned-integer' instruction for positive integers. This fixes loading of integers greater than 2^31 - 1. * testsuite/Makefile.am (vm_test_files): Add `t-literal-integers.scm'. * doc/ref/vm.texi (Loading Instructions): Add `load-unsigned-integer'.
This commit is contained in:
parent
4e29767187
commit
b912a1cd6b
7 changed files with 37 additions and 6 deletions
|
@ -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.
|
may be encoded in 1, 2, or 4 bytes.
|
||||||
|
|
||||||
@deffn Instruction load-integer length
|
@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
|
@end deffn
|
||||||
@deffn Instruction load-number length
|
@deffn Instruction load-number length
|
||||||
Load an arbitrary number from the instruction stream. The number is
|
Load an arbitrary number from the instruction stream. The number is
|
||||||
|
|
|
@ -18,12 +18,30 @@
|
||||||
|
|
||||||
/* This file is included in vm_engine.c */
|
/* 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")
|
VM_DEFINE_LOADER (60, load_integer, "load-integer")
|
||||||
{
|
{
|
||||||
size_t len;
|
size_t len;
|
||||||
|
|
||||||
FETCH_LENGTH (len);
|
FETCH_LENGTH (len);
|
||||||
if (len <= 4)
|
if (SCM_LIKELY (len <= 4))
|
||||||
{
|
{
|
||||||
int val = 0;
|
int val = 0;
|
||||||
while (len-- > 0)
|
while (len-- > 0)
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;; Guile Virtual Machine Assembly
|
;;; 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
|
;; 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
|
;; it under the terms of the GNU General Public License as published by
|
||||||
|
@ -38,6 +38,8 @@
|
||||||
(pmatch assembly
|
(pmatch assembly
|
||||||
(,label (guard (not (pair? label)))
|
(,label (guard (not (pair? label)))
|
||||||
0)
|
0)
|
||||||
|
((load-unsigned-integer ,str)
|
||||||
|
(+ 1 *len-len* (string-length str)))
|
||||||
((load-integer ,str)
|
((load-integer ,str)
|
||||||
(+ 1 *len-len* (string-length str)))
|
(+ 1 *len-len* (string-length str)))
|
||||||
((load-number ,str)
|
((load-number ,str)
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;; Guile VM assembler
|
;;; 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
|
;; 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
|
;; it under the terms of the GNU General Public License as published by
|
||||||
|
@ -107,6 +107,7 @@
|
||||||
(if (> i 0) (write-byte x))))
|
(if (> i 0) (write-byte x))))
|
||||||
(get-addr (lambda () i)))
|
(get-addr (lambda () i)))
|
||||||
(write-bytecode meta write get-addr '()))))
|
(write-bytecode meta write get-addr '()))))
|
||||||
|
((load-unsigned-integer ,str) (write-loader str))
|
||||||
((load-integer ,str) (write-loader str))
|
((load-integer ,str) (write-loader str))
|
||||||
((load-number ,str) (write-loader str))
|
((load-number ,str) (write-loader str))
|
||||||
((load-string ,str) (write-loader str))
|
((load-string ,str) (write-loader str))
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
;;; Guile VM assembler
|
;;; 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
|
;; 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
|
;; it under the terms of the GNU General Public License as published by
|
||||||
|
@ -343,7 +343,9 @@
|
||||||
(l '() (cons (modulo n 256) l)))
|
(l '() (cons (modulo n 256) l)))
|
||||||
((= n 0)
|
((= n 0)
|
||||||
(list->string (map integer->char l))))))
|
(list->string (map integer->char l))))))
|
||||||
`((load-integer ,str))))
|
(if (< x 0)
|
||||||
|
`((load-integer ,str))
|
||||||
|
`((load-unsigned-integer ,str)))))
|
||||||
((number? x)
|
((number? x)
|
||||||
`((load-number ,(number->string x))))
|
`((load-number ,(number->string x))))
|
||||||
((string? x)
|
((string? x)
|
||||||
|
|
|
@ -13,6 +13,7 @@ vm_test_files = \
|
||||||
t-closure3.scm \
|
t-closure3.scm \
|
||||||
t-closure4.scm \
|
t-closure4.scm \
|
||||||
t-do-loop.scm \
|
t-do-loop.scm \
|
||||||
|
t-literal-integers.scm \
|
||||||
t-macros.scm \
|
t-macros.scm \
|
||||||
t-macros2.scm \
|
t-macros2.scm \
|
||||||
t-map.scm \
|
t-map.scm \
|
||||||
|
|
5
testsuite/t-literal-integers.scm
Normal file
5
testsuite/t-literal-integers.scm
Normal file
|
@ -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
|
Loading…
Add table
Add a link
Reference in a new issue