diff options
author | Andy Wingo <wingo@pobox.com> | 2009-03-14 12:01:56 +0100 |
---|---|---|
committer | Andy Wingo <wingo@oblong.net> | 2009-03-17 16:47:14 +0100 |
commit | 6fe6a2a27d6a8285a837fce46227fedf41efc38f (patch) | |
tree | 6197ae6b42265a0b9308980e4a5aa370d053f9cd /module/language/assembly/decompile-bytecode.scm | |
parent | 1dcf33280d39c7b7366eae1083a287e2dea6a8ca (diff) | |
download | guile-6fe6a2a27d6a8285a837fce46227fedf41efc38f.tar.gz |
parse jumps as labels when decompiling bytecode->assembly
* module/language/assembly/decompile-bytecode.scm (decode-load-program):
Parse out jumps as labels.
Diffstat (limited to 'module/language/assembly/decompile-bytecode.scm')
-rw-r--r-- | module/language/assembly/decompile-bytecode.scm | 31 |
1 files changed, 28 insertions, 3 deletions
diff --git a/module/language/assembly/decompile-bytecode.scm b/module/language/assembly/decompile-bytecode.scm index d5ffae189..e65b2cbaa 100644 --- a/module/language/assembly/decompile-bytecode.scm +++ b/module/language/assembly/decompile-bytecode.scm @@ -39,6 +39,15 @@ (values ret env) (error "bad bytecode: only decoded ~a out of ~a bytes" i size))))) +(define (br-instruction? x) + (memq x '(br br-if br-if-not br-if-eq br-if-not-eq br-if-null br-if-not-null))) + +(define (bytes->s16 a b) + (let ((x (+ (ash a 8) b))) + (if (zero? (logand (ash 1 15) x)) + x + (- x (ash 1 16))))) + (define (decode-load-program pop) (let* ((nargs (pop)) (nrest (pop)) (nlocs (pop)) (nexts (pop)) (a (pop)) (b (pop)) (c (pop)) (d (pop)) @@ -46,7 +55,15 @@ (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)) + (labels '()) (i 0)) + (define (ensure-label rel1 rel2) + (let ((where (+ i (bytes->s16 rel1 rel2)))) + (or (assv-ref labels where) + (begin + (let ((l (gensym ":L"))) + (set! labels (acons where l labels)) + l))))) (define (sub-pop) ;; ...records. ha. ha. (let ((b (cond ((< i len) (pop)) ((= i len) #f) @@ -57,13 +74,21 @@ (cond ((> i len) (error "error decoding program -- read too many bytes" out)) ((= i len) - `(load-program ,nargs ,nrest ,nlocs ,nexts () ,len + `(load-program ,nargs ,nrest ,nlocs ,nexts + ,(map (lambda (x) (cons (cdr x) (car x))) + (reverse labels)) + ,len ,(if (zero? metalen) #f (decode-load-program pop)) ,@(reverse! out))) (else (let ((exp (decode-bytecode sub-pop))) - ;; replace with labels? - (lp (cons exp out)))))))) + (pmatch exp + ((,br ,rel1 ,rel2) (guard (br-instruction? br)) + (lp (cons `(,br ,(ensure-label rel1 rel2)) out))) + ((mv-call ,n ,rel1 ,rel2) + (lp (cons `(mv-call ,n ,(ensure-label rel1 rel2)) out))) + (else + (lp (cons exp out)))))))))) (define (decode-bytecode pop) (and=> (pop) |