mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 20:00:19 +02:00
Program sources are always pre-retire now
* module/system/repl/debug.scm (<debug>): Remove for-trap?. Backtraces with RTL will always happen pre-retire on the top frame, source info is pre-retire, and continuations will always have a source-marked receive or receive-values or whatever with the right source marking, so we can remove this complication. (print-frame): Use frame-source. (print-frames): Remove for-trap? kw. * module/system/repl/command.scm (define-stack-command, backtrace) (up, down, frame): Remove for-trap? introduced local, and its uses. (repl-pop-continuation-resumer): Adapt to make-debug change. * module/system/repl/error-handling.scm (call-with-error-handling): Adapt to make-debug change. * module/system/vm/frame.scm (frame-next-source): Remove. RTL sources are pre-retire. * module/system/vm/trap-state.scm (add-ephemeral-stepping-trap!): Adapt to use frame-source. Still some work to do here.
This commit is contained in:
Andy Wingo
parent
0128bb9c38
commit
e15aa02284
5 changed files with 23 additions and 43 deletions
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 (<debug>
|
||||
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 <debug> frames index error-message for-trap?)
|
||||
(define-record <debug> 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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue