summaryrefslogtreecommitdiff
path: root/module/ice-9/debugging/ice-9-debugger-extensions.scm
blob: 5d7bfc8b5d6910b742a6a4e59375490d2a3cc835 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
(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)