diff options
author | Andy Wingo <wingo@pobox.com> | 2013-11-08 17:41:31 +0100 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2013-11-08 17:41:31 +0100 |
commit | 741073719e657c8d7103287e942a72a6aedcce88 (patch) | |
tree | aad38be18fd8d8173a708bf6ce13819f8f76831e | |
parent | 70974fd21329896f4d6fdca0147c46f723233d9d (diff) | |
download | guile-741073719e657c8d7103287e942a72a6aedcce88.tar.gz |
Remove program-sources-pre-retire case for stack programs.
* module/system/vm/program.scm (program-sources-pre-retire): Remove
stack program case.
-rw-r--r-- | module/system/vm/program.scm | 35 |
1 files changed, 6 insertions, 29 deletions
diff --git a/module/system/vm/program.scm b/module/system/vm/program.scm index cf77c2824..f99df8091 100644 --- a/module/system/vm/program.scm +++ b/module/system/vm/program.scm @@ -21,7 +21,6 @@ (define-module (system vm program) #:use-module (ice-9 match) #:use-module (system vm instruction) - #:use-module (system vm objcode) #:use-module (system vm debug) #:use-module (rnrs bytevectors) #:use-module (srfi srfi-1) @@ -161,34 +160,12 @@ ;; pre-retire addresses. ;; (define (program-sources-pre-retire proc) - (cond - ((rtl-program? proc) - (map (lambda (source) - (cons* (- (source-pre-pc source) (rtl-program-code proc)) - (source-file source) - (source-line source) - (source-column source))) - (find-program-sources (rtl-program-code proc)))) - (else - (let ((bv (objcode->bytecode (program-objcode proc)))) - (let lp ((in (program-sources proc)) - (out '()) - (ip 0)) - (cond - ((null? in) - (reverse out)) - (else - (match (car in) - ((post-ip . source) - (let lp2 ((ip ip) - (next ip)) - (if (< next post-ip) - (lp2 next (+ next (bytecode-instruction-length bv next))) - (lp (cdr in) - (acons ip source out) - next)))) - (_ - (error "unexpected")))))))))) + (map (lambda (source) + (cons* (- (source-pre-pc source) (rtl-program-code proc)) + (source-file source) + (source-line source) + (source-column source))) + (find-program-sources (rtl-program-code proc)))) (define (collapse-locals locs) (let lp ((ret '()) (locs locs)) |