|
0
|
1 ;; Things to look at:
|
|
|
2 ; (gud-call "") in gud-send-input
|
|
|
3 ; (defvar gud-last-last-frame nil)
|
|
|
4 ; term-prompt-regexp
|
|
|
5
|
|
|
6 ;;; tgud.el --- Grand Unified Debugger mode for gdb, sdb, dbx, or xdb
|
|
|
7 ;;; under Emacs
|
|
|
8
|
|
|
9 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
|
|
|
10 ;; Maintainer: FSF
|
|
|
11 ;; Version: 1.3
|
|
|
12 ;; Keywords: unix, tools
|
|
|
13
|
|
|
14 ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
|
|
|
15
|
|
|
16 ;; This file is part of GNU Emacs.
|
|
|
17
|
|
|
18 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
|
19 ;; it under the terms of the GNU General Public License as published by
|
|
|
20 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
21 ;; any later version.
|
|
|
22
|
|
|
23 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
|
24 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
25 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
26 ;; GNU General Public License for more details.
|
|
|
27
|
|
|
28 ;; You should have received a copy of the GNU General Public License
|
|
|
29 ;; along with GNU Emacs; see the file COPYING. If not, write to
|
|
|
30 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
31
|
|
|
32 ;;; Commentary:
|
|
|
33
|
|
|
34 ;; The ancestral gdb.el was by W. Schelter <wfs@rascal.ics.utexas.edu>
|
|
|
35 ;; It was later rewritten by rms. Some ideas were due to Masanobu.
|
|
|
36 ;; Grand Unification (sdb/dbx support) by Eric S. Raymond <esr@thyrsus.com>
|
|
|
37 ;; The overloading code was then rewritten by Barry Warsaw <bwarsaw@cen.com>,
|
|
|
38 ;; who also hacked the mode to use comint.el. Shane Hartman <shane@spr.com>
|
|
|
39 ;; added support for xdb (HPUX debugger). Rick Sladkey <jrs@world.std.com>
|
|
|
40 ;; wrote the GDB command completion code. Dave Love <d.love@dl.ac.uk>
|
|
|
41 ;; added the IRIX kluge and re-implemented the Mips-ish variant.
|
|
|
42 ;; Then hacked by Per Bothner <bothner@cygnus.com> to use term.el.
|
|
|
43
|
|
|
44 ;;; Code:
|
|
|
45
|
|
|
46 (require 'term)
|
|
|
47 (require 'etags)
|
|
|
48
|
|
|
49 ;; ======================================================================
|
|
|
50 ;; TGUD commands must be visible in C buffers visited by TGUD
|
|
|
51
|
|
|
52 (defvar tgud-key-prefix "\C-x\C-a"
|
|
|
53 "Prefix of all TGUD commands valid in C buffers.")
|
|
|
54
|
|
|
55 (global-set-key (concat tgud-key-prefix "\C-l") 'tgud-refresh)
|
|
|
56 (define-key ctl-x-map " " 'tgud-break) ;; backward compatibility hack
|
|
|
57
|
|
|
58 ;; ======================================================================
|
|
|
59 ;; the overloading mechanism
|
|
|
60
|
|
|
61 (defun tgud-overload-functions (tgud-overload-alist)
|
|
|
62 "Overload functions defined in TGUD-OVERLOAD-ALIST.
|
|
|
63 This association list has elements of the form
|
|
|
64 (ORIGINAL-FUNCTION-NAME OVERLOAD-FUNCTION)"
|
|
|
65 (mapcar
|
|
|
66 (function (lambda (p) (fset (car p) (symbol-function (cdr p)))))
|
|
|
67 tgud-overload-alist))
|
|
|
68
|
|
|
69 (defun tgud-massage-args (file args)
|
|
|
70 (error "TGUD not properly entered"))
|
|
|
71
|
|
|
72 (defun tgud-marker-filter (str)
|
|
|
73 (error "TGUD not properly entered"))
|
|
|
74
|
|
|
75 (defun tgud-find-file (f)
|
|
|
76 (error "TGUD not properly entered"))
|
|
|
77
|
|
|
78 ;; ======================================================================
|
|
|
79 ;; command definition
|
|
|
80
|
|
|
81 ;; This macro is used below to define some basic debugger interface commands.
|
|
|
82 ;; Of course you may use `tgud-def' with any other debugger command, including
|
|
|
83 ;; user defined ones.
|
|
|
84
|
|
|
85 ;; A macro call like (tgud-def FUNC NAME KEY DOC) expands to a form
|
|
|
86 ;; which defines FUNC to send the command NAME to the debugger, gives
|
|
|
87 ;; it the docstring DOC, and binds that function to KEY in the TGUD
|
|
|
88 ;; major mode. The function is also bound in the global keymap with the
|
|
|
89 ;; TGUD prefix.
|
|
|
90
|
|
|
91 (defmacro tgud-def (func cmd key &optional doc)
|
|
|
92 "Define FUNC to be a command sending STR and bound to KEY, with
|
|
|
93 optional doc string DOC. Certain %-escapes in the string arguments
|
|
|
94 are interpreted specially if present. These are:
|
|
|
95
|
|
|
96 %f name (without directory) of current source file.
|
|
|
97 %d directory of current source file.
|
|
|
98 %l number of current source line
|
|
|
99 %e text of the C lvalue or function-call expression surrounding point.
|
|
|
100 %a text of the hexadecimal address surrounding point
|
|
|
101 %p prefix argument to the command (if any) as a number
|
|
|
102
|
|
|
103 The `current' source file is the file of the current buffer (if
|
|
|
104 we're in a C file) or the source file current at the last break or
|
|
|
105 step (if we're in the TGUD buffer).
|
|
|
106 The `current' line is that of the current buffer (if we're in a
|
|
|
107 source file) or the source line number at the last break or step (if
|
|
|
108 we're in the TGUD buffer)."
|
|
|
109 (list 'progn
|
|
|
110 (list 'defun func '(arg)
|
|
|
111 (or doc "")
|
|
|
112 '(interactive "p")
|
|
|
113 (list 'tgud-call cmd 'arg))
|
|
|
114 (if key
|
|
|
115 (list 'define-key
|
|
|
116 '(current-local-map)
|
|
|
117 (concat "\C-c" key)
|
|
|
118 (list 'quote func)))
|
|
|
119 (if key
|
|
|
120 (list 'global-set-key
|
|
|
121 (list 'concat 'tgud-key-prefix key)
|
|
|
122 (list 'quote func)))))
|
|
|
123
|
|
|
124 ;; Used by tgud-refresh, which should cause tgud-display-frame to redisplay
|
|
|
125 ;; the last frame, even if it's been called before and term-pending-frame has
|
|
|
126 ;; been set to nil.
|
|
|
127 (defvar tgud-last-last-frame nil)
|
|
|
128
|
|
|
129 ;; All debugger-specific information is collected here.
|
|
|
130 ;; Here's how it works, in case you ever need to add a debugger to the mode.
|
|
|
131 ;;
|
|
|
132 ;; Each entry must define the following at startup:
|
|
|
133 ;;
|
|
|
134 ;;<name>
|
|
|
135 ;; term-prompt-regexp
|
|
|
136 ;; tgud-<name>-massage-args
|
|
|
137 ;; tgud-<name>-marker-filter
|
|
|
138 ;; tgud-<name>-find-file
|
|
|
139 ;;
|
|
|
140 ;; The job of the massage-args method is to modify the given list of
|
|
|
141 ;; debugger arguments before running the debugger.
|
|
|
142 ;;
|
|
|
143 ;; The job of the marker-filter method is to detect file/line markers in
|
|
|
144 ;; strings and set the global term-pending-frame to indicate what display
|
|
|
145 ;; action (if any) should be triggered by the marker. Note that only
|
|
|
146 ;; whatever the method *returns* is displayed in the buffer; thus, you
|
|
|
147 ;; can filter the debugger's output, interpreting some and passing on
|
|
|
148 ;; the rest.
|
|
|
149 ;;
|
|
|
150 ;; The job of the find-file method is to visit and return the buffer indicated
|
|
|
151 ;; by the car of tgud-tag-frame. This may be a file name, a tag name, or
|
|
|
152 ;; something else.
|
|
|
153
|
|
|
154 ;; ======================================================================
|
|
|
155 ;; gdb functions
|
|
|
156
|
|
|
157 ;;; History of argument lists passed to gdb.
|
|
|
158 (defvar tgud-gdb-history nil)
|
|
|
159
|
|
|
160 (defun tgud-gdb-massage-args (file args)
|
|
|
161 (cons "-fullname" (cons file args)))
|
|
|
162
|
|
|
163 ;; Don't need to do anything, since term-mode does it for us.
|
|
|
164 ;; (This is so that you can run 'gdb -fullname' from a shell buffer.)
|
|
|
165 (defun tgud-gdb-marker-filter (string)
|
|
|
166 string)
|
|
|
167
|
|
|
168 (defun tgud-gdb-find-file (f)
|
|
|
169 (find-file-noselect f))
|
|
|
170
|
|
|
171 (defvar gdb-minibuffer-local-map nil
|
|
|
172 "Keymap for minibuffer prompting of gdb startup command.")
|
|
|
173 (if gdb-minibuffer-local-map
|
|
|
174 ()
|
|
|
175 (setq gdb-minibuffer-local-map (copy-keymap minibuffer-local-map))
|
|
|
176 (define-key
|
|
|
177 gdb-minibuffer-local-map "\C-i" 'term-dynamic-complete-filename))
|
|
|
178
|
|
|
179 ;;;###autoload
|
|
|
180 (defun tgdb (command-line)
|
|
|
181 "Run gdb on program FILE in buffer *tgud-FILE*.
|
|
|
182 The directory containing FILE becomes the initial working directory
|
|
|
183 and source-file directory for your debugger."
|
|
|
184 (interactive
|
|
|
185 (list (read-from-minibuffer "Run gdb (like this): "
|
|
|
186 (if (consp tgud-gdb-history)
|
|
|
187 (car tgud-gdb-history)
|
|
|
188 "gdb ")
|
|
|
189 gdb-minibuffer-local-map nil
|
|
|
190 '(tgud-gdb-history . 1))))
|
|
|
191 (tgud-overload-functions '((tgud-massage-args . tgud-gdb-massage-args)
|
|
|
192 (tgud-marker-filter . tgud-gdb-marker-filter)
|
|
|
193 (tgud-find-file . tgud-gdb-find-file)
|
|
|
194 ))
|
|
|
195
|
|
|
196 (tgud-common-init command-line)
|
|
|
197
|
|
|
198 (tgud-def tgud-break "break %f:%l" "\C-b" "Set breakpoint at current line.")
|
|
|
199 (tgud-def tgud-tbreak "tbreak %f:%l" "\C-t" "Set breakpoint at current line.")
|
|
|
200 (tgud-def tgud-remove "clear %l" "\C-d" "Remove breakpoint at current line")
|
|
|
201 (tgud-def tgud-step "step %p" "\C-s" "Step one source line with display.")
|
|
|
202 (tgud-def tgud-stepi "stepi %p" "\C-i" "Step one instruction with display.")
|
|
|
203 (tgud-def tgud-next "next %p" "\C-n" "Step one line (skip functions).")
|
|
|
204 (tgud-def tgud-cont "cont" "\C-r" "Continue with display.")
|
|
|
205 (tgud-def tgud-finish "finish" "\C-f" "Finish executing current function.")
|
|
|
206 (tgud-def tgud-up "up %p" "<" "Up N stack frames (numeric arg).")
|
|
|
207 (tgud-def tgud-down "down %p" ">" "Down N stack frames (numeric arg).")
|
|
|
208 (tgud-def tgud-print "print %e" "\C-p" "Evaluate C expression at point.")
|
|
|
209
|
|
|
210 (local-set-key "\C-i" 'tgud-gdb-complete-command)
|
|
|
211 (setq term-prompt-regexp "^(.*gdb[+]?) *")
|
|
|
212 (setq paragraph-start term-prompt-regexp)
|
|
|
213 (run-hooks 'gdb-mode-hook)
|
|
|
214 )
|
|
|
215
|
|
|
216 ;; One of the nice features of GDB is its impressive support for
|
|
|
217 ;; context-sensitive command completion. We preserve that feature
|
|
|
218 ;; in the TGUD buffer by using a GDB command designed just for Emacs.
|
|
|
219
|
|
|
220 ;; The completion process filter indicates when it is finished.
|
|
|
221 (defvar tgud-gdb-complete-in-progress)
|
|
|
222
|
|
|
223 ;; Since output may arrive in fragments we accumulate partials strings here.
|
|
|
224 (defvar tgud-gdb-complete-string)
|
|
|
225
|
|
|
226 ;; We need to know how much of the completion to chop off.
|
|
|
227 (defvar tgud-gdb-complete-break)
|
|
|
228
|
|
|
229 ;; The completion list is constructed by the process filter.
|
|
|
230 (defvar tgud-gdb-complete-list)
|
|
|
231
|
|
|
232 (defvar tgud-term-buffer nil)
|
|
|
233
|
|
|
234 (defun tgud-gdb-complete-command ()
|
|
|
235 "Perform completion on the GDB command preceding point.
|
|
|
236 This is implemented using the GDB `complete' command which isn't
|
|
|
237 available with older versions of GDB."
|
|
|
238 (interactive)
|
|
|
239 (let* ((end (point))
|
|
|
240 (command (save-excursion
|
|
|
241 (beginning-of-line)
|
|
|
242 (and (looking-at term-prompt-regexp)
|
|
|
243 (goto-char (match-end 0)))
|
|
|
244 (buffer-substring (point) end)))
|
|
|
245 command-word)
|
|
|
246 ;; Find the word break. This match will always succeed.
|
|
|
247 (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command)
|
|
|
248 (setq tgud-gdb-complete-break (match-beginning 2)
|
|
|
249 command-word (substring command tgud-gdb-complete-break))
|
|
|
250 (unwind-protect
|
|
|
251 (progn
|
|
|
252 ;; Temporarily install our filter function.
|
|
|
253 (tgud-overload-functions
|
|
|
254 '((tgud-marker-filter . tgud-gdb-complete-filter)))
|
|
|
255 ;; Issue the command to GDB.
|
|
|
256 (tgud-basic-call (concat "complete " command))
|
|
|
257 (setq tgud-gdb-complete-in-progress t
|
|
|
258 tgud-gdb-complete-string nil
|
|
|
259 tgud-gdb-complete-list nil)
|
|
|
260 ;; Slurp the output.
|
|
|
261 (while tgud-gdb-complete-in-progress
|
|
|
262 (accept-process-output (get-buffer-process tgud-term-buffer))))
|
|
|
263 ;; Restore the old filter function.
|
|
|
264 (tgud-overload-functions '((tgud-marker-filter . tgud-gdb-marker-filter))))
|
|
|
265 ;; Protect against old versions of GDB.
|
|
|
266 (and tgud-gdb-complete-list
|
|
|
267 (string-match "^Undefined command: \"complete\""
|
|
|
268 (car tgud-gdb-complete-list))
|
|
|
269 (error "This version of GDB doesn't support the `complete' command."))
|
|
|
270 ;; Sort the list like readline.
|
|
|
271 (setq tgud-gdb-complete-list
|
|
|
272 (sort tgud-gdb-complete-list (function string-lessp)))
|
|
|
273 ;; Remove duplicates.
|
|
|
274 (let ((first tgud-gdb-complete-list)
|
|
|
275 (second (cdr tgud-gdb-complete-list)))
|
|
|
276 (while second
|
|
|
277 (if (string-equal (car first) (car second))
|
|
|
278 (setcdr first (setq second (cdr second)))
|
|
|
279 (setq first second
|
|
|
280 second (cdr second)))))
|
|
|
281 ;; Let term handle the rest.
|
|
|
282 (term-dynamic-simple-complete command-word tgud-gdb-complete-list)))
|
|
|
283
|
|
|
284 ;; The completion process filter is installed temporarily to slurp the
|
|
|
285 ;; output of GDB up to the next prompt and build the completion list.
|
|
|
286 (defun tgud-gdb-complete-filter (string)
|
|
|
287 (setq string (concat tgud-gdb-complete-string string))
|
|
4
|
288 (while (string-match "\r?\n" string)
|
|
0
|
289 (setq tgud-gdb-complete-list
|
|
|
290 (cons (substring string tgud-gdb-complete-break (match-beginning 0))
|
|
|
291 tgud-gdb-complete-list))
|
|
|
292 (setq string (substring string (match-end 0))))
|
|
|
293 (if (string-match term-prompt-regexp string)
|
|
|
294 (progn
|
|
|
295 (setq tgud-gdb-complete-in-progress nil)
|
|
|
296 string)
|
|
|
297 (progn
|
|
|
298 (setq tgud-gdb-complete-string string)
|
|
|
299 "")))
|
|
|
300
|
|
|
301
|
|
|
302 ;; ======================================================================
|
|
|
303 ;; sdb functions
|
|
|
304
|
|
|
305 ;;; History of argument lists passed to sdb.
|
|
|
306 (defvar tgud-sdb-history nil)
|
|
|
307
|
|
|
308 (defvar tgud-sdb-needs-tags (not (file-exists-p "/var"))
|
|
|
309 "If nil, we're on a System V Release 4 and don't need the tags hack.")
|
|
|
310
|
|
|
311 (defvar tgud-sdb-lastfile nil)
|
|
|
312
|
|
|
313 (defun tgud-sdb-massage-args (file args)
|
|
|
314 (cons file args))
|
|
|
315
|
|
|
316 (defun tgud-sdb-marker-filter (string)
|
|
|
317 (cond
|
|
|
318 ;; System V Release 3.2 uses this format
|
|
|
319 ((string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n"
|
|
|
320 string)
|
|
|
321 (setq term-pending-frame
|
|
|
322 (cons
|
|
|
323 (substring string (match-beginning 2) (match-end 2))
|
|
|
324 (string-to-int
|
|
|
325 (substring string (match-beginning 3) (match-end 3))))))
|
|
|
326 ;; System V Release 4.0
|
|
|
327 ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n"
|
|
|
328 string)
|
|
|
329 (setq tgud-sdb-lastfile
|
|
|
330 (substring string (match-beginning 2) (match-end 2))))
|
|
|
331 ((and tgud-sdb-lastfile (string-match "^\\([0-9]+\\):" string))
|
|
|
332 (setq term-pending-frame
|
|
|
333 (cons
|
|
|
334 tgud-sdb-lastfile
|
|
|
335 (string-to-int
|
|
|
336 (substring string (match-beginning 1) (match-end 1))))))
|
|
|
337 (t
|
|
|
338 (setq tgud-sdb-lastfile nil)))
|
|
|
339 string)
|
|
|
340
|
|
|
341 (defun tgud-sdb-find-file (f)
|
|
|
342 (if tgud-sdb-needs-tags
|
|
|
343 (find-tag-noselect f)
|
|
|
344 (find-file-noselect f)))
|
|
|
345
|
|
|
346 ;;;###autoload
|
|
|
347 (defun tsdb (command-line)
|
|
|
348 "Run sdb on program FILE in buffer *tgud-FILE*.
|
|
|
349 The directory containing FILE becomes the initial working directory
|
|
|
350 and source-file directory for your debugger."
|
|
|
351 (interactive
|
|
|
352 (list (read-from-minibuffer "Run sdb (like this): "
|
|
|
353 (if (consp tgud-sdb-history)
|
|
|
354 (car tgud-sdb-history)
|
|
|
355 "sdb ")
|
|
|
356 nil nil
|
|
|
357 '(tgud-sdb-history . 1))))
|
|
|
358 (if (and tgud-sdb-needs-tags
|
|
|
359 (not (and (boundp 'tags-file-name)
|
|
|
360 (stringp tags-file-name)
|
|
|
361 (file-exists-p tags-file-name))))
|
|
|
362 (error "The sdb support requires a valid tags table to work."))
|
|
|
363 (tgud-overload-functions '((tgud-massage-args . tgud-sdb-massage-args)
|
|
|
364 (tgud-marker-filter . tgud-sdb-marker-filter)
|
|
|
365 (tgud-find-file . tgud-sdb-find-file)
|
|
|
366 ))
|
|
|
367
|
|
|
368 (tgud-common-init command-line)
|
|
|
369
|
|
|
370 (tgud-def tgud-break "%l b" "\C-b" "Set breakpoint at current line.")
|
|
|
371 (tgud-def tgud-tbreak "%l c" "\C-t" "Set temporary breakpoint at current line.")
|
|
|
372 (tgud-def tgud-remove "%l d" "\C-d" "Remove breakpoint at current line")
|
|
|
373 (tgud-def tgud-step "s %p" "\C-s" "Step one source line with display.")
|
|
|
374 (tgud-def tgud-stepi "i %p" "\C-i" "Step one instruction with display.")
|
|
|
375 (tgud-def tgud-next "S %p" "\C-n" "Step one line (skip functions).")
|
|
|
376 (tgud-def tgud-cont "c" "\C-r" "Continue with display.")
|
|
|
377 (tgud-def tgud-print "%e/" "\C-p" "Evaluate C expression at point.")
|
|
|
378
|
|
|
379 (setq term-prompt-regexp "\\(^\\|\n\\)\\*")
|
|
|
380 (setq paragraph-start term-prompt-regexp)
|
|
|
381 (run-hooks 'sdb-mode-hook)
|
|
|
382 )
|
|
|
383
|
|
|
384 ;; ======================================================================
|
|
|
385 ;; dbx functions
|
|
|
386
|
|
|
387 ;;; History of argument lists passed to dbx.
|
|
|
388 (defvar tgud-dbx-history nil)
|
|
|
389
|
|
|
390 (defun tgud-dbx-massage-args (file args)
|
|
|
391 (cons file args))
|
|
|
392
|
|
|
393 (defun tgud-dbx-marker-filter (string)
|
|
|
394 (if (or (string-match
|
|
|
395 "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\""
|
|
|
396 string)
|
|
|
397 (string-match
|
|
|
398 "signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\""
|
|
|
399 string))
|
|
|
400 (setq term-pending-frame
|
|
|
401 (cons
|
|
|
402 (substring string (match-beginning 2) (match-end 2))
|
|
|
403 (string-to-int
|
|
|
404 (substring string (match-beginning 1) (match-end 1))))))
|
|
|
405 string)
|
|
|
406
|
|
|
407 ;; Functions for Mips-style dbx. Given the option `-emacs', documented in
|
|
|
408 ;; OSF1, not necessarily elsewhere, it produces markers similar to gdb's.
|
|
|
409 (defvar tgud-mips-p
|
|
|
410 (or (string-match "^mips-[^-]*-ultrix" system-configuration)
|
|
|
411 ;; We haven't tested tgud on this system:
|
|
|
412 (string-match "^mips-[^-]*-riscos" system-configuration)
|
|
|
413 ;; It's documented on OSF/1.3
|
|
|
414 (string-match "^mips-[^-]*-osf1" system-configuration)
|
|
|
415 (string-match "^alpha-[^-]*-osf" system-configuration))
|
|
|
416 "Non-nil to assume the MIPS/OSF dbx conventions (argument `-emacs').")
|
|
|
417
|
|
|
418 (defun tgud-mipsdbx-massage-args (file args)
|
|
|
419 (cons "-emacs" (cons file args)))
|
|
|
420
|
|
|
421 ;; This is just like the gdb one except for the regexps since we need to cope
|
|
|
422 ;; with an optional breakpoint number in [] before the ^Z^Z
|
|
|
423 (defun tgud-mipsdbx-marker-filter (string)
|
|
|
424 (save-match-data
|
|
|
425 (setq tgud-marker-acc (concat tgud-marker-acc string))
|
|
|
426 (let ((output ""))
|
|
|
427
|
|
|
428 ;; Process all the complete markers in this chunk.
|
|
|
429 (while (string-match
|
|
|
430 ;; This is like th gdb marker but with an optional
|
|
|
431 ;; leading break point number like `[1] '
|
|
|
432 "[][ 0-9]*\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n"
|
|
|
433 tgud-marker-acc)
|
|
|
434 (setq
|
|
|
435
|
|
|
436 ;; Extract the frame position from the marker.
|
|
|
437 term-pending-frame
|
|
|
438 (cons (substring tgud-marker-acc (match-beginning 1) (match-end 1))
|
|
|
439 (string-to-int (substring tgud-marker-acc
|
|
|
440 (match-beginning 2)
|
|
|
441 (match-end 2))))
|
|
|
442
|
|
|
443 ;; Append any text before the marker to the output we're going
|
|
|
444 ;; to return - we don't include the marker in this text.
|
|
|
445 output (concat output
|
|
|
446 (substring tgud-marker-acc 0 (match-beginning 0)))
|
|
|
447
|
|
|
448 ;; Set the accumulator to the remaining text.
|
|
|
449 tgud-marker-acc (substring tgud-marker-acc (match-end 0))))
|
|
|
450
|
|
|
451 ;; Does the remaining text look like it might end with the
|
|
|
452 ;; beginning of another marker? If it does, then keep it in
|
|
|
453 ;; tgud-marker-acc until we receive the rest of it. Since we
|
|
|
454 ;; know the full marker regexp above failed, it's pretty simple to
|
|
|
455 ;; test for marker starts.
|
|
|
456 (if (string-match "[][ 0-9]*\032.*\\'" tgud-marker-acc)
|
|
|
457 (progn
|
|
|
458 ;; Everything before the potential marker start can be output.
|
|
|
459 (setq output (concat output (substring tgud-marker-acc
|
|
|
460 0 (match-beginning 0))))
|
|
|
461
|
|
|
462 ;; Everything after, we save, to combine with later input.
|
|
|
463 (setq tgud-marker-acc
|
|
|
464 (substring tgud-marker-acc (match-beginning 0))))
|
|
|
465
|
|
|
466 (setq output (concat output tgud-marker-acc)
|
|
|
467 tgud-marker-acc ""))
|
|
|
468
|
|
|
469 output)))
|
|
|
470
|
|
|
471 ;; The dbx in IRIX is a pain. It doesn't print the file name when
|
|
|
472 ;; stopping at a breakpoint (but you do get it from the `up' and
|
|
|
473 ;; `down' commands...). The only way to extract the information seems
|
|
|
474 ;; to be with a `file' command, although the current line number is
|
|
|
475 ;; available in $curline. Thus we have to look for output which
|
|
|
476 ;; appears to indicate a breakpoint. Then we prod the dbx sub-process
|
|
|
477 ;; to output the information we want with a combination of the
|
|
|
478 ;; `printf' and `file' commands as a pseudo marker which we can
|
|
|
479 ;; recognise next time through the marker-filter. This would be like
|
|
|
480 ;; the gdb marker but you can't get the file name without a newline...
|
|
|
481 ;; Note that tgud-remove won't work since Irix dbx expects a breakpoint
|
|
|
482 ;; number rather than a line number etc. Maybe this could be made to
|
|
|
483 ;; work by listing all the breakpoints and picking the one(s) with the
|
|
|
484 ;; correct line number, but life's too short.
|
|
|
485 ;; d.love@dl.ac.uk (Dave Love) can be blamed for this
|
|
|
486
|
|
|
487 (defvar tgud-irix-p (string-match "^mips-[^-]*-irix" system-configuration)
|
|
|
488 "Non-nil to assume the interface appropriate for IRIX dbx.
|
|
|
489 This works in IRIX 4 and probably IRIX 5.")
|
|
|
490 ;; (It's been tested in IRIX 4 and the output from dbx on IRIX 5 looks
|
|
|
491 ;; the same.)
|
|
|
492
|
|
|
493 ;; this filter is influenced by the xdb one rather than the gdb one
|
|
|
494
|
|
|
495 (defun tgud-irixdbx-marker-filter (string)
|
|
|
496 (save-match-data
|
|
|
497 (let (result (case-fold-search nil))
|
|
|
498 (if (or (string-match term-prompt-regexp string)
|
|
|
499 (string-match ".*\012" string))
|
|
|
500 (setq result (concat tgud-marker-acc string)
|
|
|
501 tgud-marker-acc "")
|
|
|
502 (setq tgud-marker-acc (concat tgud-marker-acc string)))
|
|
|
503 (if result
|
|
|
504 (cond
|
|
|
505 ;; look for breakpoint or signal indication e.g.:
|
|
|
506 ;; [2] Process 1267 (pplot) stopped at [params:338 ,0x400ec0]
|
|
|
507 ;; Process 1281 (pplot) stopped at [params:339 ,0x400ec8]
|
|
|
508 ;; Process 1270 (pplot) Floating point exception [._read._read:16 ,0x452188]
|
|
|
509 ((string-match
|
|
|
510 "^\\(\\[[0-9]+] \\)?Process +[0-9]+ ([^)]*) [^[]+\\[[^]\n]*]\n"
|
|
|
511 result)
|
|
|
512 ;; prod dbx into printing out the line number and file
|
|
|
513 ;; name in a form we can grok as below
|
|
|
514 (process-send-string (get-buffer-process tgud-term-buffer)
|
|
|
515 "printf \"\032\032%1d:\",$curline;file\n"))
|
|
|
516 ;; look for result of, say, "up" e.g.:
|
|
|
517 ;; .pplot.pplot(0x800) ["src/pplot.f":261, 0x400c7c]
|
|
|
518 ;; (this will also catch one of the lines printed by "where")
|
|
|
519 ((string-match
|
|
|
520 "^[^ ][^[]*\\[\"\\([^\"]+\\)\":\\([0-9]+\\), [^]]+]\n"
|
|
|
521 result)
|
|
|
522 (let ((file (substring result (match-beginning 1)
|
|
|
523 (match-end 1))))
|
|
|
524 (if (file-exists-p file)
|
|
|
525 (setq term-pending-frame
|
|
|
526 (cons
|
|
|
527 (substring
|
|
|
528 result (match-beginning 1) (match-end 1))
|
|
|
529 (string-to-int
|
|
|
530 (substring
|
|
|
531 result (match-beginning 2) (match-end 2)))))))
|
|
|
532 result)
|
|
|
533 ((string-match ; kluged-up marker as above
|
|
|
534 "\032\032\\([0-9]*\\):\\(.*\\)\n" result)
|
|
|
535 (let ((file (substring result (match-beginning 2) (match-end 2))))
|
|
|
536 (if (file-exists-p file)
|
|
|
537 (setq term-pending-frame
|
|
|
538 (cons
|
|
|
539 file
|
|
|
540 (string-to-int
|
|
|
541 (substring
|
|
|
542 result (match-beginning 1) (match-end 1)))))))
|
|
|
543 (setq result (substring result 0 (match-beginning 0))))))
|
|
|
544 (or result ""))))
|
|
|
545
|
|
|
546 (defun tgud-dbx-find-file (f)
|
|
|
547 (find-file-noselect f))
|
|
|
548
|
|
|
549 ;;;###autoload
|
|
|
550 (defun tdbx (command-line)
|
|
|
551 "Run dbx on program FILE in buffer *tgud-FILE*.
|
|
|
552 The directory containing FILE becomes the initial working directory
|
|
|
553 and source-file directory for your debugger."
|
|
|
554 (interactive
|
|
|
555 (list (read-from-minibuffer "Run dbx (like this): "
|
|
|
556 (if (consp tgud-dbx-history)
|
|
|
557 (car tgud-dbx-history)
|
|
|
558 "dbx ")
|
|
|
559 nil nil
|
|
|
560 '(tgud-dbx-history . 1))))
|
|
|
561
|
|
|
562 (tgud-overload-functions
|
|
|
563 (cond
|
|
|
564 (tgud-mips-p
|
|
|
565 '((tgud-massage-args . tgud-mipsdbx-massage-args)
|
|
|
566 (tgud-marker-filter . tgud-mipsdbx-marker-filter)
|
|
|
567 (tgud-find-file . tgud-dbx-find-file)))
|
|
|
568 (tgud-irix-p
|
|
|
569 '((tgud-massage-args . tgud-dbx-massage-args)
|
|
|
570 (tgud-marker-filter . tgud-irixdbx-marker-filter)
|
|
|
571 (tgud-find-file . tgud-dbx-find-file)))
|
|
|
572 (t
|
|
|
573 '((tgud-massage-args . tgud-dbx-massage-args)
|
|
|
574 (tgud-marker-filter . tgud-dbx-marker-filter)
|
|
|
575 (tgud-find-file . tgud-dbx-find-file)))))
|
|
|
576
|
|
|
577 (tgud-common-init command-line)
|
|
|
578
|
|
|
579 (cond
|
|
|
580 (tgud-mips-p
|
|
|
581 (tgud-def tgud-break "stop at \"%f\":%l"
|
|
|
582 "\C-b" "Set breakpoint at current line.")
|
|
|
583 (tgud-def tgud-finish "return" "\C-f" "Finish executing current function."))
|
|
|
584 (tgud-irix-p
|
|
|
585 (tgud-def tgud-break "stop at \"%d%f\":%l"
|
|
|
586 "\C-b" "Set breakpoint at current line.")
|
|
|
587 (tgud-def tgud-finish "return" "\C-f" "Finish executing current function.")
|
|
|
588 ;; Make dbx give out the source location info that we need.
|
|
|
589 (process-send-string (get-buffer-process tgud-term-buffer)
|
|
|
590 "printf \"\032\032%1d:\",$curline;file\n"))
|
|
|
591 (t
|
|
|
592 (tgud-def tgud-break "file \"%d%f\"\nstop at %l"
|
|
|
593 "\C-b" "Set breakpoint at current line.")))
|
|
|
594
|
|
|
595 (tgud-def tgud-remove "clear %l" "\C-d" "Remove breakpoint at current line")
|
|
|
596 (tgud-def tgud-step "step %p" "\C-s" "Step one line with display.")
|
|
|
597 (tgud-def tgud-stepi "stepi %p" "\C-i" "Step one instruction with display.")
|
|
|
598 (tgud-def tgud-next "next %p" "\C-n" "Step one line (skip functions).")
|
|
|
599 (tgud-def tgud-cont "cont" "\C-r" "Continue with display.")
|
|
|
600 (tgud-def tgud-up "up %p" "<" "Up (numeric arg) stack frames.")
|
|
|
601 (tgud-def tgud-down "down %p" ">" "Down (numeric arg) stack frames.")
|
|
|
602 (tgud-def tgud-print "print %e" "\C-p" "Evaluate C expression at point.")
|
|
|
603
|
|
|
604 (setq term-prompt-regexp "^[^)\n]*dbx) *")
|
|
|
605 (setq paragraph-start term-prompt-regexp)
|
|
|
606 (run-hooks 'dbx-mode-hook)
|
|
|
607 )
|
|
|
608
|
|
|
609 ;;---ok
|
|
|
610 ;; ======================================================================
|
|
|
611 ;; xdb (HP PARISC debugger) functions
|
|
|
612
|
|
|
613 ;;; History of argument lists passed to xdb.
|
|
|
614 (defvar tgud-xdb-history nil)
|
|
|
615
|
|
|
616 (defvar tgud-xdb-directories nil
|
|
|
617 "*A list of directories that xdb should search for source code.
|
|
|
618 If nil, only source files in the program directory
|
|
|
619 will be known to xdb.
|
|
|
620
|
|
|
621 The file names should be absolute, or relative to the directory
|
|
|
622 containing the executable being debugged.")
|
|
|
623
|
|
|
624 (defun tgud-xdb-massage-args (file args)
|
|
|
625 (nconc (let ((directories tgud-xdb-directories)
|
|
|
626 (result nil))
|
|
|
627 (while directories
|
|
|
628 (setq result (cons (car directories) (cons "-d" result)))
|
|
|
629 (setq directories (cdr directories)))
|
|
|
630 (nreverse (cons file result)))
|
|
|
631 args))
|
|
|
632
|
|
|
633 (defun tgud-xdb-file-name (f)
|
|
|
634 "Transform a relative pathname to a full pathname in xdb mode"
|
|
|
635 (let ((result nil))
|
|
|
636 (if (file-exists-p f)
|
|
|
637 (setq result (expand-file-name f))
|
|
|
638 (let ((directories tgud-xdb-directories))
|
|
|
639 (while directories
|
|
|
640 (let ((path (concat (car directories) "/" f)))
|
|
|
641 (if (file-exists-p path)
|
|
|
642 (setq result (expand-file-name path)
|
|
|
643 directories nil)))
|
|
|
644 (setq directories (cdr directories)))))
|
|
|
645 result))
|
|
|
646
|
|
|
647 ;; xdb does not print the lines all at once, so we have to accumulate them
|
|
|
648 (defun tgud-xdb-marker-filter (string)
|
|
|
649 (let (result)
|
|
|
650 (if (or (string-match term-prompt-regexp string)
|
|
|
651 (string-match ".*\012" string))
|
|
|
652 (setq result (concat tgud-marker-acc string)
|
|
|
653 tgud-marker-acc "")
|
|
|
654 (setq tgud-marker-acc (concat tgud-marker-acc string)))
|
|
|
655 (if result
|
|
|
656 (if (or (string-match "\\([^\n \t:]+\\): [^:]+: \\([0-9]+\\):" result)
|
|
|
657 (string-match "[^: \t]+:[ \t]+\\([^:]+\\): [^:]+: \\([0-9]+\\):"
|
|
|
658 result))
|
|
|
659 (let ((line (string-to-int
|
|
|
660 (substring result (match-beginning 2) (match-end 2))))
|
|
|
661 (file (tgud-xdb-file-name
|
|
|
662 (substring result (match-beginning 1) (match-end 1)))))
|
|
|
663 (if file
|
|
|
664 (setq term-pending-frame (cons file line))))))
|
|
|
665 (or result "")))
|
|
|
666
|
|
|
667 (defun tgud-xdb-find-file (f)
|
|
|
668 (let ((realf (tgud-xdb-file-name f)))
|
|
|
669 (if realf (find-file-noselect realf))))
|
|
|
670
|
|
|
671 ;;;###autoload
|
|
|
672 (defun txdb (command-line)
|
|
|
673 "Run xdb on program FILE in buffer *tgud-FILE*.
|
|
|
674 The directory containing FILE becomes the initial working directory
|
|
|
675 and source-file directory for your debugger.
|
|
|
676
|
|
|
677 You can set the variable 'tgud-xdb-directories' to a list of program source
|
|
|
678 directories if your program contains sources from more than one directory."
|
|
|
679 (interactive
|
|
|
680 (list (read-from-minibuffer "Run xdb (like this): "
|
|
|
681 (if (consp tgud-xdb-history)
|
|
|
682 (car tgud-xdb-history)
|
|
|
683 "xdb ")
|
|
|
684 nil nil
|
|
|
685 '(tgud-xdb-history . 1))))
|
|
|
686 (tgud-overload-functions '((tgud-massage-args . tgud-xdb-massage-args)
|
|
|
687 (tgud-marker-filter . tgud-xdb-marker-filter)
|
|
|
688 (tgud-find-file . tgud-xdb-find-file)))
|
|
|
689
|
|
|
690 (tgud-common-init command-line)
|
|
|
691
|
|
|
692 (tgud-def tgud-break "b %f:%l" "\C-b" "Set breakpoint at current line.")
|
|
|
693 (tgud-def tgud-tbreak "b %f:%l\\t" "\C-t"
|
|
|
694 "Set temporary breakpoint at current line.")
|
|
|
695 (tgud-def tgud-remove "db" "\C-d" "Remove breakpoint at current line")
|
|
|
696 (tgud-def tgud-step "s %p" "\C-s" "Step one line with display.")
|
|
|
697 (tgud-def tgud-next "S %p" "\C-n" "Step one line (skip functions).")
|
|
|
698 (tgud-def tgud-cont "c" "\C-r" "Continue with display.")
|
|
|
699 (tgud-def tgud-up "up %p" "<" "Up (numeric arg) stack frames.")
|
|
|
700 (tgud-def tgud-down "down %p" ">" "Down (numeric arg) stack frames.")
|
|
|
701 (tgud-def tgud-finish "bu\\t" "\C-f" "Finish executing current function.")
|
|
|
702 (tgud-def tgud-print "p %e" "\C-p" "Evaluate C expression at point.")
|
|
|
703
|
|
|
704 (setq term-prompt-regexp "^>")
|
|
|
705 (setq paragraph-start term-prompt-regexp)
|
|
|
706 (run-hooks 'xdb-mode-hook))
|
|
|
707
|
|
|
708 ;; ======================================================================
|
|
|
709 ;; perldb functions
|
|
|
710
|
|
|
711 ;;; History of argument lists passed to perldb.
|
|
|
712 (defvar tgud-perldb-history nil)
|
|
|
713
|
|
|
714 (defun tgud-perldb-massage-args (file args)
|
|
|
715 (cons "-d" (cons file (cons "-emacs" args))))
|
|
|
716
|
|
|
717 ;; There's no guarantee that Emacs will hand the filter the entire
|
|
|
718 ;; marker at once; it could be broken up across several strings. We
|
|
|
719 ;; might even receive a big chunk with several markers in it. If we
|
|
|
720 ;; receive a chunk of text which looks like it might contain the
|
|
|
721 ;; beginning of a marker, we save it here between calls to the
|
|
|
722 ;; filter.
|
|
|
723 (defvar tgud-perldb-marker-acc "")
|
|
|
724
|
|
|
725 (defun tgud-perldb-marker-filter (string)
|
|
|
726 (save-match-data
|
|
|
727 (setq tgud-marker-acc (concat tgud-marker-acc string))
|
|
|
728 (let ((output ""))
|
|
|
729
|
|
|
730 ;; Process all the complete markers in this chunk.
|
|
|
731 (while (string-match "\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n"
|
|
|
732 tgud-marker-acc)
|
|
|
733 (setq
|
|
|
734
|
|
|
735 ;; Extract the frame position from the marker.
|
|
|
736 term-pending-frame
|
|
|
737 (cons (substring tgud-marker-acc (match-beginning 1) (match-end 1))
|
|
|
738 (string-to-int (substring tgud-marker-acc
|
|
|
739 (match-beginning 2)
|
|
|
740 (match-end 2))))
|
|
|
741
|
|
|
742 ;; Append any text before the marker to the output we're going
|
|
|
743 ;; to return - we don't include the marker in this text.
|
|
|
744 output (concat output
|
|
|
745 (substring tgud-marker-acc 0 (match-beginning 0)))
|
|
|
746
|
|
|
747 ;; Set the accumulator to the remaining text.
|
|
|
748 tgud-marker-acc (substring tgud-marker-acc (match-end 0))))
|
|
|
749
|
|
|
750 ;; Does the remaining text look like it might end with the
|
|
|
751 ;; beginning of another marker? If it does, then keep it in
|
|
|
752 ;; tgud-marker-acc until we receive the rest of it. Since we
|
|
|
753 ;; know the full marker regexp above failed, it's pretty simple to
|
|
|
754 ;; test for marker starts.
|
|
|
755 (if (string-match "\032.*\\'" tgud-marker-acc)
|
|
|
756 (progn
|
|
|
757 ;; Everything before the potential marker start can be output.
|
|
|
758 (setq output (concat output (substring tgud-marker-acc
|
|
|
759 0 (match-beginning 0))))
|
|
|
760
|
|
|
761 ;; Everything after, we save, to combine with later input.
|
|
|
762 (setq tgud-marker-acc
|
|
|
763 (substring tgud-marker-acc (match-beginning 0))))
|
|
|
764
|
|
|
765 (setq output (concat output tgud-marker-acc)
|
|
|
766 tgud-marker-acc ""))
|
|
|
767
|
|
|
768 output)))
|
|
|
769
|
|
|
770 (defun tgud-perldb-find-file (f)
|
|
|
771 (find-file-noselect f))
|
|
|
772
|
|
|
773 ;;;###autoload
|
|
|
774 (defun tperldb (command-line)
|
|
|
775 "Run perldb on program FILE in buffer *tgud-FILE*.
|
|
|
776 The directory containing FILE becomes the initial working directory
|
|
|
777 and source-file directory for your debugger."
|
|
|
778 (interactive
|
|
|
779 (list (read-from-minibuffer "Run perldb (like this): "
|
|
|
780 (if (consp tgud-perldb-history)
|
|
|
781 (car tgud-perldb-history)
|
|
|
782 "perl ")
|
|
|
783 nil nil
|
|
|
784 '(tgud-perldb-history . 1))))
|
|
|
785 (tgud-overload-functions '((tgud-massage-args . tgud-perldb-massage-args)
|
|
|
786 (tgud-marker-filter . tgud-perldb-marker-filter)
|
|
|
787 (tgud-find-file . tgud-perldb-find-file)
|
|
|
788 ))
|
|
|
789
|
|
|
790 (tgud-common-init command-line)
|
|
|
791
|
|
|
792 (tgud-def tgud-break "b %l" "\C-b" "Set breakpoint at current line.")
|
|
|
793 (tgud-def tgud-remove "d %l" "\C-d" "Remove breakpoint at current line")
|
|
|
794 (tgud-def tgud-step "s" "\C-s" "Step one source line with display.")
|
|
|
795 (tgud-def tgud-next "n" "\C-n" "Step one line (skip functions).")
|
|
|
796 (tgud-def tgud-cont "c" "\C-r" "Continue with display.")
|
|
|
797 ; (tgud-def tgud-finish "finish" "\C-f" "Finish executing current function.")
|
|
|
798 ; (tgud-def tgud-up "up %p" "<" "Up N stack frames (numeric arg).")
|
|
|
799 ; (tgud-def tgud-down "down %p" ">" "Down N stack frames (numeric arg).")
|
|
|
800 (tgud-def tgud-print "%e" "\C-p" "Evaluate perl expression at point.")
|
|
|
801
|
|
|
802 (setq term-prompt-regexp "^ DB<[0-9]+> ")
|
|
|
803 (setq paragraph-start term-prompt-regexp)
|
|
|
804 (run-hooks 'perldb-mode-hook)
|
|
|
805 )
|
|
|
806
|
|
|
807 ;;
|
|
|
808 ;; End of debugger-specific information
|
|
|
809 ;;
|
|
|
810
|
|
|
811
|
|
|
812 ;;; When we send a command to the debugger via tgud-call, it's annoying
|
|
|
813 ;;; to see the command and the new prompt inserted into the debugger's
|
|
|
814 ;;; buffer; we have other ways of knowing the command has completed.
|
|
|
815 ;;;
|
|
|
816 ;;; If the buffer looks like this:
|
|
|
817 ;;; --------------------
|
|
|
818 ;;; (gdb) set args foo bar
|
|
|
819 ;;; (gdb) -!-
|
|
|
820 ;;; --------------------
|
|
|
821 ;;; (the -!- marks the location of point), and we type `C-x SPC' in a
|
|
|
822 ;;; source file to set a breakpoint, we want the buffer to end up like
|
|
|
823 ;;; this:
|
|
|
824 ;;; --------------------
|
|
|
825 ;;; (gdb) set args foo bar
|
|
|
826 ;;; Breakpoint 1 at 0x92: file make-docfile.c, line 49.
|
|
|
827 ;;; (gdb) -!-
|
|
|
828 ;;; --------------------
|
|
|
829 ;;; Essentially, the old prompt is deleted, and the command's output
|
|
|
830 ;;; and the new prompt take its place.
|
|
|
831 ;;;
|
|
|
832 ;;; Not echoing the command is easy enough; you send it directly using
|
|
|
833 ;;; process-send-string, and it never enters the buffer. However,
|
|
|
834 ;;; getting rid of the old prompt is trickier; you don't want to do it
|
|
|
835 ;;; when you send the command, since that will result in an annoying
|
|
|
836 ;;; flicker as the prompt is deleted, redisplay occurs while Emacs
|
|
|
837 ;;; waits for a response from the debugger, and the new prompt is
|
|
|
838 ;;; inserted. Instead, we'll wait until we actually get some output
|
|
|
839 ;;; from the subprocess before we delete the prompt. If the command
|
|
|
840 ;;; produced no output other than a new prompt, that prompt will most
|
|
|
841 ;;; likely be in the first chunk of output received, so we will delete
|
|
|
842 ;;; the prompt and then replace it with an identical one. If the
|
|
|
843 ;;; command produces output, the prompt is moving anyway, so the
|
|
|
844 ;;; flicker won't be annoying.
|
|
|
845 ;;;
|
|
|
846 ;;; So - when we want to delete the prompt upon receipt of the next
|
|
|
847 ;;; chunk of debugger output, we position term-pending-delete-marker at
|
|
|
848 ;;; the start of the prompt; the process filter will notice this, and
|
|
|
849 ;;; delete all text between it and the process output marker. If
|
|
|
850 ;;; term-pending-delete-marker points nowhere, we leave the current
|
|
|
851 ;;; prompt alone.
|
|
|
852 (defvar term-pending-delete-marker nil)
|
|
|
853
|
|
|
854
|
|
|
855 (defun tgud-mode ()
|
|
|
856 "Major mode for interacting with an inferior debugger process.
|
|
|
857
|
|
|
858 You start it up with one of the commands M-x gdb, M-x sdb, M-x dbx,
|
|
|
859 or M-x xdb. Each entry point finishes by executing a hook; `gdb-mode-hook',
|
|
|
860 `sdb-mode-hook', `dbx-mode-hook' or `xdb-mode-hook' respectively.
|
|
|
861
|
|
|
862 After startup, the following commands are available in both the TGUD
|
|
|
863 interaction buffer and any source buffer TGUD visits due to a breakpoint stop
|
|
|
864 or step operation:
|
|
|
865
|
|
|
866 \\[tgud-break] sets a breakpoint at the current file and line. In the
|
|
|
867 TGUD buffer, the current file and line are those of the last breakpoint or
|
|
|
868 step. In a source buffer, they are the buffer's file and current line.
|
|
|
869
|
|
|
870 \\[tgud-remove] removes breakpoints on the current file and line.
|
|
|
871
|
|
|
872 \\[tgud-refresh] displays in the source window the last line referred to
|
|
|
873 in the tgud buffer.
|
|
|
874
|
|
|
875 \\[tgud-step], \\[tgud-next], and \\[tgud-stepi] do a step-one-line,
|
|
|
876 step-one-line (not entering function calls), and step-one-instruction
|
|
|
877 and then update the source window with the current file and position.
|
|
|
878 \\[tgud-cont] continues execution.
|
|
|
879
|
|
|
880 \\[tgud-print] tries to find the largest C lvalue or function-call expression
|
|
|
881 around point, and sends it to the debugger for value display.
|
|
|
882
|
|
|
883 The above commands are common to all supported debuggers except xdb which
|
|
|
884 does not support stepping instructions.
|
|
|
885
|
|
|
886 Under gdb, sdb and xdb, \\[tgud-tbreak] behaves exactly like \\[tgud-break],
|
|
|
887 except that the breakpoint is temporary; that is, it is removed when
|
|
|
888 execution stops on it.
|
|
|
889
|
|
|
890 Under gdb, dbx, and xdb, \\[tgud-up] pops up through an enclosing stack
|
|
|
891 frame. \\[tgud-down] drops back down through one.
|
|
|
892
|
|
|
893 If you are using gdb or xdb, \\[tgud-finish] runs execution to the return from
|
|
|
894 the current function and stops.
|
|
|
895
|
|
|
896 All the keystrokes above are accessible in the TGUD buffer
|
|
|
897 with the prefix C-c, and in all buffers through the prefix C-x C-a.
|
|
|
898
|
|
|
899 All pre-defined functions for which the concept make sense repeat
|
|
|
900 themselves the appropriate number of times if you give a prefix
|
|
|
901 argument.
|
|
|
902
|
|
|
903 You may use the `tgud-def' macro in the initialization hook to define other
|
|
|
904 commands.
|
|
|
905
|
|
|
906 Other commands for interacting with the debugger process are inherited from
|
|
|
907 term mode, which see."
|
|
|
908 (interactive)
|
|
|
909 (term-mode)
|
|
|
910 (setq major-mode 'tgud-mode)
|
|
|
911 (setq mode-name "Debugger")
|
|
|
912 (setq mode-line-process '(":%s"))
|
|
|
913 (use-local-map (copy-keymap term-mode-map))
|
|
|
914 (define-key (current-local-map) "\C-m" 'tgud-send-input)
|
|
|
915 (define-key (current-local-map) "\C-c\C-l" 'tgud-refresh)
|
|
|
916 (make-local-variable 'term-prompt-regexp)
|
|
|
917 (make-local-variable 'paragraph-start)
|
|
|
918 (run-hooks 'tgud-mode-hook)
|
|
|
919 )
|
|
|
920
|
|
|
921 (defun tgud-send-input ()
|
|
|
922 (interactive)
|
|
|
923 (let ((proc (get-buffer-process (current-buffer))))
|
|
|
924 (if (not proc) (error "Current buffer has no process")
|
|
|
925 ;; If input line is empty, use tgud-call to get prompt deleted.
|
|
|
926 (if (and (= (point) (process-mark proc)) (= (point) (point-max)))
|
|
|
927 (tgud-call "")
|
|
|
928 (term-send-input)))))
|
|
|
929
|
|
|
930 ;; Chop STRING into words separated by SPC or TAB and return a list of them.
|
|
|
931 (defun tgud-chop-words (string)
|
|
|
932 (let ((i 0) (beg 0)
|
|
|
933 (len (length string))
|
|
|
934 (words nil))
|
|
|
935 (while (< i len)
|
|
|
936 (if (memq (aref string i) '(?\t ? ))
|
|
|
937 (progn
|
|
|
938 (setq words (cons (substring string beg i) words)
|
|
|
939 beg (1+ i))
|
|
|
940 (while (and (< beg len) (memq (aref string beg) '(?\t ? )))
|
|
|
941 (setq beg (1+ beg)))
|
|
|
942 (setq i (1+ beg)))
|
|
|
943 (setq i (1+ i))))
|
|
|
944 (if (< beg len)
|
|
|
945 (setq words (cons (substring string beg) words)))
|
|
|
946 (nreverse words)))
|
|
|
947
|
|
|
948 ;; Perform initializations common to all debuggers.
|
|
|
949 (defun tgud-common-init (command-line)
|
|
|
950 (let* ((words (tgud-chop-words command-line))
|
|
|
951 (program (car words))
|
|
|
952 (file-word (let ((w (cdr words)))
|
|
|
953 (while (and w (= ?- (aref (car w) 0)))
|
|
|
954 (setq w (cdr w)))
|
|
|
955 (car w)))
|
|
|
956 (args (delq file-word (cdr words)))
|
|
|
957 (file (and file-word
|
|
|
958 (expand-file-name (substitute-in-file-name file-word))))
|
|
|
959 (filepart (and file-word (file-name-nondirectory file))))
|
|
|
960 (switch-to-buffer (concat "*tgud-" filepart "*"))
|
|
|
961 (and file-word (setq default-directory (file-name-directory file)))
|
|
|
962 (or (bolp) (newline))
|
|
|
963 (insert "Current directory is " default-directory "\n")
|
|
|
964 (apply 'make-term (concat "tgud-" filepart) program nil
|
|
|
965 (if file-word (tgud-massage-args file args))))
|
|
|
966 (tgud-mode)
|
|
|
967 ;; Note the insertion about of the line giving the "Current directory"
|
|
|
968 ;; is not known about by the terminal emulator, so clear the
|
|
|
969 ;; current-row cache to avoid confusion.
|
|
|
970 (setq term-current-row nil)
|
|
|
971 (set-process-filter (get-buffer-process (current-buffer)) 'tgud-filter)
|
|
|
972 (set-process-sentinel (get-buffer-process (current-buffer)) 'tgud-sentinel)
|
|
|
973 (tgud-set-buffer)
|
|
|
974 )
|
|
|
975
|
|
|
976 (defun tgud-set-buffer ()
|
|
|
977 (cond ((eq major-mode 'tgud-mode)
|
|
|
978 (setq tgud-term-buffer (current-buffer)))))
|
|
|
979
|
|
|
980 ;; These functions are responsible for inserting output from your debugger
|
|
|
981 ;; into the buffer. The hard work is done by the method that is
|
|
|
982 ;; the value of tgud-marker-filter.
|
|
|
983
|
|
|
984 (defun tgud-filter (proc string)
|
|
|
985 ;; Here's where the actual buffer insertion is done
|
|
|
986 (set-buffer (process-buffer proc))
|
|
|
987 (let ((inhibit-quit t)) ;; ???
|
|
|
988 (term-emulate-terminal proc (tgud-marker-filter string))))
|
|
|
989
|
|
|
990 (defun tgud-sentinel (proc msg)
|
|
|
991 (cond ((null (buffer-name (process-buffer proc)))
|
|
|
992 ;; buffer killed
|
|
|
993 ;; Stop displaying an arrow in a source file.
|
|
|
994 (setq overlay-arrow-position nil)
|
|
|
995 (set-process-buffer proc nil))
|
|
|
996 ((memq (process-status proc) '(signal exit))
|
|
|
997 ;; Stop displaying an arrow in a source file.
|
|
|
998 (setq overlay-arrow-position nil)
|
|
|
999 ;; Fix the mode line.
|
|
|
1000 (setq mode-line-process
|
|
|
1001 (concat ":"
|
|
|
1002 (symbol-name (process-status proc))))
|
|
|
1003 (let* ((obuf (current-buffer)))
|
|
|
1004 ;; save-excursion isn't the right thing if
|
|
|
1005 ;; process-buffer is current-buffer
|
|
|
1006 (unwind-protect
|
|
|
1007 (progn
|
|
|
1008 ;; Write something in *compilation* and hack its mode line,
|
|
|
1009 (set-buffer (process-buffer proc))
|
|
|
1010 ;; Force mode line redisplay soon
|
|
|
1011 (set-buffer-modified-p (buffer-modified-p))
|
|
|
1012 (if (eobp)
|
|
|
1013 (insert ?\n mode-name " " msg)
|
|
|
1014 (save-excursion
|
|
|
1015 (goto-char (point-max))
|
|
|
1016 (insert ?\n mode-name " " msg)))
|
|
|
1017 ;; If buffer and mode line will show that the process
|
|
|
1018 ;; is dead, we can delete it now. Otherwise it
|
|
|
1019 ;; will stay around until M-x list-processes.
|
|
|
1020 (delete-process proc))
|
|
|
1021 ;; Restore old buffer, but don't restore old point
|
|
|
1022 ;; if obuf is the tgud buffer.
|
|
|
1023 (set-buffer obuf))))))
|
|
|
1024
|
|
|
1025 (defun tgud-display-frame ()
|
|
|
1026 "Find and obey the last filename-and-line marker from the debugger.
|
|
|
1027 Obeying it means displaying in another window the specified file and line."
|
|
|
1028 (interactive)
|
|
|
1029 (if term-pending-frame
|
|
|
1030 (progn
|
|
|
1031 (tgud-set-buffer)
|
|
|
1032 (term-display-buffer-line (tgud-visit-file (car term-pending-frame))
|
|
|
1033 (cdr term-pending-frame))
|
|
|
1034 (setq term-pending-frame nil))))
|
|
|
1035
|
|
|
1036 ;;; The tgud-call function must do the right thing whether its invoking
|
|
|
1037 ;;; keystroke is from the TGUD buffer itself (via major-mode binding)
|
|
|
1038 ;;; or a C buffer. In the former case, we want to supply data from
|
|
|
1039 ;;; term-pending-frame. Here's how we do it:
|
|
|
1040
|
|
|
1041 (defun tgud-format-command (str arg)
|
|
|
1042 (let ((insource (not (eq (current-buffer) tgud-term-buffer)))
|
|
|
1043 (frame (or term-pending-frame tgud-last-last-frame))
|
|
|
1044 result)
|
|
|
1045 (while (and str (string-match "\\([^%]*\\)%\\([adeflp]\\)" str))
|
|
|
1046 (let ((key (string-to-char (substring str (match-beginning 2))))
|
|
|
1047 subst)
|
|
|
1048 (cond
|
|
|
1049 ((eq key ?f)
|
|
|
1050 (setq subst (file-name-nondirectory (if insource
|
|
|
1051 (buffer-file-name)
|
|
|
1052 (car frame)))))
|
|
|
1053 ((eq key ?d)
|
|
|
1054 (setq subst (file-name-directory (if insource
|
|
|
1055 (buffer-file-name)
|
|
|
1056 (car frame)))))
|
|
|
1057 ((eq key ?l)
|
|
|
1058 (setq subst (if insource
|
|
|
1059 (save-excursion
|
|
|
1060 (beginning-of-line)
|
|
|
1061 (save-restriction (widen)
|
|
|
1062 (1+ (count-lines 1 (point)))))
|
|
|
1063 (cdr frame))))
|
|
|
1064 ((eq key ?e)
|
|
|
1065 (setq subst (find-c-expr)))
|
|
|
1066 ((eq key ?a)
|
|
|
1067 (setq subst (tgud-read-address)))
|
|
|
1068 ((eq key ?p)
|
|
|
1069 (setq subst (if arg (int-to-string arg) ""))))
|
|
|
1070 (setq result (concat result
|
|
|
1071 (substring str (match-beginning 1) (match-end 1))
|
|
|
1072 subst)))
|
|
|
1073 (setq str (substring str (match-end 2))))
|
|
|
1074 ;; There might be text left in STR when the loop ends.
|
|
|
1075 (concat result str)))
|
|
|
1076
|
|
|
1077 (defun tgud-read-address ()
|
|
|
1078 "Return a string containing the core-address found in the buffer at point."
|
|
|
1079 (save-excursion
|
|
|
1080 (let ((pt (point)) found begin)
|
|
|
1081 (setq found (if (search-backward "0x" (- pt 7) t) (point)))
|
|
|
1082 (cond
|
|
|
1083 (found (forward-char 2)
|
|
|
1084 (buffer-substring found
|
|
|
1085 (progn (re-search-forward "[^0-9a-f]")
|
|
|
1086 (forward-char -1)
|
|
|
1087 (point))))
|
|
|
1088 (t (setq begin (progn (re-search-backward "[^0-9]")
|
|
|
1089 (forward-char 1)
|
|
|
1090 (point)))
|
|
|
1091 (forward-char 1)
|
|
|
1092 (re-search-forward "[^0-9]")
|
|
|
1093 (forward-char -1)
|
|
|
1094 (buffer-substring begin (point)))))))
|
|
|
1095
|
|
|
1096 (defun tgud-call (fmt &optional arg)
|
|
|
1097 (let ((msg (tgud-format-command fmt arg)))
|
|
|
1098 (message "Command: %s" msg)
|
|
|
1099 (sit-for 0)
|
|
|
1100 (tgud-basic-call msg)))
|
|
|
1101
|
|
|
1102 (defun tgud-basic-call (command)
|
|
|
1103 "Invoke the debugger COMMAND displaying source in other window."
|
|
|
1104 (interactive)
|
|
|
1105 (tgud-set-buffer)
|
|
|
1106 (let ((proc (get-buffer-process tgud-term-buffer)))
|
|
|
1107
|
|
|
1108 ;; Arrange for the current prompt to get deleted.
|
|
|
1109 (save-excursion
|
|
|
1110 (set-buffer tgud-term-buffer)
|
|
|
1111 (goto-char (process-mark proc))
|
|
|
1112 (beginning-of-line)
|
|
|
1113 (if (looking-at term-prompt-regexp)
|
|
|
1114 (set-marker term-pending-delete-marker (point)))
|
|
|
1115 (term-send-invisible command proc))))
|
|
|
1116
|
|
|
1117 (defun tgud-refresh (&optional arg)
|
|
|
1118 "Fix up a possibly garbled display, and redraw the arrow."
|
|
|
1119 (interactive "P")
|
|
|
1120 (recenter arg)
|
|
|
1121 (or term-pending-frame (setq term-pending-frame tgud-last-last-frame))
|
|
|
1122 (tgud-display-frame))
|
|
|
1123
|
|
|
1124 ;;; Code for parsing expressions out of C code. The single entry point is
|
|
|
1125 ;;; find-c-expr, which tries to return an lvalue expression from around point.
|
|
|
1126 ;;;
|
|
|
1127 ;;; The rest of this file is a hacked version of gdbsrc.el by
|
|
|
1128 ;;; Debby Ayers <ayers@asc.slb.com>,
|
|
|
1129 ;;; Rich Schaefer <schaefer@asc.slb.com> Schlumberger, Austin, Tx.
|
|
|
1130
|
|
|
1131 (defun find-c-expr ()
|
|
|
1132 "Returns the C expr that surrounds point."
|
|
|
1133 (interactive)
|
|
|
1134 (save-excursion
|
|
|
1135 (let ((p) (expr) (test-expr))
|
|
|
1136 (setq p (point))
|
|
|
1137 (setq expr (expr-cur))
|
|
|
1138 (setq test-expr (expr-prev))
|
|
|
1139 (while (expr-compound test-expr expr)
|
|
|
1140 (setq expr (cons (car test-expr) (cdr expr)))
|
|
|
1141 (goto-char (car expr))
|
|
|
1142 (setq test-expr (expr-prev)))
|
|
|
1143 (goto-char p)
|
|
|
1144 (setq test-expr (expr-next))
|
|
|
1145 (while (expr-compound expr test-expr)
|
|
|
1146 (setq expr (cons (car expr) (cdr test-expr)))
|
|
|
1147 (setq test-expr (expr-next))
|
|
|
1148 )
|
|
|
1149 (buffer-substring (car expr) (cdr expr)))))
|
|
|
1150
|
|
|
1151 (defun expr-cur ()
|
|
|
1152 "Returns the expr that point is in; point is set to beginning of expr.
|
|
|
1153 The expr is represented as a cons cell, where the car specifies the point in
|
|
|
1154 the current buffer that marks the beginning of the expr and the cdr specifies
|
|
|
1155 the character after the end of the expr."
|
|
|
1156 (let ((p (point)) (begin) (end))
|
|
|
1157 (expr-backward-sexp)
|
|
|
1158 (setq begin (point))
|
|
|
1159 (expr-forward-sexp)
|
|
|
1160 (setq end (point))
|
|
|
1161 (if (>= p end)
|
|
|
1162 (progn
|
|
|
1163 (setq begin p)
|
|
|
1164 (goto-char p)
|
|
|
1165 (expr-forward-sexp)
|
|
|
1166 (setq end (point))
|
|
|
1167 )
|
|
|
1168 )
|
|
|
1169 (goto-char begin)
|
|
|
1170 (cons begin end)))
|
|
|
1171
|
|
|
1172 (defun expr-backward-sexp ()
|
|
|
1173 "Version of `backward-sexp' that catches errors."
|
|
|
1174 (condition-case nil
|
|
|
1175 (backward-sexp)
|
|
|
1176 (error t)))
|
|
|
1177
|
|
|
1178 (defun expr-forward-sexp ()
|
|
|
1179 "Version of `forward-sexp' that catches errors."
|
|
|
1180 (condition-case nil
|
|
|
1181 (forward-sexp)
|
|
|
1182 (error t)))
|
|
|
1183
|
|
|
1184 (defun expr-prev ()
|
|
|
1185 "Returns the previous expr, point is set to beginning of that expr.
|
|
|
1186 The expr is represented as a cons cell, where the car specifies the point in
|
|
|
1187 the current buffer that marks the beginning of the expr and the cdr specifies
|
|
|
1188 the character after the end of the expr"
|
|
|
1189 (let ((begin) (end))
|
|
|
1190 (expr-backward-sexp)
|
|
|
1191 (setq begin (point))
|
|
|
1192 (expr-forward-sexp)
|
|
|
1193 (setq end (point))
|
|
|
1194 (goto-char begin)
|
|
|
1195 (cons begin end)))
|
|
|
1196
|
|
|
1197 (defun expr-next ()
|
|
|
1198 "Returns the following expr, point is set to beginning of that expr.
|
|
|
1199 The expr is represented as a cons cell, where the car specifies the point in
|
|
|
1200 the current buffer that marks the beginning of the expr and the cdr specifies
|
|
|
1201 the character after the end of the expr."
|
|
|
1202 (let ((begin) (end))
|
|
|
1203 (expr-forward-sexp)
|
|
|
1204 (expr-forward-sexp)
|
|
|
1205 (setq end (point))
|
|
|
1206 (expr-backward-sexp)
|
|
|
1207 (setq begin (point))
|
|
|
1208 (cons begin end)))
|
|
|
1209
|
|
|
1210 (defun expr-compound-sep (span-start span-end)
|
|
|
1211 "Returns '.' for '->' & '.', returns ' ' for white space,
|
|
|
1212 returns '?' for other punctuation."
|
|
|
1213 (let ((result ? )
|
|
|
1214 (syntax))
|
|
|
1215 (while (< span-start span-end)
|
|
|
1216 (setq syntax (char-syntax (char-after span-start)))
|
|
|
1217 (cond
|
|
|
1218 ((= syntax ? ) t)
|
|
|
1219 ((= syntax ?.) (setq syntax (char-after span-start))
|
|
|
1220 (cond
|
|
|
1221 ((= syntax ?.) (setq result ?.))
|
|
|
1222 ((and (= syntax ?-) (= (char-after (+ span-start 1)) ?>))
|
|
|
1223 (setq result ?.)
|
|
|
1224 (setq span-start (+ span-start 1)))
|
|
|
1225 (t (setq span-start span-end)
|
|
|
1226 (setq result ??)))))
|
|
|
1227 (setq span-start (+ span-start 1)))
|
|
|
1228 result))
|
|
|
1229
|
|
|
1230 (defun expr-compound (first second)
|
|
|
1231 "Non-nil if concatenating FIRST and SECOND makes a single C token.
|
|
|
1232 The two exprs are represented as a cons cells, where the car
|
|
|
1233 specifies the point in the current buffer that marks the beginning of the
|
|
|
1234 expr and the cdr specifies the character after the end of the expr.
|
|
|
1235 Link exprs of the form:
|
|
|
1236 Expr -> Expr
|
|
|
1237 Expr . Expr
|
|
|
1238 Expr (Expr)
|
|
|
1239 Expr [Expr]
|
|
|
1240 (Expr) Expr
|
|
|
1241 [Expr] Expr"
|
|
|
1242 (let ((span-start (cdr first))
|
|
|
1243 (span-end (car second))
|
|
|
1244 (syntax))
|
|
|
1245 (setq syntax (expr-compound-sep span-start span-end))
|
|
|
1246 (cond
|
|
|
1247 ((= (car first) (car second)) nil)
|
|
|
1248 ((= (cdr first) (cdr second)) nil)
|
|
|
1249 ((= syntax ?.) t)
|
|
|
1250 ((= syntax ? )
|
|
|
1251 (setq span-start (char-after (- span-start 1)))
|
|
|
1252 (setq span-end (char-after span-end))
|
|
|
1253 (cond
|
|
|
1254 ((= span-start ?) ) t )
|
|
|
1255 ((= span-start ?] ) t )
|
|
|
1256 ((= span-end ?( ) t )
|
|
|
1257 ((= span-end ?[ ) t )
|
|
|
1258 (t nil))
|
|
|
1259 )
|
|
|
1260 (t nil))))
|
|
|
1261
|
|
|
1262 (provide 'tgud)
|
|
|
1263
|
|
|
1264 ;;; tgud.el ends here
|
