From ba5f8bf4b1ff19871222d832a446c5e54da64b93 Mon Sep 17 00:00:00 2001 From: Neil Jerram Date: Thu, 27 Aug 2009 22:21:20 +0100 Subject: Incorporate ice-9-debugger-extensions properly i.e. put the extensions where they need to be, and delete ice-9-debugger-extensions.scm. * doc/ref/api-debug.texi (Single Stepping through a Procedure's Code): Change mentions of (ice-9 debugging ice-9-debugger-extensions) module to whatever is appropriate now (or just remove them). * module/Makefile.am (NOCOMP_SOURCES): Remove ice-9-debugger-extensions.scm. * module/ice-9/debugger.scm (debug-trap): Move here from ice-9-debugger-extensions.scm. * module/ice-9/debugger/command-loop.scm ("continue", "finish", "step", "next"): Move here from ice-9-debugger-extensions.scm. * module/ice-9/debugger/commands.scm (assert-continuable, continue, finish, step, next): Move here from ice-9-debugger-extensions.scm. * module/ice-9/debugging/breakpoints.scm: Don't use ice-9-debugger-extensions module. * module/ice-9/debugging/ice-9-debugger-extensions.scm: Removed. * module/ice-9/debugging/trace.scm, module/ice-9/debugging/traps.scm: Remove more old version code. * module/ice-9/debugging/traps.scm (guile-trap-features): Hardcoded as '(tweaking). --- doc/ref/api-debug.texi | 10 +- module/Makefile.am | 1 - module/ice-9/debugger.scm | 19 +++ module/ice-9/debugger/command-loop.scm | 11 ++ module/ice-9/debugger/commands.scm | 55 +++++++- module/ice-9/debugging/breakpoints.scm | 1 - .../ice-9/debugging/ice-9-debugger-extensions.scm | 138 --------------------- module/ice-9/debugging/trace.scm | 5 +- module/ice-9/debugging/traps.scm | 35 +----- 9 files changed, 91 insertions(+), 184 deletions(-) diff --git a/doc/ref/api-debug.texi b/doc/ref/api-debug.texi index 42e0676a6..c29bfdf12 100644 --- a/doc/ref/api-debug.texi +++ b/doc/ref/api-debug.texi @@ -1708,7 +1708,7 @@ facilities just described. A good way to explore in detail what a Scheme procedure does is to set a trap on it and then single step through what it does. To do this, make and install a @code{} with the @code{debug-trap} -behaviour from @code{(ice-9 debugging ice-9-debugger-extensions)}. +behaviour from @code{(ice-9 debugger)}. The following sample session illustrates this. It assumes that the file @file{matrix.scm} defines a procedure @code{mkmatrix}, which is @@ -1718,7 +1718,6 @@ calls @code{mkmatrix}. @lisp $ /usr/bin/guile -q guile> (use-modules (ice-9 debugger) - (ice-9 debugging ice-9-debugger-extensions) (ice-9 debugging traps)) guile> (load "matrix.scm") guile> (install-trap (make @@ -1758,10 +1757,9 @@ guile> Or you can use Guile's Emacs interface (GDS), by using the module @code{(ice-9 gds-client)} instead of @code{(ice-9 debugger)} and -@code{(ice-9 debugging ice-9-debugger-extensions)}, and changing -@code{debug-trap} to @code{gds-debug-trap}. Then the stack and -corresponding source locations are displayed in Emacs instead of on -the Guile command line. +changing @code{debug-trap} to @code{gds-debug-trap}. Then the stack and +corresponding source locations are displayed in Emacs instead of on the +Guile command line. @node Profiling or Tracing a Procedure's Code diff --git a/module/Makefile.am b/module/Makefile.am index d1c2d95ce..668b8a597 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -269,7 +269,6 @@ NOCOMP_SOURCES = \ ice-9/debugger/trc.scm \ ice-9/debugger/utils.scm \ ice-9/debugging/example-fns.scm \ - ice-9/debugging/ice-9-debugger-extensions.scm \ ice-9/debugging/steps.scm \ ice-9/debugging/trace.scm \ ice-9/debugging/traps.scm \ diff --git a/module/ice-9/debugger.scm b/module/ice-9/debugger.scm index 06f7ed230..d6fe2990c 100644 --- a/module/ice-9/debugger.scm +++ b/module/ice-9/debugger.scm @@ -20,6 +20,7 @@ #:use-module (ice-9 debugger command-loop) #:use-module (ice-9 debugger state) #:use-module (ice-9 debugger utils) + #:use-module (ice-9 debugging traps) #:use-module (ice-9 format) #:export (debug-stack debug @@ -143,4 +144,22 @@ Indicates that the debugger should display an introductory message. (apply default-pre-unwind-handler key args)) default-pre-unwind-handler))) +;;; Also provide a `debug-trap' entry point. This maps from a +;;; trap-context to a debug-stack call. + +(define-public (debug-trap trap-context) + "Invoke the Guile debugger to explore the stack at the specified @var{trap-context}." + (let* ((stack (tc:stack trap-context)) + (flags1 (let ((trap-type (tc:type trap-context))) + (case trap-type + ((#:return #:error) + (list trap-type + (tc:return-value trap-context))) + (else + (list trap-type))))) + (flags (if (tc:continuation trap-context) + (cons #:continuable flags1) + flags1))) + (apply debug-stack stack flags))) + ;;; (ice-9 debugger) ends here. diff --git a/module/ice-9/debugger/command-loop.scm b/module/ice-9/debugger/command-loop.scm index c6628271c..18ea00314 100644 --- a/module/ice-9/debugger/command-loop.scm +++ b/module/ice-9/debugger/command-loop.scm @@ -18,6 +18,9 @@ (define-module (ice-9 debugger command-loop) #:use-module ((ice-9 debugger commands) :prefix debugger:) + #:use-module (ice-9 debugger) + #:use-module (ice-9 debugger state) + #:use-module (ice-9 debugging traps) #:export (debugger-command-loop debugger-command-loop-error debugger-command-loop-quit) @@ -540,3 +543,11 @@ (define-command-alias "where" "backtrace") (define-command-alias "p" "evaluate") (define-command-alias '("info" "stack") "backtrace") + +(define-command "continue" '() debugger:continue) + +(define-command "finish" '() debugger:finish) + +(define-command "step" '('optional exact-integer) debugger:step) + +(define-command "next" '('optional exact-integer) debugger:next) diff --git a/module/ice-9/debugger/commands.scm b/module/ice-9/debugger/commands.scm index c254ce9e2..00cab87f6 100644 --- a/module/ice-9/debugger/commands.scm +++ b/module/ice-9/debugger/commands.scm @@ -21,6 +21,7 @@ #:use-module (ice-9 debugger) #:use-module (ice-9 debugger state) #:use-module (ice-9 debugger utils) + #:use-module (ice-9 debugging steps) #:export (backtrace evaluate info-args @@ -28,7 +29,11 @@ position up down - frame)) + frame + continue + finish + step + next)) (define (backtrace state n-frames) "Print backtrace of all stack frames, or innermost COUNT frames. @@ -151,4 +156,52 @@ An argument specifies the frame to select; it must be a stack-frame number." (if n (set-stack-index! state (frame-number->index n (state-stack state)))) (write-state-short state)) +(define (assert-continuable state) + ;; Check that debugger is in a state where `continuing' makes sense. + ;; If not, signal an error. + (or (memq #:continuable (state-flags state)) + (user-error "This debug session is not continuable."))) + +(define (continue state) + "Tell the program being debugged to continue running. (In fact this is +the same as the @code{quit} command, because it exits the debugger +command loop and so allows whatever code it was that invoked the +debugger to continue.)" + (assert-continuable state) + (throw 'exit-debugger)) + +(define (finish state) + "Continue until evaluation of the current frame is complete, and +print the result obtained." + (assert-continuable state) + (at-exit (- (stack-length (state-stack state)) + (state-index state)) + (list trace-trap debug-trap)) + (continue state)) + +(define (step state n) + "Tell the debugged program to do @var{n} more steps from its current +position. One @dfn{step} means executing until the next frame entry +or exit of any kind. @var{n} defaults to 1." + (assert-continuable state) + (at-step debug-trap (or n 1)) + (continue state)) + +(define (next state n) + "Tell the debugged program to do @var{n} more steps from its current +position, but only counting frame entries and exits where the +corresponding source code comes from the same file as the current +stack frame. (See @ref{Step Traps} for the details of how this +works.) If the current stack frame has no source code, the effect of +this command is the same as of @code{step}. @var{n} defaults to 1." + (assert-continuable state) + (at-step debug-trap + (or n 1) + (frame-file-name (stack-ref (state-stack state) + (state-index state))) + (if (memq #:return (state-flags state)) + #f + (- (stack-length (state-stack state)) (state-index state)))) + (continue state)) + ;;; (ice-9 debugger commands) ends here. diff --git a/module/ice-9/debugging/breakpoints.scm b/module/ice-9/debugging/breakpoints.scm index c839409ef..0690699a7 100644 --- a/module/ice-9/debugging/breakpoints.scm +++ b/module/ice-9/debugging/breakpoints.scm @@ -25,7 +25,6 @@ #:use-module (ice-9 optargs) #:use-module (ice-9 regex) #:use-module (oop goops) - #:use-module (ice-9 debugging ice-9-debugger-extensions) #:use-module (ice-9 debugging traps) #:use-module (ice-9 debugging trc) #:use-module (srfi srfi-1) diff --git a/module/ice-9/debugging/ice-9-debugger-extensions.scm b/module/ice-9/debugging/ice-9-debugger-extensions.scm index 5d7bfc8b5..e69de29bb 100644 --- a/module/ice-9/debugging/ice-9-debugger-extensions.scm +++ b/module/ice-9/debugging/ice-9-debugger-extensions.scm @@ -1,138 +0,0 @@ - -(define-module (ice-9 debugging ice-9-debugger-extensions) - #:use-module (ice-9 debugger)) - -;;; Upgrade the debugger state object so that it can carry a flag -;;; indicating whether the debugging session is continuable. - -(use-modules (ice-9 debugger state)) -(define-module (ice-9 debugger state)) - -(set! state-rtd (make-record-type "debugger-state" '(stack index flags))) -(set! state? (record-predicate state-rtd)) -(set! make-state - (let ((make-state-internal (record-constructor state-rtd - '(stack index flags)))) - (lambda (stack index . flags) - (make-state-internal stack index flags)))) -(set! state-stack (record-accessor state-rtd 'stack)) -(set! state-index (record-accessor state-rtd 'index)) - -(define state-flags (record-accessor state-rtd 'flags)) - -;;; Add commands that (ice-9 debugger) doesn't currently have, for -;;; continuing or single stepping program execution. - -(use-modules (ice-9 debugger command-loop)) -(define-module (ice-9 debugger command-loop) - #:use-module (ice-9 debugger) - #:use-module (ice-9 debugger state) - #:use-module (ice-9 debugging traps)) -(define new-define-command define-command) -(set! define-command - (lambda (name argument-template documentation procedure) - (new-define-command name argument-template procedure))) - -(use-modules (ice-9 debugging steps)) - -(define (assert-continuable state) - ;; Check that debugger is in a state where `continuing' makes sense. - ;; If not, signal an error. - (or (memq #:continuable (state-flags state)) - (user-error "This debug session is not continuable."))) - -(define (debugger:continue state) - "Tell the program being debugged to continue running. (In fact this is -the same as the @code{quit} command, because it exits the debugger -command loop and so allows whatever code it was that invoked the -debugger to continue.)" - (assert-continuable state) - (throw 'exit-debugger)) - -(define (debugger:finish state) - "Continue until evaluation of the current frame is complete, and -print the result obtained." - (assert-continuable state) - (at-exit (- (stack-length (state-stack state)) - (state-index state)) - (list trace-trap debug-trap)) - (debugger:continue state)) - -(define (debugger:step state n) - "Tell the debugged program to do @var{n} more steps from its current -position. One @dfn{step} means executing until the next frame entry -or exit of any kind. @var{n} defaults to 1." - (assert-continuable state) - (at-step debug-trap (or n 1)) - (debugger:continue state)) - -(define (debugger:next state n) - "Tell the debugged program to do @var{n} more steps from its current -position, but only counting frame entries and exits where the -corresponding source code comes from the same file as the current -stack frame. (See @ref{Step Traps} for the details of how this -works.) If the current stack frame has no source code, the effect of -this command is the same as of @code{step}. @var{n} defaults to 1." - (assert-continuable state) - (at-step debug-trap - (or n 1) - (frame-file-name (stack-ref (state-stack state) - (state-index state))) - (if (memq #:return (state-flags state)) - #f - (- (stack-length (state-stack state)) (state-index state)))) - (debugger:continue state)) - -(define-command "continue" '() - "Continue program execution." - debugger:continue) - -(define-command "finish" '() - "Continue until evaluation of the current frame is complete, and -print the result obtained." - debugger:finish) - -(define-command "step" '('optional exact-integer) - "Continue until entry to @var{n}th next frame." - debugger:step) - -(define-command "next" '('optional exact-integer) - "Continue until entry to @var{n}th next frame in same file." - debugger:next) - -;;; Provide a `debug-trap' entry point in (ice-9 debugger). This is -;;; designed so that it can be called to explore the stack at a -;;; breakpoint, and to single step from the breakpoint. - -(define-module (ice-9 debugger)) - -(use-modules (ice-9 debugging traps)) - -(define *not-yet-introduced* #t) - -(define-public (debug-trap trap-context) - "Invoke the Guile debugger to explore the stack at the specified @var{trap}." - (start-stack 'debugger - (let* ((stack (tc:stack trap-context)) - (flags1 (let ((trap-type (tc:type trap-context))) - (case trap-type - ((#:return #:error) - (list trap-type - (tc:return-value trap-context))) - (else - (list trap-type))))) - (flags (if (tc:continuation trap-context) - (cons #:continuable flags1) - flags1)) - (state (apply make-state stack 0 flags))) - (if *not-yet-introduced* - (let ((ssize (stack-length stack))) - (display "This is the Guile debugger -- for help, type `help'.\n") - (set! *not-yet-introduced* #f) - (if (= ssize 1) - (display "There is 1 frame on the stack.\n\n") - (format #t "There are ~A frames on the stack.\n\n" ssize)))) - (write-state-short-with-source-location state) - (debugger-command-loop state)))) - -(define write-state-short-with-source-location write-state-short) diff --git a/module/ice-9/debugging/trace.scm b/module/ice-9/debugging/trace.scm index 55b1f3965..76160e177 100644 --- a/module/ice-9/debugging/trace.scm +++ b/module/ice-9/debugging/trace.scm @@ -19,7 +19,7 @@ (define-module (ice-9 debugging trace) #:use-module (ice-9 debug) #:use-module (ice-9 debugger) - #:use-module (ice-9 debugging ice-9-debugger-extensions) + #:use-module (ice-9 debugger utils) #:use-module (ice-9 debugging steps) #:use-module (ice-9 debugging traps) #:export (trace-trap @@ -40,9 +40,6 @@ trace-at-exit trace-until-exit)) -(cond ((string>=? (version) "1.7") - (use-modules (ice-9 debugger utils)))) - (define trace-format-string #f) (define trace-arg-procs #f) diff --git a/module/ice-9/debugging/traps.scm b/module/ice-9/debugging/traps.scm index e13011e99..292456d43 100755 --- a/module/ice-9/debugging/traps.scm +++ b/module/ice-9/debugging/traps.scm @@ -25,6 +25,7 @@ (define-module (ice-9 debugging traps) #:use-module (ice-9 regex) + #:use-module (ice-9 weak-vector) #:use-module (oop goops) #:use-module (oop goops describe) #:use-module (ice-9 debugging trc) @@ -86,11 +87,6 @@ ;; "(trc " to find other symbols that can be passed to trc-add. ;; (trc-add 'after-gc-hook) -;; In Guile 1.7 onwards, weak-vector and friends are provided by the -;; (ice-9 weak-vector) module. -(cond ((string>=? (version) "1.7") - (use-modules (ice-9 weak-vector)))) - ;;; The current low level traps interface is as follows. ;;; ;;; All trap handlers are subject to SCM_TRAPS_P, which is controlled @@ -1002,34 +998,7 @@ it twice." (trap-disable 'traps) (thunk)))) -(define guile-trap-features - ;; Helper procedure, to test whether a specific possible Guile - ;; feature is supported. - (let ((supported? - (lambda (test-feature) - (case test-feature - ((tweaking) - ;; Tweaking is supported if the description of the cheap - ;; traps option includes the word "obsolete", or if the - ;; option isn't there any more. - (and (string>=? (version) "1.7") - (let ((cheap-opt-desc - (assq 'cheap (debug-options-interface 'help)))) - (or (not cheap-opt-desc) - (string-match "obsolete" (caddr cheap-opt-desc)))))) - (else - (error "Unexpected feature name:" test-feature)))))) - ;; Compile the list of actually supported features from all - ;; possible features. - (let loop ((possible-features '(tweaking)) - (actual-features '())) - (if (null? possible-features) - (reverse! actual-features) - (let ((test-feature (car possible-features))) - (loop (cdr possible-features) - (if (supported? test-feature) - (cons test-feature actual-features) - actual-features))))))) +(define guile-trap-features '(tweaking)) ;; Make sure that traps are enabled. (trap-enable 'traps) -- cgit v1.2.3