From ccf77d955c875ce95473098af96da9e1bec0b7eb Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Fri, 24 Jul 2009 10:12:01 +0200 Subject: [PATCH] nlocs is now 16 bits wide * libguile/objcodes.h (struct scm_objcode): Remove the "unused" field -- the old "nexts" -- and expand nlocs to 16 bits. * module/language/assembly/compile-bytecode.scm (write-bytecode): Write the nlocs as a uint16. * module/language/assembly/decompile-bytecode.scm (decode-load-program): Decompile 16-bit nlocs. It seems this decompilation is little-endian :-/ * test-suite/tests/asm-to-bytecode.test: Fix up to understand nlocs as a little-endian value. The test does the right thing regarding endianness. --- libguile/objcodes.h | 3 +- module/language/assembly/compile-bytecode.scm | 7 +- .../language/assembly/decompile-bytecode.scm | 4 +- test-suite/tests/asm-to-bytecode.test | 73 ++++++++++--------- 4 files changed, 47 insertions(+), 40 deletions(-) diff --git a/libguile/objcodes.h b/libguile/objcodes.h index 6727e23e8..d50f6dc94 100644 --- a/libguile/objcodes.h +++ b/libguile/objcodes.h @@ -25,8 +25,7 @@ struct scm_objcode { scm_t_uint8 nargs; scm_t_uint8 nrest; - scm_t_uint8 nlocs; - scm_t_uint8 unused; + scm_t_uint16 nlocs; scm_t_uint32 len; /* the maximum index of base[] */ scm_t_uint32 metalen; /* well, i lie. this many bytes at the end of base[] for metadata */ diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm index 0a1489845..d17e00f2f 100644 --- a/module/language/assembly/compile-bytecode.scm +++ b/module/language/assembly/compile-bytecode.scm @@ -81,6 +81,10 @@ (let ((inst (car asm)) (args (cdr asm)) + (write-uint16 (case byte-order + ((1234) write-uint16-le) + ((4321) write-uint16-be) + (else (error "unknown endianness" byte-order)))) (write-uint32 (case byte-order ((1234) write-uint32-le) ((4321) write-uint32-be) @@ -92,8 +96,7 @@ ((load-program ,nargs ,nrest ,nlocs ,labels ,length ,meta . ,code) (write-byte nargs) (write-byte nrest) - (write-byte nlocs) - (write-byte 0) ;; what used to be nexts + (write-uint16 nlocs) (write-uint32 length) (write-uint32 (if meta (1- (byte-length meta)) 0)) (letrec ((i 0) diff --git a/module/language/assembly/decompile-bytecode.scm b/module/language/assembly/decompile-bytecode.scm index 56f58f750..231205d08 100644 --- a/module/language/assembly/decompile-bytecode.scm +++ b/module/language/assembly/decompile-bytecode.scm @@ -48,8 +48,10 @@ x (- x (ash 1 16))))) +;; FIXME: this is a little-endian disassembly!!! (define (decode-load-program pop) - (let* ((nargs (pop)) (nrest (pop)) (nlocs (pop)) (unused (pop)) + (let* ((nargs (pop)) (nrest (pop)) (nlocs0 (pop)) (nlocs1 (pop)) + (nlocs (+ nlocs0 (ash nlocs1 8))) (a (pop)) (b (pop)) (c (pop)) (d (pop)) (e (pop)) (f (pop)) (g (pop)) (h (pop)) (len (+ a (ash b 8) (ash c 16) (ash d 24))) diff --git a/test-suite/tests/asm-to-bytecode.test b/test-suite/tests/asm-to-bytecode.test index d819a3b1b..fb598a64b 100644 --- a/test-suite/tests/asm-to-bytecode.test +++ b/test-suite/tests/asm-to-bytecode.test @@ -20,16 +20,28 @@ #:use-module (system vm instruction) #:use-module (language assembly compile-bytecode)) +(define (->u8-list sym val) + (let ((entry (assq-ref `((uint16 2 ,bytevector-u16-native-set!) + (uint32 4 ,bytevector-u32-native-set!)) + sym))) + (or entry (error "unknown sym" sym)) + (let ((bv (make-bytevector (car entry)))) + ((cadr entry) bv 0 val) + (bytevector->u8-list bv)))) + (define (munge-bytecode v) - (let ((newv (make-u8vector (vector-length v)))) - (let lp ((i 0)) - (if (= i (vector-length v)) - newv - (let ((x (vector-ref v i))) - (u8vector-set! newv i (if (symbol? x) - (instruction->opcode x) - x)) - (lp (1+ i))))))) + (let lp ((i 0) (out '())) + (if (= i (vector-length v)) + (list->u8vector (reverse out)) + (let ((x (vector-ref v i))) + (cond + ((symbol? x) + (lp (1+ i) (cons (instruction->opcode x) out))) + ((integer? x) + (lp (1+ i) (cons x out))) + ((pair? x) + (lp (1+ i) (append (reverse (apply ->u8-list x)) out))) + (else (error "bad test bytecode" x))))))) (define (comp-test x y) (let* ((y (munge-bytecode y)) @@ -46,13 +58,6 @@ (lambda () (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 "asm-to-bytecode" @@ -86,28 +91,26 @@ (char->integer #\x))) (comp-test '(load-program 3 2 1 () 3 #f (make-int8 3) (return)) - (list->vector - `(load-program - 3 2 1 0 ;; nargs, nrest, nlocs, unused - ,@(u32->u8-list 3) ;; len - ,@(u32->u8-list 0) ;; metalen - make-int8 3 - return))) + #(load-program + 3 2 (uint16 1) ;; nargs, nrest, nlocs + (uint32 3) ;; len + (uint32 0) ;; metalen + make-int8 3 + return)) (comp-test '(load-program 3 2 1 () 3 (load-program 3 2 1 () 3 #f (make-int8 3) (return)) (make-int8 3) (return)) - (list->vector - `(load-program - 3 2 1 0 ;; nargs, nrest, nlocs, unused - ,@(u32->u8-list 3) ;; len - ,@(u32->u8-list (+ 3 12)) ;; metalen - make-int8 3 - return - 3 2 1 0 ;; nargs, nrest, nlocs, unused - ,@(u32->u8-list 3) ;; len - ,@(u32->u8-list 0) ;; metalen - make-int8 3 - return))))) + #(load-program + 3 2 (uint16 1) ;; nargs, nrest, nlocs + (uint32 3) ;; len + (uint32 15) ;; metalen + make-int8 3 + return + 3 2 (uint16 1) ;; nargs, nrest, nlocs + (uint32 3) ;; len + (uint32 0) ;; metalen + make-int8 3 + return))))