This is an automated email from the git hooks/post-receive script. It was generated because a ref change was pushed to the repository containing the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=e9588e7032ced422014fb29bfaa6dbb7c2582b12 The branch, master has been updated via e9588e7032ced422014fb29bfaa6dbb7c2582b12 (commit) via e0230913e9bb1e54576ef7b9347c786ede99f733 (commit) from 7ea00e230aa05bc143c12d20dbc1d865129875a9 (commit) Those revisions listed above that are new to this repository have not appeared on any other notification email; so we list those revisions in full, below. - Log ----------------------------------------------------------------- commit e9588e7032ced422014fb29bfaa6dbb7c2582b12 Author: Andy Wingo <wi...@pobox.com> Date: Fri Oct 4 15:28:40 2013 +0200 Disassembling RTL prints source information. * module/system/vm/disassembler.scm (disassemble-buffer): Print source information. commit e0230913e9bb1e54576ef7b9347c786ede99f733 Author: Andy Wingo <wi...@pobox.com> Date: Fri Oct 4 15:09:31 2013 +0200 add contification test * test-suite/tests/rtl-compilation.test ("contification"): Add contification test where non-recursive call is not in tail position relative to the letrec. ----------------------------------------------------------------------- Summary of changes: module/system/vm/disassembler.scm | 22 ++++++++++++++++++++-- test-suite/tests/rtl-compilation.test | 11 ++++++++++- 2 files changed, 30 insertions(+), 3 deletions(-) diff --git a/module/system/vm/disassembler.scm b/module/system/vm/disassembler.scm index ad7bb2b..4917743 100644 --- a/module/system/vm/disassembler.scm +++ b/module/system/vm/disassembler.scm @@ -311,15 +311,33 @@ address of that offset." addr info extra src)) (define (disassemble-buffer port bv start end context) - (let ((labels (compute-labels bv start end))) + (let ((labels (compute-labels bv start end)) + (sources (find-program-sources (u32-offset->addr start context) + context))) + (define (lookup-source addr) + (let lp ((sources sources)) + (match sources + (() #f) + ((source . sources) + (let ((pc (source-pre-pc source))) + (cond + ((< pc addr) (lp sources)) + ((= pc addr) + (format #f "~a:~a:~a" + (source-file source) + (source-line-for-user source) + (source-column source))) + (else #f))))))) (let lp ((offset start)) (when (< offset end) (call-with-values (lambda () (disassemble-one bv offset)) (lambda (len elt) (let ((pos (- offset start)) + (addr (u32-offset->addr offset context)) (annotation (code-annotation elt len offset start labels context))) - (print-info port pos (vector-ref labels pos) elt annotation #f) + (print-info port pos (vector-ref labels pos) elt annotation + (lookup-source addr)) (lp (+ offset len))))))))) (define* (disassemble-program program #:optional (port (current-output-port))) diff --git a/test-suite/tests/rtl-compilation.test b/test-suite/tests/rtl-compilation.test index cf00a4f..ef4ab8d 100644 --- a/test-suite/tests/rtl-compilation.test +++ b/test-suite/tests/rtl-compilation.test @@ -158,7 +158,16 @@ (define (odd? x) (if (null? x) #f (even? (cdr x)))) (even? x))) - '(1 2 3))))) + '(1 2 3)))) + + (pass-if-equal '(#t) + ((run-rtl '(lambda (x) + (define (even? x) + (if (null? x) #t (odd? (cdr x)))) + (define (odd? x) + (if (null? x) #f (even? (cdr x)))) + (list (even? x)))) + '(1 2 3 4)))) (with-test-prefix "case-lambda" (pass-if-equal "simple" hooks/post-receive -- GNU Guile
