mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 20:30:28 +02:00
Code Activity

Merge branch 'master' of git://git.savannah.gnu.org/guile into elisp

Browse source
This commit is contained in:
Daniel Kraft 2009-07-14 20:20:03 +02:00
commit 285277590d
2 changed files with 38 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

16
libguile/vm-i-scheme.c
View file

@ -281,7 +281,7 @@ VM_DEFINE_INSTRUCTION (108, slot_set, "slot-set", 0, 3, 0)
VM_DEFINE_FUNCTION (109, vector_ref, "vector-ref", 2) VM_DEFINE_FUNCTION (109, vector_ref, "vector-ref", 2)
{ {
long i; long i = 0;
ARGS2 (vect, idx); ARGS2 (vect, idx);
if (SCM_LIKELY (SCM_I_IS_VECTOR (vect) if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)
&& SCM_I_INUMP (idx) && SCM_I_INUMP (idx)
@ -294,7 +294,7 @@ VM_DEFINE_FUNCTION (109, vector_ref, "vector-ref", 2)
VM_DEFINE_INSTRUCTION (110, vector_set, "vector-set", 0, 3, 0) VM_DEFINE_INSTRUCTION (110, vector_set, "vector-set", 0, 3, 0)
{ {
long i; long i = 0;
SCM vect, idx, val; SCM vect, idx, val;
POP (val); POP (idx); POP (vect); POP (val); POP (idx); POP (vect);
if (SCM_LIKELY (SCM_I_IS_VECTOR (vect) if (SCM_LIKELY (SCM_I_IS_VECTOR (vect)
@ -346,7 +346,7 @@ BV_REF_WITH_ENDIANNESS (f64, ieee_double)
#define BV_FIXABLE_INT_REF(stem, fn_stem, type, size) \ #define BV_FIXABLE_INT_REF(stem, fn_stem, type, size) \
{ \ { \
long i; \ long i = 0; \
ARGS2 (bv, idx); \ ARGS2 (bv, idx); \
VM_VALIDATE_BYTEVECTOR (bv); \ VM_VALIDATE_BYTEVECTOR (bv); \
if (SCM_LIKELY (SCM_I_INUMP (idx) \ if (SCM_LIKELY (SCM_I_INUMP (idx) \
@ -361,7 +361,7 @@ BV_REF_WITH_ENDIANNESS (f64, ieee_double)
#define BV_INT_REF(stem, type, size) \ #define BV_INT_REF(stem, type, size) \
{ \ { \
long i; \ long i = 0; \
ARGS2 (bv, idx); \ ARGS2 (bv, idx); \
VM_VALIDATE_BYTEVECTOR (bv); \ VM_VALIDATE_BYTEVECTOR (bv); \
if (SCM_LIKELY (SCM_I_INUMP (idx) \ if (SCM_LIKELY (SCM_I_INUMP (idx) \
@ -380,7 +380,7 @@ BV_REF_WITH_ENDIANNESS (f64, ieee_double)
#define BV_FLOAT_REF(stem, fn_stem, type, size) \ #define BV_FLOAT_REF(stem, fn_stem, type, size) \
{ \ { \
long i; \ long i = 0; \
ARGS2 (bv, idx); \ ARGS2 (bv, idx); \
VM_VALIDATE_BYTEVECTOR (bv); \ VM_VALIDATE_BYTEVECTOR (bv); \
if (SCM_LIKELY (SCM_I_INUMP (idx) \ if (SCM_LIKELY (SCM_I_INUMP (idx) \
@ -454,7 +454,7 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double)
#define BV_FIXABLE_INT_SET(stem, fn_stem, type, min, max, size) \ #define BV_FIXABLE_INT_SET(stem, fn_stem, type, min, max, size) \
{ \ { \
long i, j; \ long i = 0, j = 0; \
SCM bv, idx, val; POP (val); POP (idx); POP (bv); \ SCM bv, idx, val; POP (val); POP (idx); POP (bv); \
VM_VALIDATE_BYTEVECTOR (bv); \ VM_VALIDATE_BYTEVECTOR (bv); \
if (SCM_LIKELY (SCM_I_INUMP (idx) \ if (SCM_LIKELY (SCM_I_INUMP (idx) \
@ -472,7 +472,7 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double)
#define BV_INT_SET(stem, type, size) \ #define BV_INT_SET(stem, type, size) \
{ \ { \
long i; \ long i = 0; \
SCM bv, idx, val; POP (val); POP (idx); POP (bv); \ SCM bv, idx, val; POP (val); POP (idx); POP (bv); \
VM_VALIDATE_BYTEVECTOR (bv); \ VM_VALIDATE_BYTEVECTOR (bv); \
if (SCM_LIKELY (SCM_I_INUMP (idx) \ if (SCM_LIKELY (SCM_I_INUMP (idx) \
@ -487,7 +487,7 @@ BV_SET_WITH_ENDIANNESS (f64, ieee_double)
#define BV_FLOAT_SET(stem, fn_stem, type, size) \ #define BV_FLOAT_SET(stem, fn_stem, type, size) \
{ \ { \
long i; \ long i = 0; \
SCM bv, idx, val; POP (val); POP (idx); POP (bv); \ SCM bv, idx, val; POP (val); POP (idx); POP (bv); \
VM_VALIDATE_BYTEVECTOR (bv); \ VM_VALIDATE_BYTEVECTOR (bv); \
if (SCM_LIKELY (SCM_I_INUMP (idx) \ if (SCM_LIKELY (SCM_I_INUMP (idx) \

43
test-suite/tests/asm-to-bytecode.test
View file

@ -15,6 +15,7 @@
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite tests asm-to-bytecode) (define-module (test-suite tests asm-to-bytecode)
#:use-module (rnrs bytevector)
#:use-module (test-suite lib) #:use-module (test-suite lib)
#:use-module (system vm instruction) #:use-module (system vm instruction)
#:use-module (language assembly compile-bytecode)) #:use-module (language assembly compile-bytecode))
@ -45,6 +46,14 @@
(lambda () (lambda ()
(equal? v y))))) (equal? v y)))))
(define (u32->u8-list x)
;; Return a 4 uint8 list corresponding to the host's native representation
;; of X, a uint32.
(let ((bv (make-bytevector 4)))
(bytevector-u32-native-set! bv 0 x)
(bytevector->u8-list bv)))
(with-test-prefix "compiler" (with-test-prefix "compiler"
(with-test-prefix "asm-to-bytecode" (with-test-prefix "asm-to-bytecode"
@ -75,22 +84,30 @@
(comp-test '(load-keyword "qux") (comp-test '(load-keyword "qux")
(vector 'load-keyword 0 0 3 (char->integer #\q) (char->integer #\u) (vector 'load-keyword 0 0 3 (char->integer #\q) (char->integer #\u)
(char->integer #\x))) (char->integer #\x)))
;; fixme: little-endian test.
(comp-test '(load-program 3 2 1 0 () 3 #f (make-int8 3) (return))
(vector 'load-program 3 2 1 0 3 0 0 0 0 0 0 0
(instruction->opcode 'make-int8) 3
(instruction->opcode 'return)))
;; fixme: little-endian test. (comp-test '(load-program 3 2 1 0 () 3 #f (make-int8 3) (return))
(list->vector
`(load-program
3 2 1 0 ;; nargs, nrest, nlocs, nexts
,@(u32->u8-list 3) ;; len
,@(u32->u8-list 0) ;; metalen
make-int8 3
return)))
(comp-test '(load-program 3 2 1 0 () 3 (comp-test '(load-program 3 2 1 0 () 3
(load-program 3 2 1 0 () 3 (load-program 3 2 1 0 () 3
#f #f
(make-int8 3) (return)) (make-int8 3) (return))
(make-int8 3) (return)) (make-int8 3) (return))
(vector 'load-program 3 2 1 0 3 0 0 0 (+ 3 12) 0 0 0 (list->vector
(instruction->opcode 'make-int8) 3 `(load-program
(instruction->opcode 'return) 3 2 1 0 ;; nargs, nrest, nlocs, nexts
3 2 1 0 3 0 0 0 0 0 0 0 ,@(u32->u8-list 3) ;; len
(instruction->opcode 'make-int8) 3 ,@(u32->u8-list (+ 3 12)) ;; metalen
(instruction->opcode 'return))))) make-int8 3
return
3 2 1 0 ;; nargs, nrest, nlocs, nexts
,@(u32->u8-list 3) ;; len
,@(u32->u8-list 0) ;; metalen
make-int8 3
return)))))