diff options
author | Andy Wingo <wingo@pobox.com> | 2009-02-01 09:19:24 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2009-02-01 09:19:24 +0100 |
commit | 9aeaabdc4571b5a2319c88e02904bd8996d5ac01 (patch) | |
tree | ebc106e1e56e3a34fa6049b9f2bfbb69661d782e | |
parent | d2d7acd5c11c6573dad62b0a77ace7bb6603e425 (diff) | |
download | guile-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.h | 4 | ||||
-rw-r--r-- | libguile/vm.c | 5 | ||||
-rw-r--r-- | module/language/assembly.scm | 8 | ||||
-rw-r--r-- | module/language/assembly/compile-bytecode.scm | 3 | ||||
-rw-r--r-- | module/language/assembly/decompile-bytecode.scm | 13 | ||||
-rw-r--r-- | module/language/assembly/disassemble.scm | 2 | ||||
-rw-r--r-- | module/language/glil/compile-assembly.scm | 2 | ||||
-rw-r--r-- | test-suite/tests/asm-to-bytecode.test | 4 |
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))))) |