dmbcs/guile
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

add metalen field to bytecode serialization

Browse source 
* 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.
This commit is contained in:
Andy Wingo 2009-02-01 09:19:24 +01:00
commit 9aeaabdc45
8 changed files with 25 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

4
libguile/objcodes.h
View file

@ -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)

5
libguile/vm.c
View file

@ -271,12 +271,13 @@ static SCM
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);
}

8
module/language/assembly.scm
View file

@ -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))))

3
module/language/assembly/compile-bytecode.scm
View file

@ -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)))

13
module/language/assembly/decompile-bytecode.scm
View file

@ -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)))

2
module/language/assembly/disassemble.scm
View file

@ -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)))

2
module/language/glil/compile-assembly.scm
View file

@ -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

4
test-suite/tests/asm-to-bytecode.test
View file

@ -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)))))