mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +02:00
Code Activity

parse jumps as labels when decompiling bytecode->assembly

Browse source 
* module/language/assembly/decompile-bytecode.scm (decode-load-program):
  Parse out jumps as labels.
This commit is contained in:
Andy Wingo 2009-03-14 12:01:56 +01:00 • committed by Andy Wingo
parent 1dcf33280d
commit 6fe6a2a27d
1 changed files with 28 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -39,6 +39,15 @@
(values ret env) (values ret env)
(error "bad bytecode: only decoded ~a out of ~a bytes" i size))))) (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) (define (decode-load-program pop)
(let* ((nargs (pop)) (nrest (pop)) (nlocs (pop)) (nexts (pop)) (let* ((nargs (pop)) (nrest (pop)) (nlocs (pop)) (nexts (pop))
(a (pop)) (b (pop)) (c (pop)) (d (pop)) (a (pop)) (b (pop)) (c (pop)) (d (pop))
@ -46,7 +55,15 @@
(len (+ a (ash b 8) (ash c 16) (ash d 24))) (len (+ a (ash b 8) (ash c 16) (ash d 24)))
(metalen (+ e (ash f 8) (ash g 16) (ash h 24))) (metalen (+ e (ash f 8) (ash g 16) (ash h 24)))
(totlen (+ len metalen)) (totlen (+ len metalen))
(labels '())
(i 0)) (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. (define (sub-pop) ;; ...records. ha. ha.
(let ((b (cond ((< i len) (pop)) (let ((b (cond ((< i len) (pop))
((= i len) #f) ((= i len) #f)
@ -57,13 +74,21 @@
(cond ((> i len) (cond ((> i len)
(error "error decoding program -- read too many bytes" out)) (error "error decoding program -- read too many bytes" out))
((= i len) ((= 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)) ,(if (zero? metalen) #f (decode-load-program pop))
,@(reverse! out))) ,@(reverse! out)))
(else (else
(let ((exp (decode-bytecode sub-pop))) (let ((exp (decode-bytecode sub-pop)))
;; replace with labels? (pmatch exp
(lp (cons exp out)))))))) ((,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) (define (decode-bytecode pop)
(and=> (pop) (and=> (pop)