diff options
author | Andy Wingo <wingo@pobox.com> | 2009-03-14 16:24:34 +0100 |
---|---|---|
committer | Andy Wingo <wingo@oblong.net> | 2009-03-17 16:47:43 +0100 |
commit | 06dc937dd7575c820d8a0884978d0c22de4946fc (patch) | |
tree | 127b3d14f6d226e53e0caf4028e932a7996ed30a | |
parent | ff33605d6a5046019562661857e2ea2d41c54f3c (diff) | |
download | guile-06dc937dd7575c820d8a0884978d0c22de4946fc.tar.gz |
decompile source info into <glil-source> annotations.
* module/language/glil/decompile-assembly.scm (decompile-load-program):
Decompile source information into <glil-source> annotations.
-rw-r--r-- | module/language/glil/decompile-assembly.scm | 26 |
1 files changed, 26 insertions, 0 deletions
diff --git a/module/language/glil/decompile-assembly.scm b/module/language/glil/decompile-assembly.scm index 7b1d591eb..a98c39975 100644 --- a/module/language/glil/decompile-assembly.scm +++ b/module/language/glil/decompile-assembly.scm @@ -68,6 +68,7 @@ (unbindings (sort (if meta (car meta) '()) (lambda (x y) (< (binding:end x) (binding:end y))))) (sources (if meta (cadr meta) '())) + (filename #f) (props (if meta (cddr meta) '()))) (define (pop-bindings! addr) (let lp ((in bindings) (out '())) @@ -83,6 +84,19 @@ (set! unbindings in) (if (null? out) #f (reverse out))) (lp (cdr in) (cons (car in) out))))) + (define (pop-source! addr) + ;; a fragile algorithm. + (cond ((null? sources) #f) + ((eq? (caar sources) 'filename) + (set! filename (cdar sources)) + (pop-source! addr)) + ((eqv? (caar sources) addr) + (let ((x (car sources))) + (set! sources (cdr sources)) + `((filename . ,filename) + (line . ,(cadr x)) + (column . ,(cddr x))))) + (else #f))) (let lp ((in body) (stack '()) (out '()) (pos 0)) (cond ((null? in) @@ -105,6 +119,9 @@ ((pop-unbindings! pos) => (lambda (bindings) (lp in stack (cons (make-glil-unbind) out) pos))) + ((pop-source! pos) + => (lambda (s) + (lp in stack (cons (make-glil-source s) out) pos))) ((and (or (null? out) (not (glil-label? (car out)))) (assv-ref glil-labels pos)) => (lambda (label) @@ -131,6 +148,15 @@ (lp (cdr in) (cons 1 stack) out (1+ pos))) ((make-int8 ,n) (lp (cdr in) (cons n stack) out (+ pos 2))) + ((cons) + (let ((head (list-head stack 2)) + (stack (list-tail stack 2))) + (if (memq *placeholder* head) + (lp (cdr in) (cons *placeholder* stack) + (cons (make-glil-call 'cons 2) (emit-constants head out)) + (+ pos 1)) + (lp (cdr in) (cons (cons (cadr head) (car head)) stack) + out (+ pos 3))))) ((list ,a ,b) (let* ((len (+ (ash a 8) b)) (head (list-head stack len)) |