summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2009-02-01 09:19:24 +0100
committerAndy Wingo <wingo@pobox.com>2009-02-01 09:19:24 +0100
commit9aeaabdc4571b5a2319c88e02904bd8996d5ac01 (patch)
treeebc106e1e56e3a34fa6049b9f2bfbb69661d782e
parentd2d7acd5c11c6573dad62b0a77ace7bb6603e425 (diff)
downloadguile-9aeaabdc4571b5a2319c88e02904bd8996d5ac01.tar.gz
add metalen field to bytecode serialization
* libguile/objcodes.h (struct scm_objcode): Add a new field, metalen, in preparation for embedding metadata within a program. (SCM_OBJCODE_META_LEN, SCM_OBJCODE_TOTAL_LEN): New defines. * libguile/vm.c (really_make_boot_program): * module/language/assembly.scm (*program-header-len*, byte-length): * module/language/assembly/compile-bytecode.scm (write-bytecode): * module/language/assembly/decompile-bytecode.scm (decode-load-program): * module/language/assembly/disassemble.scm (disassemble-load-program): * module/language/glil/compile-assembly.scm (glil->assembly): * test-suite/tests/asm-to-bytecode.test ("compiler"): Update for metalen addition.
-rw-r--r--libguile/objcodes.h4
-rw-r--r--libguile/vm.c5
-rw-r--r--module/language/assembly.scm8
-rw-r--r--module/language/assembly/compile-bytecode.scm3
-rw-r--r--module/language/assembly/decompile-bytecode.scm13
-rw-r--r--module/language/assembly/disassemble.scm2
-rw-r--r--module/language/glil/compile-assembly.scm2
-rw-r--r--test-suite/tests/asm-to-bytecode.test4
8 files changed, 25 insertions, 16 deletions
diff --git a/libguile/objcodes.h b/libguile/objcodes.h
index 6b3c2aec9..7480a03c1 100644
--- a/libguile/objcodes.h
+++ b/libguile/objcodes.h
@@ -51,6 +51,8 @@ struct scm_objcode {
scm_t_uint8 nlocs;
scm_t_uint8 nexts;
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_uint8 base[0];
};
@@ -65,6 +67,8 @@ extern scm_t_bits scm_tc16_objcode;
#define SCM_VALIDATE_OBJCODE(p,x) SCM_MAKE_VALIDATE (p, x, OBJCODE_P)
#define SCM_OBJCODE_LEN(x) (SCM_OBJCODE_DATA (x)->len)
+#define SCM_OBJCODE_META_LEN(x) (SCM_OBJCODE_DATA (x)->metalen)
+#define SCM_OBJCODE_TOTAL_LEN(x) (SCM_OBJCODE_LEN (x) + SCM_OBJCODE_META_LEN (x))
#define SCM_OBJCODE_NARGS(x) (SCM_OBJCODE_DATA (x)->nargs)
#define SCM_OBJCODE_NREST(x) (SCM_OBJCODE_DATA (x)->nrest)
#define SCM_OBJCODE_NLOCS(x) (SCM_OBJCODE_DATA (x)->nlocs)
diff --git a/libguile/vm.c b/libguile/vm.c
index 9e5e9dbe6..ffb14384e 100644
--- a/libguile/vm.c
+++ b/libguile/vm.c
@@ -272,11 +272,12 @@ really_make_boot_program (long nargs)
{
scm_byte_t 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};
- ((scm_t_uint32*)bytes)[1] = 6; /* set len in current endianness */
+ ((scm_t_uint32*)bytes)[1] = 6; /* set len in current endianness, no meta */
if (SCM_UNLIKELY (nargs > 255 || nargs < 0))
abort ();
- bytes[9] = (scm_byte_t)nargs;
+ bytes[13] = (scm_byte_t)nargs;
return scm_make_program (scm_bytecode_to_objcode (make_u8vector (bytes, sizeof(bytes))),
SCM_BOOL_F, SCM_EOL);
}
diff --git a/module/language/assembly.scm b/module/language/assembly.scm
index b124081a7..8887eab4b 100644
--- a/module/language/assembly.scm
+++ b/module/language/assembly.scm
@@ -26,8 +26,8 @@
assembly-pack assembly-unpack
object->assembly assembly->object))
-;; nargs, nrest, nlocs, nexts, len
-(define *program-header-len* (+ 1 1 1 1 4))
+;; nargs, nrest, nlocs, nexts, len, metalen
+(define *program-header-len* (+ 1 1 1 1 4 4))
;; lengths are encoded in 3 bytes
(define *len-len* 3)
@@ -48,8 +48,8 @@
(+ 1 *len-len* (string-length str)))
((define ,str)
(+ 1 *len-len* (string-length str)))
- ((load-program ,nargs ,nrest ,nlocs ,nexts ,labels ,len . ,code)
- (+ 1 *program-header-len* len))
+ ((load-program ,nargs ,nrest ,nlocs ,nexts ,labels ,len ,metalen . ,code)
+ (+ 1 *program-header-len* len metalen))
((,inst . _) (guard (>= (instruction-length inst) 0))
(+ 1 (instruction-length inst)))
(else (error "unknown instruction" assembly))))
diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm
index 17a71f21b..bf423ab74 100644
--- a/module/language/assembly/compile-bytecode.scm
+++ b/module/language/assembly/compile-bytecode.scm
@@ -81,12 +81,13 @@
(write-byte opcode)
(pmatch asm
((load-program ,nargs ,nrest ,nlocs ,nexts
- ,labels ,length . ,code)
+ ,labels ,length ,metalength . ,code)
(write-byte nargs)
(write-byte nrest)
(write-byte nlocs)
(write-byte nexts)
(write-uint32-le length) ;; FIXME!
+ (write-uint32-le metalength) ;; FIXME!
(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 4bcae800b..e8d175d23 100644
--- a/module/language/assembly/decompile-bytecode.scm
+++ b/module/language/assembly/decompile-bytecode.scm
@@ -42,19 +42,22 @@
(define (decode-load-program pop)
(let* ((nargs (pop)) (nrest (pop)) (nlocs (pop)) (nexts (pop))
(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)))
+ (metalen (+ e (ash f 8) (ash g 16) (ash h 24)))
+ (totlen (+ len metalen))
(i 0))
(define (sub-pop) ;; ...records. ha. ha.
- (let ((b (cond ((< i len) (pop))
- ((= i len) #f)
+ (let ((b (cond ((< i totlen) (pop))
+ ((= i totlen) #f)
(else (error "tried to decode too many bytes")))))
(if b (set! i (1+ i)))
b))
(let lp ((out '()))
- (cond ((> i len)
+ (cond ((> i totlen)
(error "error decoding program -- read too many bytes" out))
- ((= i len)
- `(load-program ,nargs ,nrest ,nlocs ,nexts () ,len
+ ((= i totlen)
+ `(load-program ,nargs ,nrest ,nlocs ,nexts () ,len ,metalen
,@(reverse! out)))
(else
(let ((exp (decode-bytecode sub-pop)))
diff --git a/module/language/assembly/disassemble.scm b/module/language/assembly/disassemble.scm
index 7c7ba15e2..7a5691952 100644
--- a/module/language/assembly/disassemble.scm
+++ b/module/language/assembly/disassemble.scm
@@ -36,7 +36,7 @@
(define (disassemble-load-program asm env)
(pmatch asm
- ((load-program ,nargs ,nrest ,nlocs ,nexts ,labels ,len . ,code)
+ ((load-program ,nargs ,nrest ,nlocs ,nexts ,labels ,len ,metalen . ,code)
(let ((objs (and env (assq-ref env 'objects)))
(meta (and env (assq-ref env 'meta)))
(exts (and env (assq-ref env 'exts)))
diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm
index 55699300f..fc75930ee 100644
--- a/module/language/glil/compile-assembly.scm
+++ b/module/language/glil/compile-assembly.scm
@@ -151,7 +151,7 @@
(receive (code bindings sources labels objects len)
(process-body)
(let ((prog `(load-program ,nargs ,nrest ,nlocs ,nexts ,labels
- ,len . ,code)))
+ ,len 0 . ,code)))
(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 daad0b339..8064489d5 100644
--- a/test-suite/tests/asm-to-bytecode.test
+++ b/test-suite/tests/asm-to-bytecode.test
@@ -77,7 +77,7 @@
(char->integer #\x)))
;; fixme: little-endian test.
- (comp-test '(load-program 3 2 1 0 '() 3 (make-int8 3) (return))
- (vector 'load-program 3 2 1 0 3 0 0 0
+ (comp-test '(load-program 3 2 1 0 '() 3 0 (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)))))