summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--libguile/objcodes.c2
-rw-r--r--libguile/objcodes.h1
-rw-r--r--libguile/vm-engine.h4
-rw-r--r--libguile/vm-i-system.c2
-rw-r--r--libguile/vm.c49
-rw-r--r--module/language/assembly.scm6
-rw-r--r--module/language/assembly/compile-bytecode.scm1
-rw-r--r--module/language/assembly/decompile-bytecode.scm1
-rw-r--r--module/language/glil/compile-assembly.scm17
-rw-r--r--test-suite/tests/asm-to-bytecode.test15
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))))