Mercurial > emacs
comparison lisp/gud.el @ 460:c103b99fd872
Initial revision
author | Eric S. Raymond <esr@snark.thyrsus.com> |
---|---|
date | Wed, 18 Dec 1991 10:42:47 +0000 |
parents | |
children | ab9a55b26bd4 |
comparison
equal
deleted
inserted
replaced
459:a4742d1b81bc | 460:c103b99fd872 |
---|---|
1 ;; Grand Unified Debugger mode --- run gdb, sdb, dbx under Emacs control | |
2 ;; @(#)gud.el 1.8 | |
3 | |
4 ;; This file is part of GNU Emacs. | |
5 | |
6 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
7 ;; it under the terms of the GNU General Public License as published by | |
8 ;; the Free Software Foundation; either version 1, or (at your option) | |
9 ;; any later version. | |
10 | |
11 ;; GNU Emacs is distributed in the hope that it will be useful, | |
12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 ;; GNU General Public License for more details. | |
15 | |
16 ;; You should have received a copy of the GNU General Public License | |
17 ;; along with GNU Emacs; see the file COPYING. If not, write to | |
18 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. | |
19 | |
20 ;; The ancestral gdb.el was by W. Schelter <wfs@rascal.ics.utexas.edu> | |
21 ;; It was later ewritten by rms. Some ideas were due to Masanobu. | |
22 ;; Grand Unification (sdb/dbx support) by Eric S. Raymond <eric@thyrsus.com> | |
23 ;; The overloading code was then rewritten by Barry Warsaw <bwarsaw@cen.com>, | |
24 ;; who also hacked the mode to use comint.el. | |
25 | |
26 ;; Note: use of this package with sdb requires that your tags.el support | |
27 ;; the find-tag-noselect entry point. Stock distributions up to 18.57 do | |
28 ;; *not* include this feature; if it's not included with this file, email | |
29 ;; eric@snark.thyrsus.com for it or get 18.58. | |
30 | |
31 (require 'comint) | |
32 (require 'tags) | |
33 | |
34 ;; ====================================================================== | |
35 ;; the overloading mechanism | |
36 | |
37 (defun gud-overload-functions (gud-overload-alist) | |
38 "Overload functions defined in GUD-OVERLOAD-ALIST. | |
39 This association list has elements of the form | |
40 | |
41 (ORIGINAL-FUNCTION-NAME OVERLOAD-FUNCTION)" | |
42 (let ((binding nil) | |
43 (overloads gud-overload-alist)) | |
44 (while overloads | |
45 (setq binding (car overloads) | |
46 overloads (cdr overloads)) | |
47 (fset (car binding) (symbol-function (car (cdr binding)))) | |
48 ))) | |
49 | |
50 (defun gud-debugger-startup (f d) | |
51 (error "GUD not properly entered.")) | |
52 | |
53 (defun gud-marker-filter (proc s) | |
54 (error "GUD not properly entered.")) | |
55 | |
56 (defun gud-visit-file (f) | |
57 (error "GUD not properly entered.")) | |
58 | |
59 (defun gud-set-break (proc f n) | |
60 (error "GUD not properly entered.")) | |
61 | |
62 ;; This macro is used below to define some basic debugger interface commands. | |
63 ;; Of course you may use `def-gud' with any other debugger command, including | |
64 ;; user defined ones. | |
65 | |
66 (defmacro def-gud (func name key &optional doc) | |
67 (let* ((cstr (list 'if '(not (= 1 arg)) | |
68 (list 'format "%s %s" name 'arg) name))) | |
69 (list 'progn | |
70 (list 'defun func '(arg) | |
71 (or doc "") | |
72 '(interactive "p") | |
73 (list 'gud-call cstr)) | |
74 (list 'define-key 'gud-mode-map key (list 'quote func))))) | |
75 | |
76 ;; All debugger-specific information is collected here | |
77 ;; Here's how it works, in case you ever need to add a debugger to the table. | |
78 ;; | |
79 ;; Each entry must define the following at startup: | |
80 ;; | |
81 ;;<name> | |
82 ;; comint-prompt-regexp | |
83 ;; gud-<name>-startup-command | |
84 ;; gud-<name>-marker-filter | |
85 ;; gud-<name>-file-visit | |
86 ;; gud-<name>-set-break | |
87 ;; | |
88 | |
89 ;; ====================================================================== | |
90 ;; gdb functions | |
91 | |
92 (defun gud-gdb-debugger-startup (f d) | |
93 (make-comint (concat "gud-" f) "gdb" nil "-fullname" "-cd" d f)) | |
94 | |
95 (defun gud-gdb-marker-filter (proc s) | |
96 (if (string-match "\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n" s) | |
97 (progn | |
98 (setq gud-last-frame | |
99 (cons | |
100 (substring string (match-beginning 1) (match-end 1)) | |
101 (string-to-int | |
102 (substring string (match-beginning 2) (match-end 2))))) | |
103 ;; this computation means the ^Z^Z-initiated marker in the | |
104 ;; input string is never emitted. | |
105 (concat | |
106 (substring string 0 (match-beginning 0)) | |
107 (substring string (match-end 0)) | |
108 )) | |
109 string)) | |
110 | |
111 (defun gud-gdb-visit-file (f) | |
112 (find-file-noselect f)) | |
113 | |
114 (defun gud-gdb-set-break (proc f n) | |
115 (gud-call "break %s:%d" f n)) | |
116 | |
117 (defun gdb (path) | |
118 "Run gdb on program FILE in buffer *gud-FILE*. | |
119 The directory containing FILE becomes the initial working directory | |
120 and source-file directory for your debugger." | |
121 (interactive "fRun gdb on file: ") | |
122 (gud-overload-functions '((gud-debugger-startup gud-gdb-debugger-startup) | |
123 (gud-marker-filter gud-gdb-marker-filter) | |
124 (gud-visit-file gud-gdb-visit-file) | |
125 (gud-set-break gud-gdb-set-break))) | |
126 | |
127 (def-gud gud-step "step" "\C-cs" "Step one source line with display") | |
128 (def-gud gud-stepi "stepi" "\C-ci" "Step one instruction with display") | |
129 (def-gud gud-next "next" "\C-cn" "Step one line (skip functions)") | |
130 (def-gud gud-cont "cont" "\C-c\C-c" "Continue with display") | |
131 | |
132 (def-gud gud-finish "finish" "\C-c\C-f" "Finish executing current function") | |
133 (def-gud gud-up "up" "\C-c<" "Up N stack frames (numeric arg)") | |
134 (def-gud gud-down "down" "\C-c>" "Down N stack frames (numeric arg)") | |
135 | |
136 (gud-common-init path) | |
137 | |
138 (setq comint-prompt-regexp "^(.*gdb[+]?) *") | |
139 (run-hooks 'gdb-mode-hook) | |
140 ) | |
141 | |
142 | |
143 ;; ====================================================================== | |
144 ;; sdb functions | |
145 | |
146 (defun gud-sdb-debugger-startup (f d) | |
147 (make-comint (concat "gud-" f) "sdb" nil f "-" d)) | |
148 | |
149 (defun gud-sdb-marker-filter (proc str) | |
150 (if (string-match "\\(^0x\\w* in \\|^\\|\n\\)\\([^:\n]*\\):\\([0-9]*\\):.*\n" | |
151 str) | |
152 (setq gud-last-frame | |
153 (cons | |
154 (substring string (match-beginning 2) (match-end 2)) | |
155 (string-to-int | |
156 (substring string (match-beginning 3) (match-end 3)))))) | |
157 string) | |
158 | |
159 (defun gud-sdb-visit-file (f) | |
160 (find-tag-noselect f t)) | |
161 | |
162 (defun gud-sdb-set-break (proc f n) | |
163 (gud-queue-send (format "e %s" f) (format "%d b" n))) | |
164 | |
165 (defun sdb (path) | |
166 "Run sdb on program FILE in buffer *gud-FILE*. | |
167 The directory containing FILE becomes the initial working directory | |
168 and source-file directory for your debugger." | |
169 (if (not (and (boundp 'tags-file-name) (file-exists-p tags-file-name))) | |
170 (error "The sdb support requires a valid tags table to work.")) | |
171 (interactive "fRun sdb on file: ") | |
172 (gud-overload-functions '((gud-debugger-startup gud-sdb-debugger-startup) | |
173 (gud-marker-filter gud-sdb-marker-filter) | |
174 (gud-visit-file gud-sdb-visit-file) | |
175 (gud-set-break gud-sdb-set-break))) | |
176 | |
177 (def-gud gud-step "s" "\C-cs" "Step one source line with display") | |
178 (def-gud gud-stepi "i" "\C-ci" "Step one instruction with display") | |
179 (def-gud gud-next "S" "\C-cn" "Step one source line (skip functions)") | |
180 (def-gud gud-cont "c" "\C-cc" "Continue with display") | |
181 | |
182 (gud-common-init path) | |
183 | |
184 (setq comint-prompt-pattern "\\(^\\|\n\\)\\*") | |
185 (run-hooks 'sdb-mode-hook) | |
186 ) | |
187 | |
188 ;; ====================================================================== | |
189 ;; dbx functions | |
190 | |
191 (defun gud-dbx-debugger-startup (f d) | |
192 (make-comint (concat "gud-" file) "dbx" nil f)) | |
193 | |
194 (defun gud-dbx-marker-filter (proc str) | |
195 (if (string-match | |
196 "stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\"" str) | |
197 (setq gud-last-frame | |
198 (cons | |
199 (substring string (match-beginning 2) (match-end 2)) | |
200 (string-to-int | |
201 (substring string (match-beginning 1) (match-end 1)))))) | |
202 string) | |
203 | |
204 (defun gud-dbx-visit-file (f) | |
205 (find-file-noselect f)) | |
206 | |
207 (defun gud-dbx-set-break (proc f n) | |
208 (gud-call "stop at \"%s\":%d" f n)) | |
209 | |
210 (defun dbx (path) | |
211 "Run dbx on program FILE in buffer *gud-FILE*. | |
212 The directory containing FILE becomes the initial working directory | |
213 and source-file directory for your debugger." | |
214 (interactive "fRun dbx on file: ") | |
215 (gud-overload-functions '((gud-debugger-startup gud-dbx-debugger-startup) | |
216 (gud-marker-filter gud-dbx-marker-filter) | |
217 (gud-visit-file gud-dbx-visit-file) | |
218 (gud-set-break gud-dbx-set-break))) | |
219 | |
220 (make-local-variable 'comint-prompt-regexp) | |
221 (setq comint-prompt-regexp "^[^)]*dbx) *") | |
222 | |
223 (gud-common-init path) | |
224 | |
225 (run-hooks 'dbx-mode-hook) | |
226 ) | |
227 | |
228 ;; The job of the debugger-startup method is to fire up a copy of the debugger, | |
229 ;; given an object file and source directory. | |
230 ;; | |
231 ;; The job of the marker-filter method is to detect file/line markers in | |
232 ;; strings and set the global gud-last-frame to indicate what display | |
233 ;; action (if any) should be triggered by the marker | |
234 ;; | |
235 ;; The job of the visit-file method is to visit and return the buffer indicated | |
236 ;; by the car of gud-tag-frame. This may be a file name, a tag name, or | |
237 ;; something else. | |
238 ;; | |
239 ;; The job of the gud-set-break method is to send the commands necessary | |
240 ;; to set a breakpoint at a given line in a given source file. | |
241 ;; | |
242 ;; End of debugger-specific information | |
243 | |
244 (defvar gud-mode-map nil | |
245 "Keymap for gud-mode.") | |
246 | |
247 (defvar gud-command-queue nil) | |
248 | |
249 (if gud-mode-map | |
250 nil | |
251 (setq gud-mode-map (copy-keymap comint-mode-map)) | |
252 (define-key gud-mode-map "\C-l" 'gud-refresh)) | |
253 | |
254 (define-key ctl-x-map " " 'gud-break) | |
255 (define-key ctl-x-map "&" 'send-gud-command) | |
256 | |
257 | |
258 (defun gud-mode () | |
259 "Major mode for interacting with an inferior debugger process. | |
260 The following commands are available: | |
261 | |
262 \\{gud-mode-map} | |
263 | |
264 \\[gud-display-frame] displays in the other window | |
265 the last line referred to in the gud buffer. | |
266 | |
267 \\[gud-step],\\[gud-next], and \\[gud-nexti] in the gud window, | |
268 do a step-one-line, step-one-line (not entering function calls), and | |
269 step-one-instruction and then update the other window | |
270 with the current file and position. \\[gud-cont] continues | |
271 execution. | |
272 | |
273 If you are in a source file, you may set a breakpoint at the current | |
274 line in the current source file by doing \\[gud-break]. | |
275 | |
276 Commands: | |
277 Many commands are inherited from comint mode. | |
278 Additionally we have: | |
279 | |
280 \\[gud-display-frame] display frames file in other window | |
281 \\[gud-step] advance one line in program | |
282 \\[gud-next] advance one line in program (skip over calls). | |
283 \\[send-gud-command] used for special printing of an arg at the current point. | |
284 C-x SPACE sets break point at current line." | |
285 (interactive) | |
286 (comint-mode) | |
287 ; (kill-all-local-variables) | |
288 (setq major-mode 'gud-mode) | |
289 (setq mode-name "Debugger") | |
290 (setq mode-line-process '(": %s")) | |
291 (use-local-map gud-mode-map) | |
292 (make-local-variable 'gud-last-frame) | |
293 (setq gud-last-frame nil) | |
294 (make-local-variable 'comint-prompt-regexp) | |
295 (run-hooks 'gud-mode-hook) | |
296 ) | |
297 | |
298 (defvar current-gud-buffer nil) | |
299 | |
300 (defun gud-common-init (path) | |
301 ;; perform initializations common to all debuggers | |
302 (setq path (expand-file-name path)) | |
303 (let ((file (file-name-nondirectory path))) | |
304 (switch-to-buffer (concat "*gud-" file "*")) | |
305 (setq default-directory (file-name-directory path)) | |
306 (or (bolp) (newline)) | |
307 (insert "Current directory is " default-directory "\n") | |
308 (gud-debugger-startup file default-directory)) | |
309 (gud-mode) | |
310 (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter) | |
311 (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel) | |
312 (setq gud-command-queue nil) | |
313 (gud-set-buffer) | |
314 ) | |
315 | |
316 (defun gud-set-buffer () | |
317 (cond ((eq major-mode 'gud-mode) | |
318 (setq current-gud-buffer (current-buffer))))) | |
319 | |
320 (defun gud-filter (proc string) | |
321 ;; This function is responsible for inserting output from your debugger | |
322 ;; into the buffer. The hard work is done by the method that is | |
323 ;; the value of gud-marker-filter. | |
324 (let ((inhibit-quit t)) | |
325 (gud-filter-insert proc (gud-marker-filter proc string)) | |
326 ;; If we've got queued commands and we see a prompt, pop one and send it. | |
327 ;; In theory we should check that a prompt has been issued before sending | |
328 ;; queued commands. In practice, command responses from the first through | |
329 ;; penultimate elements of a command sequence are short enough that we | |
330 ;; don't really have to bother. | |
331 (if gud-command-queue | |
332 (progn | |
333 (gud-call (car gud-command-queue)) | |
334 (setq gud-command-queue (cdr gud-command-queue)) | |
335 ) | |
336 ))) | |
337 | |
338 (defun gud-filter-insert (proc string) | |
339 ;; Here's where the actual buffer insertion is done | |
340 (let ((moving (= (point) (process-mark proc))) | |
341 (output-after-point (< (point) (process-mark proc))) | |
342 (old-buffer (current-buffer)) | |
343 start) | |
344 (set-buffer (process-buffer proc)) | |
345 (unwind-protect | |
346 (save-excursion | |
347 ;; Insert the text, moving the process-marker. | |
348 (goto-char (process-mark proc)) | |
349 (setq start (point)) | |
350 (insert-before-markers string) | |
351 (set-marker (process-mark proc) (point)) | |
352 ;; Check for a filename-and-line number. | |
353 ;; Don't display the specified file | |
354 ;; unless (1) point is at or after the position where output appears | |
355 ;; and (2) this buffer is on the screen. | |
356 (if (and gud-last-frame (not output-after-point) | |
357 (get-buffer-window (current-buffer))) | |
358 (gud-display-frame)) | |
359 ) | |
360 (set-buffer old-buffer)) | |
361 (if moving (goto-char (process-mark proc))))) | |
362 | |
363 (defun gud-sentinel (proc msg) | |
364 (cond ((null (buffer-name (process-buffer proc))) | |
365 ;; buffer killed | |
366 ;; Stop displaying an arrow in a source file. | |
367 (setq overlay-arrow-position nil) | |
368 (set-process-buffer proc nil)) | |
369 ((memq (process-status proc) '(signal exit)) | |
370 ;; Stop displaying an arrow in a source file. | |
371 (setq overlay-arrow-position nil) | |
372 ;; Fix the mode line. | |
373 (setq mode-line-process | |
374 (concat ": " | |
375 (symbol-name (process-status proc)))) | |
376 (let* ((obuf (current-buffer))) | |
377 ;; save-excursion isn't the right thing if | |
378 ;; process-buffer is current-buffer | |
379 (unwind-protect | |
380 (progn | |
381 ;; Write something in *compilation* and hack its mode line, | |
382 (set-buffer (process-buffer proc)) | |
383 ;; Force mode line redisplay soon | |
384 (set-buffer-modified-p (buffer-modified-p)) | |
385 (if (eobp) | |
386 (insert ?\n mode-name " " msg) | |
387 (save-excursion | |
388 (goto-char (point-max)) | |
389 (insert ?\n mode-name " " msg))) | |
390 ;; If buffer and mode line will show that the process | |
391 ;; is dead, we can delete it now. Otherwise it | |
392 ;; will stay around until M-x list-processes. | |
393 (delete-process proc)) | |
394 ;; Restore old buffer, but don't restore old point | |
395 ;; if obuf is the gud buffer. | |
396 (set-buffer obuf)))))) | |
397 | |
398 | |
399 (defun gud-refresh (&optional arg) | |
400 "Fix up a possibly garbled display, and redraw the arrow." | |
401 (interactive "P") | |
402 (recenter arg) | |
403 (gud-display-frame)) | |
404 | |
405 (defun gud-display-frame () | |
406 "Find and obey the last filename-and-line marker from the debugger. | |
407 Obeying it means displaying in another window the specified file and line." | |
408 (interactive) | |
409 (if gud-last-frame | |
410 (progn | |
411 (gud-set-buffer) | |
412 (gud-display-line (car gud-last-frame) (cdr gud-last-frame)) | |
413 (setq gud-last-frame nil)))) | |
414 | |
415 ;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen | |
416 ;; and that its line LINE is visible. | |
417 ;; Put the overlay-arrow on the line LINE in that buffer. | |
418 | |
419 (defun gud-display-line (true-file line) | |
420 (let* ((buffer (gud-visit-file true-file)) | |
421 (window (display-buffer buffer t)) | |
422 (pos)) | |
423 (save-excursion | |
424 (set-buffer buffer) | |
425 (save-restriction | |
426 (widen) | |
427 (goto-line line) | |
428 (setq pos (point)) | |
429 (setq overlay-arrow-string "=>") | |
430 (or overlay-arrow-position | |
431 (setq overlay-arrow-position (make-marker))) | |
432 (set-marker overlay-arrow-position (point) (current-buffer))) | |
433 (cond ((or (< pos (point-min)) (> pos (point-max))) | |
434 (widen) | |
435 (goto-char pos)))) | |
436 (set-window-point window overlay-arrow-position))) | |
437 | |
438 (defun gud-call (command &rest args) | |
439 "Invoke the debugger COMMAND displaying source in other window." | |
440 (interactive) | |
441 (gud-set-buffer) | |
442 (goto-char (point-max)) | |
443 (let ((command (concat (apply 'format command args) "\n")) | |
444 (proc (get-buffer-process current-gud-buffer))) | |
445 (gud-filter-insert proc command) | |
446 (send-string proc command) | |
447 )) | |
448 | |
449 (defun gud-queue-send (&rest cmdlist) | |
450 ;; Send the first command, queue the rest for send after successive | |
451 ;; send on subsequent prompts | |
452 (interactive) | |
453 (gud-call (car cmdlist)) | |
454 (setq gud-command-queue (append gud-command-queue (cdr cmdlist)))) | |
455 | |
456 (defun gud-apply-from-source (func) | |
457 ;; Apply a method from the gud buffer environment, passing it file and line. | |
458 ;; This is intended to be used for gud commands called from a source file. | |
459 (if (not buffer-file-name) | |
460 (error "There is no file associated with this buffer")) | |
461 (let ((file (file-name-nondirectory buffer-file-name)) | |
462 (line (save-restriction (widen) (1+ (count-lines 1 (point)))))) | |
463 (save-excursion | |
464 (gud-set-buffer) | |
465 (funcall func | |
466 (get-buffer-process current-gud-buffer) | |
467 file | |
468 line) | |
469 ))) | |
470 | |
471 (defun gud-break () | |
472 "Set breakpoint at this source line." | |
473 (interactive) | |
474 (gud-apply-from-source 'gud-set-break)) | |
475 | |
476 (defun gud-read-address() | |
477 "Return a string containing the core-address found in the buffer at point." | |
478 (save-excursion | |
479 (let ((pt (dot)) found begin) | |
480 (setq found (if (search-backward "0x" (- pt 7) t)(dot))) | |
481 (cond (found (forward-char 2) | |
482 (setq result | |
483 (buffer-substring found | |
484 (progn (re-search-forward "[^0-9a-f]") | |
485 (forward-char -1) | |
486 (dot))))) | |
487 (t (setq begin (progn (re-search-backward "[^0-9]") (forward-char 1) | |
488 (dot))) | |
489 (forward-char 1) | |
490 (re-search-forward "[^0-9]") | |
491 (forward-char -1) | |
492 (buffer-substring begin (dot))))))) | |
493 | |
494 | |
495 (defvar gud-commands nil | |
496 "List of strings or functions used by send-gud-command. | |
497 It is for customization by you.") | |
498 | |
499 (defun send-gud-command (arg) | |
500 | |
501 "This command reads the number where the cursor is positioned. It | |
502 then inserts this ADDR at the end of the debugger buffer. A numeric arg | |
503 selects the ARG'th member COMMAND of the list gud-print-command. If | |
504 COMMAND is a string, (format COMMAND ADDR) is inserted, otherwise | |
505 (funcall COMMAND ADDR) is inserted. eg. \"p (rtx)%s->fld[0].rtint\" | |
506 is a possible string to be a member of gud-commands. " | |
507 | |
508 | |
509 (interactive "P") | |
510 (let (comm addr) | |
511 (if arg (setq comm (nth arg gud-commands))) | |
512 (setq addr (gud-read-address)) | |
513 (if (eq (current-buffer) current-gud-buffer) | |
514 (set-mark (point))) | |
515 (cond (comm | |
516 (setq comm | |
517 (if (stringp comm) (format comm addr) (funcall comm addr)))) | |
518 (t (setq comm addr))) | |
519 (switch-to-buffer current-gud-buffer) | |
520 (goto-char (dot-max)) | |
521 (insert-string comm))) |