diff options
-rw-r--r-- | libguile/objcodes.c | 2 | ||||
-rw-r--r-- | libguile/objcodes.h | 1 | ||||
-rw-r--r-- | libguile/vm-engine.h | 4 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 2 | ||||
-rw-r--r-- | libguile/vm.c | 49 | ||||
-rw-r--r-- | module/language/assembly.scm | 6 | ||||
-rw-r--r-- | module/language/assembly/compile-bytecode.scm | 1 | ||||
-rw-r--r-- | module/language/assembly/decompile-bytecode.scm | 1 | ||||
-rw-r--r-- | module/language/glil/compile-assembly.scm | 17 | ||||
-rw-r--r-- | test-suite/tests/asm-to-bytecode.test | 15 |
10 files changed, 53 insertions, 45 deletions
diff --git a/libguile/objcodes.c b/libguile/objcodes.c index 5a43edb67..728dd8d13 100644 --- a/libguile/objcodes.c +++ b/libguile/objcodes.c @@ -50,7 +50,7 @@ /* The objcode magic header. */ #define OBJCODE_COOKIE \ - "GOOF-0.7-" OBJCODE_ENDIANNESS "-" OBJCODE_WORD_SIZE "---" + "GOOF-0.8-" OBJCODE_ENDIANNESS "-" OBJCODE_WORD_SIZE "---" /* The length of the header must be a multiple of 8 bytes. */ verify (((sizeof (OBJCODE_COOKIE) - 1) & 7) == 0); diff --git a/libguile/objcodes.h b/libguile/objcodes.h index d50f6dc94..2bb4e6040 100644 --- a/libguile/objcodes.h +++ b/libguile/objcodes.h @@ -29,6 +29,7 @@ struct scm_objcode { 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 */ + scm_t_uint32 unused; /* pad so that `base' is 8-byte aligned */ scm_t_uint8 base[0]; }; diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h index 15ebb539e..c0f772fb8 100644 --- a/libguile/vm-engine.h +++ b/libguile/vm-engine.h @@ -130,11 +130,14 @@ #ifdef VM_ENABLE_PARANOID_ASSERTIONS #define CHECK_IP() \ do { if (ip < bp->base || ip - bp->base > bp->len) abort (); } while (0) +#define ASSERT_ALIGNED_PROCEDURE() \ + do { if ((scm_t_bits)bp % 8) abort (); } while (0) #define ASSERT_BOUND(x) \ do { if ((x) == SCM_UNDEFINED) { SYNC_REGISTER (); abort(); } \ } while (0) #else #define CHECK_IP() +#define ASSERT_ALIGNED_PROCEDURE() #define ASSERT_BOUND(x) #endif @@ -143,6 +146,7 @@ { \ if (bp != SCM_PROGRAM_DATA (program)) { \ bp = SCM_PROGRAM_DATA (program); \ + ASSERT_ALIGNED_PROCEDURE (); \ if (SCM_I_IS_VECTOR (SCM_PROGRAM_OBJTABLE (program))) { \ objects = SCM_I_VECTOR_WELTS (SCM_PROGRAM_OBJTABLE (program)); \ object_count = SCM_I_VECTOR_LENGTH (SCM_PROGRAM_OBJTABLE (program)); \ diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index c2c674d27..b2cdca5be 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -283,7 +283,7 @@ VM_DEFINE_INSTRUCTION (26, long_local_ref, "long-local-ref", 2, 0, 1) unsigned int i = FETCH (); i <<= 8; i += FETCH (); - PUSH (LOCAL_REF (i)) + PUSH (LOCAL_REF (i)); ASSERT_BOUND (*sp); NEXT; } diff --git a/libguile/vm.c b/libguile/vm.c index 41eacd79f..527598b86 100644 --- a/libguile/vm.c +++ b/libguile/vm.c @@ -220,44 +220,33 @@ static SCM sym_vm_run; static SCM sym_vm_error; static SCM sym_debug; -static SCM make_u8vector (const scm_t_uint8 *bytes, size_t len) -{ - scm_t_uint8 *new_bytes = scm_gc_malloc (len, "make-u8vector"); - memcpy (new_bytes, bytes, len); - return scm_take_u8vector (new_bytes, len); -} - -/* Dummy structure to guarantee 32-bit alignment. */ -struct t_32bit_aligned -{ - scm_t_int32 dummy; - scm_t_uint8 bytes[18]; -}; - static SCM really_make_boot_program (long nargs) { SCM u8vec; - struct t_32bit_aligned bytes = - { - .dummy = 0, - .bytes = { 0, 0, 0, 0, - 0, 0, 0, 0, - 0, 0, 0, 0, - scm_op_mv_call, 0, 0, 1, - scm_op_make_int8_1, scm_op_halt } - }; - + /* Make sure "bytes" is 64-bit aligned. */ + scm_t_uint8 text[] = { scm_op_mv_call, 0, 0, 1, + scm_op_make_int8_1, + scm_op_halt }; + struct scm_objcode *bp; SCM ret; - /* Set length in current endianness, no meta. */ - ((scm_t_uint32 *) bytes.bytes)[1] = 6; - if (SCM_UNLIKELY (nargs > 255 || nargs < 0)) abort (); - bytes.bytes[13] = (scm_byte_t) nargs; - - u8vec = make_u8vector (bytes.bytes, sizeof (bytes.bytes)); + text[1] = (scm_t_uint8)nargs; + + bp = scm_gc_malloc (sizeof (struct scm_objcode) + sizeof (text), + "make-u8vector"); + memcpy (bp->base, text, sizeof (text)); + bp->nargs = 0; + bp->nrest = 0; + bp->nlocs = 0; + bp->len = sizeof(text); + bp->metalen = 0; + bp->unused = 0; + + u8vec = scm_take_u8vector ((scm_t_uint8*)bp, + sizeof (struct scm_objcode) + sizeof (text)); ret = scm_make_program (scm_bytecode_to_objcode (u8vec), SCM_BOOL_F, SCM_BOOL_F); SCM_SET_SMOB_FLAGS (ret, SCM_F_PROGRAM_IS_BOOT); diff --git a/module/language/assembly.scm b/module/language/assembly.scm index 0ad94be84..90b2acc03 100644 --- a/module/language/assembly.scm +++ b/module/language/assembly.scm @@ -28,8 +28,8 @@ assembly-pack assembly-unpack object->assembly assembly->object)) -;; nargs, nrest, nlocs, <unused>, len, metalen -(define *program-header-len* (+ 1 1 1 1 4 4)) +;; nargs, nrest, nlocs, len, metalen, padding +(define *program-header-len* (+ 1 1 2 4 4 4)) ;; lengths are encoded in 3 bytes (define *len-len* 3) @@ -109,7 +109,7 @@ ((null? x) `(make-eol)) ((and (integer? x) (exact? x)) (cond ((and (<= -128 x) (< x 128)) - `(make-int8 ,(modulo x 256))) + (assembly-pack `(make-int8 ,(modulo x 256)))) ((and (<= -32768 x) (< x 32768)) (let ((n (if (< x 0) (+ x 65536) x))) `(make-int16 ,(quotient n 256) ,(modulo n 256)))) diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm index 80dee833a..58afddde0 100644 --- a/module/language/assembly/compile-bytecode.scm +++ b/module/language/assembly/compile-bytecode.scm @@ -102,6 +102,7 @@ (write-uint16 nlocs) (write-uint32 length) (write-uint32 (if meta (1- (byte-length meta)) 0)) + (write-uint32 0) ; padding (letrec ((i 0) (write (lambda (x) (set! i (1+ i)) (write-byte x))) (get-addr (lambda () i))) diff --git a/module/language/assembly/decompile-bytecode.scm b/module/language/assembly/decompile-bytecode.scm index 231205d08..82459fc6f 100644 --- a/module/language/assembly/decompile-bytecode.scm +++ b/module/language/assembly/decompile-bytecode.scm @@ -57,6 +57,7 @@ (len (+ a (ash b 8) (ash c 16) (ash d 24))) (metalen (+ e (ash f 8) (ash g 16) (ash h 24))) (totlen (+ len metalen)) + (pad0 (pop)) (pad1 (pop)) (pad2 (pop)) (pad3 (pop)) (labels '()) (i 0)) (define (ensure-label rel1 rel2) diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm index c4725e27c..2e586ec5e 100644 --- a/module/language/glil/compile-assembly.scm +++ b/module/language/glil/compile-assembly.scm @@ -137,9 +137,9 @@ (define (glil->assembly glil toplevel? bindings source-alist label-alist object-alist addr) (define (emit-code x) - (values (map assembly-pack x) bindings source-alist label-alist object-alist)) + (values x bindings source-alist label-alist object-alist)) (define (emit-code/object x object-alist) - (values (map assembly-pack x) bindings source-alist label-alist object-alist)) + (values x bindings source-alist label-alist object-alist)) (record-case glil ((<glil-program> nargs nrest nlocs meta body) @@ -164,10 +164,15 @@ (receive (code bindings sources labels objects len) (process-body) - (let ((prog `(load-program ,nargs ,nrest ,nlocs ,labels - ,len - ,(make-meta bindings sources meta) - . ,code))) + (let* ((meta (make-meta bindings sources meta)) + (meta-pad (if meta (modulo (- 8 (modulo len 8)) 8) 0)) + (prog `(load-program ,nargs ,nrest ,nlocs ,labels + ,(+ len meta-pad) + ,meta + ,@code + ,@(if meta + (make-list meta-pad '(nop)) + '())))) (cond (toplevel? ;; toplevel bytecode isn't loaded by the vm, no way to do diff --git a/test-suite/tests/asm-to-bytecode.test b/test-suite/tests/asm-to-bytecode.test index fb598a64b..33a2a45f0 100644 --- a/test-suite/tests/asm-to-bytecode.test +++ b/test-suite/tests/asm-to-bytecode.test @@ -95,22 +95,29 @@ 3 2 (uint16 1) ;; nargs, nrest, nlocs (uint32 3) ;; len (uint32 0) ;; metalen + (uint32 0) ;; padding make-int8 3 return)) - (comp-test '(load-program 3 2 1 () 3 + ;; the nops are to pad meta to an 8-byte alignment. not strictly + ;; necessary for this test, but representative of the common case. + (comp-test '(load-program 3 2 1 () 8 (load-program 3 2 1 () 3 #f (make-int8 3) (return)) - (make-int8 3) (return)) + (make-int8 3) (return) + (nop) (nop) (nop) (nop) (nop)) #(load-program 3 2 (uint16 1) ;; nargs, nrest, nlocs - (uint32 3) ;; len - (uint32 15) ;; metalen + (uint32 8) ;; len + (uint32 19) ;; metalen + (uint32 0) ;; padding make-int8 3 return + nop nop nop nop nop 3 2 (uint16 1) ;; nargs, nrest, nlocs (uint32 3) ;; len (uint32 0) ;; metalen + (uint32 0) ;; padding make-int8 3 return)))) |