diff --git a/module/system/repl/command.scm b/module/system/repl/command.scm index ca080d279..1e6aaff3d 100644 --- a/module/system/repl/command.scm +++ b/module/system/repl/command.scm @@ -569,8 +569,6 @@ Trace execution." (identifier-syntax (debug-frames debug))) (#,(datum->syntax #'repl 'message) (identifier-syntax (debug-error-message debug))) - (#,(datum->syntax #'repl 'for-trap?) - (identifier-syntax (debug-for-trap? debug))) (#,(datum->syntax #'repl 'index) (identifier-syntax (id (debug-index debug)) @@ -592,8 +590,7 @@ If COUNT is negative, the last COUNT frames will be shown." (print-frames frames #:count count #:width width - #:full? full? - #:for-trap? for-trap?)) + #:full? full?)) (define-stack-command (up repl #:optional (count 1)) "up [COUNT] @@ -610,12 +607,10 @@ An argument says how many frames up to go." (format #t "Already at outermost frame.\n")) (else (set! index (1- (vector-length frames))) - (print-frame cur #:index index - #:next-source? (and (zero? index) for-trap?))))) + (print-frame cur #:index index)))) (else (set! index (+ count index)) - (print-frame cur #:index index - #:next-source? (and (zero? index) for-trap?))))) + (print-frame cur #:index index)))) (define-stack-command (down repl #:optional (count 1)) "down [COUNT] @@ -632,11 +627,10 @@ An argument says how many frames down to go." (format #t "Already at innermost frame.\n")) (else (set! index 0) - (print-frame cur #:index index #:next-source? for-trap?)))) + (print-frame cur #:index index)))) (else (set! index (- index count)) - (print-frame cur #:index index - #:next-source? (and (zero? index) for-trap?))))) + (print-frame cur #:index index)))) (define-stack-command (frame repl #:optional idx) "frame [IDX] @@ -651,12 +645,10 @@ With an argument, select a frame by index, then show it." (format #t "Invalid argument to `frame': expected a non-negative integer for IDX.~%")) ((< idx (vector-length frames)) (set! index idx) - (print-frame cur #:index index - #:next-source? (and (zero? index) for-trap?))) + (print-frame cur #:index index)) (else (format #t "No such frame.~%")))) - (else (print-frame cur #:index index - #:next-source? (and (zero? index) for-trap?))))) + (else (print-frame cur #:index index)))) (define-stack-command (procedure repl) "procedure @@ -722,7 +714,7 @@ Note that the given source location must be inside a procedure." (format #t "Return values:~%") (for-each (lambda (x) (repl-print repl x)) values))) ((module-ref (resolve-interface '(system repl repl)) 'start-repl) - #:debug (make-debug stack 0 msg #t)))))) + #:debug (make-debug stack 0 msg)))))) (define-stack-command (finish repl) "finish @@ -746,7 +738,7 @@ Resume execution, breaking when the current frame finishes." (k (frame->stack-vector frame))))))) (format #t "~a~%" msg) ((module-ref (resolve-interface '(system repl repl)) 'start-repl) - #:debug (make-debug stack 0 msg #t))))) + #:debug (make-debug stack 0 msg))))) (define-stack-command (step repl) "step diff --git a/module/system/repl/debug.scm b/module/system/repl/debug.scm index cf408063e..0b4a90485 100644 --- a/module/system/repl/debug.scm +++ b/module/system/repl/debug.scm @@ -1,6 +1,6 @@ ;;; Guile VM debugging facilities -;;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc. +;;; Copyright (C) 2001, 2009, 2010, 2011, 2013 Free Software Foundation, Inc. ;;; ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -31,7 +31,7 @@ #:use-module (system vm program) #:export ( make-debug debug? - debug-frames debug-index debug-error-message debug-for-trap? + debug-frames debug-index debug-error-message terminal-width print-registers print-locals print-frame print-frames frame->module stack->vector narrow-stack->vector @@ -55,7 +55,7 @@ ;;; accessors, and provides some helper functions. ;;; -(define-record frames index error-message for-trap?) +(define-record frames index error-message) @@ -125,7 +125,7 @@ (if source (or (source:file source) "current input") "unknown file")) - (let* ((source ((if next-source? frame-next-source frame-source) frame)) + (let* ((source (frame-source frame)) (file (source:pretty-file source)) (line (and=> source source:line-for-user)) (col (and=> source source:column))) @@ -141,7 +141,7 @@ (define* (print-frames frames #:optional (port (current-output-port)) #:key (width (terminal-width)) (full? #f) - (forward? #f) count for-trap?) + (forward? #f) count) (let* ((len (vector-length frames)) (lower-idx (if (or (not count) (positive? count)) 0 @@ -155,12 +155,9 @@ (if (<= lower-idx i upper-idx) (let* ((frame (vector-ref frames i))) (print-frame frame port #:index i #:width width #:full? full? - #:last-source last-source - #:next-source? (and (zero? i) for-trap?)) + #:last-source last-source) (lp (+ i inc) - (if (and (zero? i) for-trap?) - (frame-next-source frame) - (frame-source frame)))))))) + (frame-source frame))))))) ;; Ideally here we would have something much more syntactic, in that a set! to a ;; local var that is not settable would raise an error, and export etc forms diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm index 0e31eb941..d0d7967a3 100644 --- a/module/system/repl/error-handling.scm +++ b/module/system/repl/error-handling.scm @@ -1,6 +1,6 @@ ;;; Error handling in the REPL -;; Copyright (C) 2001, 2009, 2010, 2011, 2012 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc. ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -72,7 +72,7 @@ (error-msg (if trap-idx (format #f "Trap ~d: ~a" trap-idx trap-name) trap-name)) - (debug (make-debug stack 0 error-msg #t))) + (debug (make-debug stack 0 error-msg))) (with-saved-ports (lambda () (if trap-idx @@ -138,7 +138,7 @@ ;; the start-stack thunk has its own frame too. 0 (and tag 1))) (error-msg (error-string stack key args)) - (debug (make-debug stack 0 error-msg #f))) + (debug (make-debug stack 0 error-msg))) (with-saved-ports (lambda () (format #t "~a~%" error-msg) diff --git a/module/system/vm/frame.scm b/module/system/vm/frame.scm index ea2faafd7..8aba837d1 100644 --- a/module/system/vm/frame.scm +++ b/module/system/vm/frame.scm @@ -26,7 +26,7 @@ #:export (frame-bindings frame-lookup-binding frame-binding-ref frame-binding-set! - frame-next-source frame-call-representation + frame-call-representation frame-environment frame-object-binding frame-object-name)) @@ -71,15 +71,6 @@ ;;; Pretty printing ;;; -(define (frame-next-source frame) - (let ((proc (frame-procedure frame))) - (if (or (program? proc) (rtl-program? proc)) - (program-source proc - (frame-instruction-pointer frame) - (program-sources-pre-retire proc)) - '()))) - - ;; Basically there are two cases to deal with here: ;; ;; 1. We've already parsed the arguments, and bound them to local diff --git a/module/system/vm/trap-state.scm b/module/system/vm/trap-state.scm index 82d4e0ef4..e334c018c 100644 --- a/module/system/vm/trap-state.scm +++ b/module/system/vm/trap-state.scm @@ -1,6 +1,6 @@ ;;; trap-state.scm: a set of traps -;; Copyright (C) 2010 Free Software Foundation, Inc. +;; Copyright (C) 2010, 2013 Free Software Foundation, Inc. ;;; This library is free software; you can redistribute it and/or ;;; modify it under the terms of the GNU Lesser General Public @@ -275,13 +275,13 @@ (and (<= (frame-address f) fp) (predicate f)))))) - (let* ((source (frame-next-source frame)) + (let* ((source (frame-source frame)) (idx (next-ephemeral-index! trap-state)) (trap (trap-matching-instructions (wrap-predicate-according-to-into (if instruction? (lambda (f) #t) - (lambda (f) (not (equal? (frame-next-source f) source))))) + (lambda (f) (not (equal? (frame-source f) source))))) (ephemeral-handler-for-index trap-state idx handler)))) (add-trap-wrapper! trap-state