3
;; Author: Nick Roberts <nickrob@gnu.org>
4
;; Maintainer: Nick Roberts <nickrob@gnu.org>
5
;; Keywords: unix, tools
7
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
8
;; Free Software Foundation, Inc.
10
;; This file is part of GNU GDB.
12
;; GNU GDB is free software; you can redistribute it and/or modify
13
;; it under the terms of the GNU General Public License as published by
14
;; the Free Software Foundation; either version 2, or (at your option)
17
;; This program is distributed in the hope that it will be useful,
18
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20
;; GNU General Public License for more details.
24
;; This mode acts as a graphical user interface to GDB and works with Emacs
25
;; 22.x and the version of GDB with which it is distributed. You can interact
26
;; with GDB through the GUD buffer in the usual way, but there are also
27
;; buffers which control the execution and describe the state of your program.
28
;; It separates the input/output of your program from that of GDB and displays
29
;; expressions and their current values in their own buffers. It also uses
30
;; features of Emacs 21 such as the fringe/display margin for breakpoints, and
31
;; the toolbar (see the GDB Graphical Interface section in the Emacs info
34
;; Start the debugger with M-x gdbmi.
36
;; This file uses GDB/MI as the primary interface to GDB. It is still under
37
;; development and is part of a process to migrate Emacs from annotations (as
38
;; used in gdb-ui.el) to GDB/MI. It runs gdb with GDB/MI (-interp=mi) and
39
;; access CLI using "-interpreter-exec console cli-command".
41
;; This mode acts on top of gdb-ui.el. After the release of 22.1,
42
;; mainline Emacs in the CVS repository will have a file also called gdb-mi.el
43
;; which will *replace* gdb-ui.el. If you are interested in developing
44
;; this mode you should get this version.
48
;; 1) To handle program input, if required, and to avoid extra output in the
49
;; GUD buffer you must not use run, step, next or continue etc but their MI
50
;; counterparts through gud-run, gud-step etc, e.g clicking on the appropriate
51
;; icon in the toolbar.
52
;; 2) Some commands send extra prompts to the GUD buffer.
53
;; 3) Doesn't list catchpoints in breakpoints buffer.
56
;; 1) Prefix MI commands with a token instead of queueing commands.
57
;; 2) Use MI command -data-read-memory for memory window.
58
;; 3) Use MI command -data-disassemble for disassembly window.
59
;; 4) Allow separate buffers for Inferior IO and GDB IO.
60
;; 5) Watch windows to work with threads.
67
(defvar gdb-last-command nil)
68
(defvar gdb-prompt-name nil)
71
(defun gdbmi (command-line)
72
"Run gdb on program FILE in buffer *gud-FILE*.
73
The directory containing FILE becomes the initial working directory
74
and source-file directory for your debugger.
76
If `gdb-many-windows' is nil (the default value) then gdb just
77
pops up the GUD buffer unless `gdb-show-main' is t. In this case
78
it starts with two windows: one displaying the GUD buffer and the
79
other with the source file with the main routine of the inferior.
81
If `gdb-many-windows' is t, regardless of the value of
82
`gdb-show-main', the layout below will appear. Keybindings are
83
given in relevant buffer.
85
Watch expressions appear in the speedbar/slowbar.
87
The following commands help control operation :
89
`gdb-many-windows' - Toggle the number of windows gdb uses.
90
`gdb-restore-windows' - To restore the window layout.
92
See Info node `(emacs)GDB Graphical Interface' for a more
93
detailed description of this mode.
96
+--------------------------------------------------------------+
98
+-------------------------------+------------------------------+
99
| GUD buffer (I/O of GDB) | Locals buffer |
103
+-------------------------------+------------------------------+
112
+-------------------------------+------------------------------+
113
| Stack buffer | Breakpoints buffer |
114
| RET gdb-frames-select | SPC gdb-toggle-breakpoint |
115
| | RET gdb-goto-breakpoint |
116
| | d gdb-delete-breakpoint |
117
+-------------------------------+------------------------------+"
119
(interactive (list (gud-query-cmdline 'gdbmi)))
121
;; Let's start with a basic gud-gdb buffer and then modify it a bit.
124
(setq gdb-debug-ring nil)
125
(set (make-local-variable 'gud-minor-mode) 'gdbmi)
126
(set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter)
128
(gud-def gud-step "-exec-step %p" "\C-s"
129
"Step one source line with display.")
130
(gud-def gud-stepi "-exec-step-instruction %p" "\C-i"
131
"Step one instruction with display.")
132
(gud-def gud-next "-exec-next %p" "\C-n"
133
"Step one line (skip functions).")
134
(gud-def gud-cont "-exec-continue" "\C-r"
135
"Continue with display.")
136
(gud-def gud-finish "-exec-finish" "\C-f"
137
"Finish executing current function.")
138
(gud-def gud-run "-exec-run" nil "Run the program.")
139
(gud-def gud-break (if (not (string-equal mode-name "Machine"))
140
(gud-call "break %f:%l" arg)
144
(gud-call "break *%a" arg)))
145
"\C-b" "Set breakpoint at current line or address.")
147
(gud-def gud-remove (if (not (string-equal mode-name "Machine"))
148
(gud-call "clear %f:%l" arg)
152
(gud-call "clear *%a" arg)))
153
"\C-d" "Remove breakpoint at current line or address.")
155
(gud-def gud-until (if (not (string-equal mode-name "Machine"))
156
(gud-call "-exec-until %f:%l" arg)
160
(gud-call "-exec-until *%a" arg)))
161
"\C-u" "Continue to current line or address.")
163
(define-key gud-minor-mode-map [left-margin mouse-1]
164
'gdb-mouse-set-clear-breakpoint)
165
(define-key gud-minor-mode-map [left-fringe mouse-1]
166
'gdb-mouse-set-clear-breakpoint)
167
(define-key gud-minor-mode-map [left-fringe mouse-2]
169
(define-key gud-minor-mode-map [left-fringe drag-mouse-1]
171
(define-key gud-minor-mode-map [left-margin mouse-3]
172
'gdb-mouse-toggle-breakpoint-margin)
173
(define-key gud-minor-mode-map [left-fringe mouse-3]
174
'gdb-mouse-toggle-breakpoint-fringe)
176
(setq comint-input-sender 'gdbmi-send)
179
(setq gdb-pc-address (if gdb-show-main "main" nil)
180
gdb-previous-frame-address nil
181
gdb-memory-address "main"
182
gdb-previous-frame nil
183
gdb-selected-frame nil
189
gdb-pending-triggers nil
190
gdb-output-sink 'user
191
gdb-server-prefix nil
192
gdb-flush-pending-output nil
193
gdb-location-alist nil
194
gdb-source-file-list nil
197
gdb-buffer-fringe-width (car (window-fringes)))
199
gdb-source-window nil
200
gdb-inferior-status nil
203
(setq gdb-buffer-type 'gdbmi)
205
;; FIXME: use tty command to separate io.
206
;;(gdb-clear-inferior-io)
208
(if (eq window-system 'w32)
209
(gdb-enqueue-input (list "-gdb-set new-console off\n" 'ignore)))
210
(gdb-enqueue-input (list "-gdb-set height 0\n" 'ignore))
211
;; find source file and compilation directory here
213
; Needs GDB 6.2 onwards.
214
(list "-file-list-exec-source-files\n"
215
'gdb-set-gud-minor-mode-existing-buffers-1))
217
; Needs GDB 6.0 onwards.
218
(list "-file-list-exec-source-file\n" 'gdb-get-source-file))
220
(list "-data-list-register-names\n" 'gdb-get-register-names))
222
(list "-gdb-show prompt\n" 'gdb-get-prompt))
224
(setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2)
225
(run-hooks 'gdbmi-mode-hook))
228
(defun gdbmi-send (proc string)
229
"A comint send filter for gdb."
231
(process-send-string proc (concat string "\n"))
232
(with-current-buffer gud-comint-buffer
233
(let ((inhibit-read-only t))
234
(remove-text-properties (point-min) (point-max) '(face))))
235
(setq gdb-output-sink 'user)
236
(setq gdb-prompting nil)
237
;; mimic <RET> key to repeat previous command in GDB
238
(if (not (string-match "^\\s+$" string))
239
(setq gdb-last-command string)
240
(if gdb-last-command (setq string gdb-last-command)))
242
(push (cons 'mi-send (concat string "\n")) gdb-debug-ring))
243
(if (string-match "^-" string)
245
(process-send-string proc (concat string "\n"))
247
(if (string-match "\\\\$" string)
248
(setq gdb-continuation (concat gdb-continuation string "\n"))
249
(process-send-string proc
250
(concat "-interpreter-exec console \""
251
gdb-continuation string "\"\n"))
252
(setq gdb-continuation nil)))))
254
(defcustom gud-gdbmi-command-name "gdb -interp=mi"
255
"Default command to execute an executable under the GDB-UI debugger."
259
(defconst gdb-gdb-regexp "(gdb) \n")
261
(defconst gdb-running-regexp (concat "\\^running\n" gdb-gdb-regexp))
263
;; fullname added GDB 6.4+.
264
;; Probably not needed. -stack-info-frame computes filename and line.
265
(defconst gdb-stopped-regexp
266
"\\*stopped,reason=.*?,file=\".*?\"\
267
,fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"}\n")
269
(defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)\n")
271
(defconst gdb-done-regexp "\\^done,*\n*")
273
(defconst gdb-console-regexp "~\\(\".*?[^\\]\"\\)\n")
275
(defconst gdb-internals-regexp "&\\(\".*?\\n\"\\)\n")
277
(defun gdbmi-prompt1 ()
278
"Queue any GDB commands that the user interface needs."
279
(unless gdb-pending-triggers
280
(gdbmi-get-selected-frame)
281
(gdbmi-invalidate-frames)
282
(gdbmi-invalidate-breakpoints)
283
(gdb-get-changed-registers)
284
(gdb-invalidate-registers-1)
285
(gdb-invalidate-locals-1)
286
(if (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
287
(gdb-var-update-1))))
289
(defun gdbmi-prompt2 ()
290
"Handle any output and send next GDB command."
291
(let ((sink gdb-output-sink))
292
(when (eq sink 'emacs)
294
(car (cdr gdb-current-item))))
295
(with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
296
(funcall handler)))))
297
(let ((input (gdb-dequeue-input)))
299
(gdb-send-item input)
301
(setq gud-running nil)
302
(setq gdb-prompting t)
303
(gud-display-frame)))))
305
(defun gud-gdbmi-marker-filter (string)
306
"Filter GDB/MI output."
307
(if gdb-flush-pending-output
309
(if gdb-enable-debug (push (cons 'recv (list string gdb-output-sink))
311
;; Recall the left over gud-marker-acc from last time
312
(setq gud-marker-acc (concat gud-marker-acc string))
313
;; Start accumulating output for the GUD buffer
314
(let ((output "") running)
316
(if (string-match gdb-running-regexp gud-marker-acc)
319
(concat (substring gud-marker-acc 0 (match-beginning 0))
320
(substring gud-marker-acc (match-end 0)))
323
(if (string-match gdb-stopped-regexp gud-marker-acc)
326
;; Extract the frame position from the marker.
327
gud-last-frame (cons (match-string 1 gud-marker-acc)
329
(match-string 2 gud-marker-acc)))
332
(concat (substring gud-marker-acc 0 (match-beginning 0))
333
(substring gud-marker-acc (match-end 0)))))
335
;; Filter error messages going to GUD buffer and
336
;; display in minibuffer.
337
(when (eq gdb-output-sink 'user)
338
(while (string-match gdb-error-regexp gud-marker-acc)
339
(message (read (match-string 1 gud-marker-acc)))
342
(concat (substring gud-marker-acc 0 (match-beginning 0))
343
(substring gud-marker-acc (match-end 0)))))
345
(if (string-match gdb-done-regexp gud-marker-acc)
348
(concat (substring gud-marker-acc 0 (match-beginning 0))
349
(substring gud-marker-acc (match-end 0))))))
351
(when (string-match gdb-gdb-regexp gud-marker-acc)
354
(concat (substring gud-marker-acc 0 (match-beginning 0))
355
(substring gud-marker-acc (match-end 0))))
357
;; Remove the trimmings from the console stream.
358
(while (string-match gdb-console-regexp gud-marker-acc)
360
gud-marker-acc (concat
361
(substring gud-marker-acc 0 (match-beginning 0))
362
(read (match-string 1 gud-marker-acc))
363
(substring gud-marker-acc (match-end 0)))))
365
;; Remove the trimmings from log stream containing debugging messages
366
;; being produced by GDB's internals and use warning face.
367
(while (string-match gdb-internals-regexp gud-marker-acc)
370
(concat (substring gud-marker-acc 0 (match-beginning 0))
372
(read (match-string 1 gud-marker-acc))))
374
0 (length error-message)
375
'face font-lock-warning-face
378
(substring gud-marker-acc (match-end 0)))))
380
(setq output (gdbmi-concat-output output gud-marker-acc))
381
(setq gud-marker-acc "")
383
(unless gdb-input-queue
384
(setq output (concat output gdb-prompt-name)))
386
(setq gud-running running))
389
(setq output (gdbmi-concat-output output gud-marker-acc))
390
(setq gud-marker-acc ""))
394
(defun gdbmi-concat-output (so-far new)
395
(let ((sink gdb-output-sink))
397
((eq sink 'user) (concat so-far new))
399
(gdb-append-to-partial-output new)
402
(gdb-append-to-inferior-io new)
406
;; Breakpoint buffer : This displays the output of `-break-list'.
408
(def-gdb-auto-update-trigger gdbmi-invalidate-breakpoints
409
(gdb-get-buffer 'gdb-breakpoints-buffer)
411
gdb-break-list-handler)
413
(defconst gdb-break-list-regexp
414
"bkpt={.*?number=\"\\(.*?\\)\",.*?type=\"\\(.*?\\)\",.*?disp=\"\\(.*?\\)\",.*?\
415
enabled=\"\\(.\\)\",.*?addr=\"\\(.*?\\)\",\\(?:.*?func=\"\\(.*?\\)\",.*?\
416
file=\"\\(.*?\\)\",.*?fullname=\".*?\",.*?line=\"\\(.*?\\)\",\
417
\\|\\(?:.*?what=\"\\(.*?\\)\",\\)*\\).*?times=\"\\(.*?\\)\".*?}")
419
(defun gdb-break-list-handler ()
420
(setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints
421
gdb-pending-triggers))
422
(let ((breakpoint) (breakpoints-list))
423
(with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
424
(goto-char (point-min))
425
(while (re-search-forward gdb-break-list-regexp nil t)
426
(let ((breakpoint (list (match-string 1)
436
(push breakpoint breakpoints-list))))
437
(let ((buf (gdb-get-buffer 'gdb-breakpoints-buffer)))
438
(and buf (with-current-buffer buf
440
(buffer-read-only nil))
442
(insert "Num Type Disp Enb Hits Addr What\n")
443
(dolist (breakpoint breakpoints-list)
446
(nth 0 breakpoint) " "
447
(nth 1 breakpoint) " "
448
(nth 2 breakpoint) " "
449
(nth 3 breakpoint) " "
450
(nth 9 breakpoint) " "
451
(nth 4 breakpoint) " "
452
(if (nth 5 breakpoint)
453
(concat "in " (nth 5 breakpoint) " at " (nth 6 breakpoint) ":" (nth 7 breakpoint) "\n")
454
(concat (nth 8 breakpoint) "\n")))))
456
(gdb-info-breakpoints-custom))
458
(defun gdbmi-get-location (bptno line flag)
459
"Find the directory containing the relevant source file.
460
Put in buffer and place breakpoint icon."
461
(goto-char (point-min))
462
(catch 'file-not-found
463
(if (re-search-forward gdb-source-file-regexp-1 nil t)
464
(delete (cons bptno "File not found") gdb-location-alist)
465
(push (cons bptno (match-string 1)) gdb-location-alist)
467
(unless (assoc bptno gdb-location-alist)
468
(push (cons bptno "File not found") gdb-location-alist)
469
(message-box "Cannot find source file for breakpoint location.
470
Add directory to search path for source files using the GDB command, dir."))
471
(throw 'file-not-found nil))
473
(find-file-noselect (match-string 1))
475
(set (make-local-variable 'gud-minor-mode) 'gdbmi)
476
(set (make-local-variable 'tool-bar-map) gud-tool-bar-map))
477
;; only want one breakpoint icon at each location
479
(goto-line (string-to-number line))
480
(gdb-put-breakpoint-icon (eq flag ?y) bptno)))))
482
;; Frames buffer. This displays a perpetually correct bactrack trace.
484
(def-gdb-auto-update-trigger gdbmi-invalidate-frames
485
(gdb-get-buffer 'gdb-stack-buffer)
486
"-stack-list-frames\n"
487
gdb-stack-list-frames-handler)
489
(defconst gdb-stack-list-frames-regexp
490
"{.*?level=\"\\(.*?\\)\",.*?addr=\"\\(.*?\\)\",.*?func=\"\\(.*?\\)\",\
491
\\(?:.*?file=\".*?\",.*?fullname=\"\\(.*?\\)\",.*?line=\"\\(.*?\\)\".*?}\\|\
492
from=\"\\(.*?\\)\"\\)")
494
(defun gdb-stack-list-frames-handler ()
495
(setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames
496
gdb-pending-triggers))
499
(with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
500
(goto-char (point-min))
501
(while (re-search-forward gdb-stack-list-frames-regexp nil t)
502
(let ((frame (list (match-string 1)
508
(push frame call-stack))))
509
(let ((buf (gdb-get-buffer 'gdb-stack-buffer)))
510
(and buf (with-current-buffer buf
512
(buffer-read-only nil))
514
(insert "Level\tAddr\tFunc\tFile:Line\n")
515
(dolist (frame (nreverse call-stack))
520
(propertize (nth 2 frame)
521
'face font-lock-function-name-face) "\t"
523
(concat "at "(nth 3 frame) ":" (nth 4 frame) "\n")
524
(concat "from " (nth 5 frame) "\n")))))
526
(gdb-stack-list-frames-custom))
528
(defun gdb-stack-list-frames-custom ()
529
(with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
531
(let ((buffer-read-only nil))
532
(goto-char (point-min))
534
(while (< (point) (point-max))
535
(add-text-properties (point-at-bol) (point-at-eol)
536
'(mouse-face highlight
537
help-echo "mouse-2, RET: Select frame"))
539
(when (and (looking-at "^[0-9]+\\s-+\\(\\S-+\\)")
540
(equal (match-string 1) gdb-selected-frame))
541
(put-text-property (point-at-bol) (point-at-eol)
542
'face '(:inverse-video t)))
543
(forward-line 1))))))
546
;; gdb-ui.el uses "info source" to find out if macro information is present.
547
(defun gdb-get-source-file ()
548
"Find the source file where the program starts and display it with related
549
buffers, if required."
550
(goto-char (point-min))
551
(if (re-search-forward gdb-source-file-regexp-1 nil t)
552
(setq gdb-main-file (match-string 1)))
555
(gdb-get-buffer-create 'gdb-breakpoints-buffer)
557
(let ((pop-up-windows t))
558
(display-buffer (gud-find-file gdb-main-file))))))
560
(defun gdbmi-get-selected-frame ()
561
(if (not (member 'gdbmi-get-selected-frame gdb-pending-triggers))
564
(list "-stack-info-frame\n" 'gdbmi-frame-handler))
565
(push 'gdbmi-get-selected-frame
566
gdb-pending-triggers))))
568
(defun gdbmi-frame-handler ()
569
(setq gdb-pending-triggers
570
(delq 'gdbmi-get-selected-frame gdb-pending-triggers))
571
(with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
572
(goto-char (point-min))
573
(when (re-search-forward gdb-stack-list-frames-regexp nil t)
574
(setq gdb-frame-number (match-string 1))
575
(setq gdb-pc-address (match-string 2))
576
(setq gdb-selected-frame (match-string 3))
577
(when (match-string 4)
579
(cons (match-string 4) (string-to-number (match-string 5))))
581
(if gud-overlay-arrow-position
582
(let ((buffer (marker-buffer gud-overlay-arrow-position))
583
(position (marker-position gud-overlay-arrow-position)))
585
(with-current-buffer buffer
586
(setq fringe-indicator-alist
587
(if (string-equal gdb-frame-number "0")
589
'((overlay-arrow . hollow-right-triangle))))
590
(setq gud-overlay-arrow-position (make-marker))
591
(set-marker gud-overlay-arrow-position position))))))
592
(if (gdb-get-buffer 'gdb-locals-buffer)
593
(with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
594
(setq mode-name (concat "Locals:" gdb-selected-frame))))
595
(if (gdb-get-buffer 'gdb-assembler-buffer)
596
(with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
597
(setq mode-name (concat "Machine:" gdb-selected-frame)))))))
599
(defvar gdb-prompt-name-regexp "value=\"\\(.*?\\)\"")
601
(defun gdb-get-prompt ()
602
"Find prompt for GDB session."
603
(goto-char (point-min))
604
(setq gdb-prompt-name nil)
605
(re-search-forward gdb-prompt-name-regexp nil t)
606
(setq gdb-prompt-name (match-string 1)))
609
;;; gdbmi.el ends here
added
removed
gdb/mi/gdb-mi.el
