1;;; gdb-mi.el (internally gdbmi6.el) - (24th May 2004)
2
3;; Run gdb with GDB/MI (-interp=mi) and access CLI using "cli-command"
4;; (could use "-interpreter-exec console cli-command")
5
6;; Author: Nick Roberts <nickrob@gnu.org>
7;; Maintainer: Nick Roberts <nickrob@gnu.org>
8;; Keywords: unix, tools
9
10;; Copyright (C) 2004  Free Software Foundation, Inc.
11
12;; This file is part of GNU GDB.
13
14;; GNU GDB is free software; you can redistribute it and/or modify
15;; it under the terms of the GNU General Public License as published by
16;; the Free Software Foundation; either version 2, or (at your option)
17;; any later version.
18
19;; This program is distributed in the hope that it will be useful,
20;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
22;; GNU General Public License for more details.
23
24;;; Commentary:
25
26;; This mode acts as a graphical user interface to GDB and requires GDB 6.1
27;; onwards. You can interact with GDB through the GUD buffer in the usual way,
28;; but there are also buffers which control the execution and describe the
29;; state of your program. It separates the input/output of your program from
30;; that of GDB and displays expressions and their current values in their own
31;; buffers. It also uses features of Emacs 21 such as the fringe/display
32;; margin for breakpoints, and the toolbar (see the GDB Graphical Interface
33;; section in the Emacs info manual).
34
35;; Start the debugger with M-x gdbmi.
36
37;; This file uses GDB/MI as the primary interface to GDB. It is still under
38;; development and is part of a process to migrate Emacs from annotations
39;; (as used in gdb-ui.el) to GDB/MI.
40
41;; Known Bugs:
42;;
43
44;;; Code:
45
46(require 'gud)
47(require 'gdb-ui)
48
49
50;;;###autoload
51(defun gdbmi (command-line)
52  "Run gdb on program FILE in buffer *gud-FILE*.
53The directory containing FILE becomes the initial working directory
54and source-file directory for your debugger.
55
56If `gdb-many-windows' is nil (the default value) then gdb just
57pops up the GUD buffer unless `gdb-show-main' is t. In this case
58it starts with two windows: one displaying the GUD buffer and the
59other with the source file with the main routine of the inferior.
60
61If `gdb-many-windows' is t, regardless of the value of
62`gdb-show-main', the layout below will appear. Keybindings are
63given in relevant buffer.
64
65Watch expressions appear in the speedbar/slowbar.
66
67The following interactive lisp functions help control operation :
68
69`gdb-many-windows'    - Toggle the number of windows gdb uses.
70`gdb-restore-windows' - To restore the window layout.
71
72See Info node `(emacs)GDB Graphical Interface' for a more
73detailed description of this mode.
74
75
76---------------------------------------------------------------------
77                               GDB Toolbar
78---------------------------------------------------------------------
79GUD buffer (I/O of GDB)           | Locals buffer
80                                  |
81                                  |
82                                  |
83---------------------------------------------------------------------
84 Source buffer                    | Input/Output (of inferior) buffer
85                                  | (comint-mode)
86                                  |
87                                  |
88                                  |
89                                  |
90                                  |
91                                  |
92---------------------------------------------------------------------
93 Stack buffer                     | Breakpoints buffer
94 RET      gdb-frames-select       | SPC    gdb-toggle-breakpoint
95                                  | RET    gdb-goto-breakpoint
96                                  |   d    gdb-delete-breakpoint
97---------------------------------------------------------------------
98"
99  ;;
100  (interactive (list (gud-query-cmdline 'gdbmi)))
101  ;;
102  ;; Let's start with a basic gud-gdb buffer and then modify it a bit.
103  (gdb command-line)
104  ;;
105  (setq gdb-debug-log nil)
106  (set (make-local-variable 'gud-minor-mode) 'gdbmi)
107  (set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter)
108  ;;
109  (gud-def gud-break (if (not (string-equal mode-name "Machine"))
110			 (gud-call "-break-insert %f:%l" arg)
111		       (save-excursion
112			 (beginning-of-line)
113			 (forward-char 2)
114			 (gud-call "-break-insert *%a" arg)))
115	   "\C-b" "Set breakpoint at current line or address.")
116  ;;
117  (gud-def gud-remove (if (not (string-equal mode-name "Machine"))
118			  (gud-call "clear %f:%l" arg)
119			(save-excursion
120			  (beginning-of-line)
121			  (forward-char 2)
122			  (gud-call "clear *%a" arg)))
123	   "\C-d" "Remove breakpoint at current line or address.")
124  ;;
125  (gud-def gud-until  (if (not (string-equal mode-name "Machine"))
126			  (gud-call "until %f:%l" arg)
127			(save-excursion
128			  (beginning-of-line)
129			  (forward-char 2)
130			  (gud-call "until *%a" arg)))
131	   "\C-u" "Continue to current line or address.")
132
133  (define-key gud-minor-mode-map [left-margin mouse-1]
134    'gdb-mouse-toggle-breakpoint)
135  (define-key gud-minor-mode-map [left-fringe mouse-1]
136    'gdb-mouse-toggle-breakpoint)
137
138  (setq comint-input-sender 'gdbmi-send)
139  ;;
140  ;; (re-)initialise
141  (setq gdb-main-file nil)
142  (setq gdb-current-address "main")
143  (setq gdb-previous-address nil)
144  (setq gdb-previous-frame nil)
145  (setq gdb-current-frame "main")
146  (setq gdb-view-source t)
147  (setq gdb-selected-view 'source)
148  (setq gdb-var-list nil)
149  (setq gdb-var-changed nil)
150  (setq gdb-prompting nil)
151  (setq gdb-current-item nil)
152  (setq gdb-pending-triggers nil)
153  (setq gdb-output-sink 'user)
154  (setq gdb-server-prefix nil)
155  ;;
156  (setq gdb-buffer-type 'gdbmi)
157  ;;
158  ;; FIXME: use tty command to separate io.
159  ;;(gdb-clear-inferior-io)
160  ;;
161  (if (eq window-system 'w32)
162      (gdb-enqueue-input (list "-gdb-set new-console off\n" 'ignore)))
163  ;; find source file and compilation directory here
164  (gdb-enqueue-input (list "list main\n"   'ignore))   ; C program
165  (gdb-enqueue-input (list "list MAIN__\n" 'ignore))   ; Fortran program
166  (gdb-enqueue-input (list "info source\n" 'gdbmi-source-info))
167  ;;
168  (run-hooks 'gdbmi-mode-hook))
169
170; Force nil till fixed.
171(defconst gdbmi-use-inferior-io-buffer nil)
172
173; uses --all-values Needs GDB 6.1 onwards.
174(defun gdbmi-var-list-children (varnum)
175  (gdb-enqueue-input
176   (list (concat "-var-update " varnum "\n") 'ignore))
177  (gdb-enqueue-input
178   (list (concat "-var-list-children --all-values "
179		 varnum "\n")
180	     `(lambda () (gdbmi-var-list-children-handler ,varnum)))))
181
182(defconst gdbmi-var-list-children-regexp
183"name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",value=\"\\(.*?\\)\""
184)
185
186(defun gdbmi-var-list-children-handler (varnum)
187  (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
188    (goto-char (point-min))
189    (let ((var-list nil))
190     (catch 'child-already-watched
191       (dolist (var gdb-var-list)
192	 (if (string-equal varnum (cadr var))
193	     (progn
194	       (push var var-list)
195	       (while (re-search-forward gdbmi-var-list-children-regexp nil t)
196		 (let ((varchild (list (match-string 2)
197				       (match-string 1)
198				       (match-string 3)
199				       nil
200				       (match-string 4)
201				       nil)))
202		   (if (looking-at ",type=\"\\(.*?\\)\"")
203		       (setcar (nthcdr 3 varchild) (match-string 1)))
204		   (dolist (var1 gdb-var-list)
205		     (if (string-equal (cadr var1) (cadr varchild))
206			 (throw 'child-already-watched nil)))
207		   (push varchild var-list))))
208	   (push var var-list)))
209       (setq gdb-var-changed t)
210       (setq gdb-var-list (nreverse var-list))))))
211
212;(defun gdbmi-send (proc string)
213;  "A comint send filter for gdb."
214;  (setq gdb-output-sink 'user)
215;  (setq gdb-prompting nil)
216;  (process-send-string proc (concat "-interpreter-exec console \"" string "\"")))
217
218(defun gdbmi-send (proc string)
219  "A comint send filter for gdb."
220  (setq gdb-output-sink 'user)
221  (setq gdb-prompting nil)
222  (process-send-string proc (concat string "\n")))
223
224(defcustom gud-gdbmi-command-name "~/gdb/gdb/gdb -interp=mi"
225  "Default command to execute an executable under the GDB-UI debugger."
226  :type 'string
227  :group 'gud)
228
229(defconst gdb-stopped-regexp
230  "\\((gdb) \n\\*stopped\\|^\\^done\\),reason=.*,file=\"\\(.*\\)\",line=\"\\(.*\\)\".*")
231
232(defconst gdb-console-regexp "~\"\\(.*\\)\\\\n\"")
233
234(defconst gdb-internals-regexp "&\".*\\n\"\n")
235
236(defconst gdb-gdb-regexp "(gdb) \n")
237
238(defconst gdb-running-regexp "^\\^running")
239
240(defun gdbmi-prompt ()
241  "This handler terminates the any collection of output. It also
242  sends the next command (if any) to gdb."
243  (unless gdb-pending-triggers
244	(gdb-get-current-frame)
245	(gdbmi-invalidate-frames)
246	(gdbmi-invalidate-breakpoints)
247	(gdbmi-invalidate-locals)
248	(dolist (frame (frame-list))
249	  (when (string-equal (frame-parameter frame 'name) "Speedbar")
250	    (setq gdb-var-changed t)    ; force update
251	    (dolist (var gdb-var-list)
252	      (setcar (nthcdr 5 var) nil))))
253	(gdb-var-update))
254  (let ((sink gdb-output-sink))
255    (when (eq sink 'emacs)
256      (let ((handler
257	     (car (cdr gdb-current-item))))
258	(with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
259	  (funcall handler)))))
260  (let ((input (gdb-dequeue-input)))
261    (if input
262	(gdb-send-item input)
263      (progn
264	(setq gud-running nil)
265	(setq gdb-prompting t)
266	(gud-display-frame)))))
267
268(defun gud-gdbmi-marker-filter (string)
269  "Filter GDB/MI output."
270  (if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log))
271  ;; Recall the left over gud-marker-acc from last time
272  (setq gud-marker-acc (concat gud-marker-acc string))
273  ;; Start accumulating output for the GUD buffer
274  (let ((output ""))
275
276    (if (string-match gdb-running-regexp gud-marker-acc)
277       (setq gud-marker-acc (substring gud-marker-acc (match-end 0))
278	     gud-running t))
279
280    ;; Remove the trimmings from the console stream.
281    (while (string-match gdb-console-regexp gud-marker-acc)
282       (setq
283	gud-marker-acc (concat (substring gud-marker-acc 0 (match-beginning 0))
284			       (match-string 1 gud-marker-acc)
285			       (substring gud-marker-acc (match-end 0)))))
286
287    ;; Remove log stream containing debugging messages being produced by GDB's
288    ;; internals.
289    (while (string-match gdb-internals-regexp gud-marker-acc)
290       (setq
291	 gud-marker-acc (concat (substring gud-marker-acc 0 (match-beginning 0))
292				(substring gud-marker-acc (match-end 0)))))
293
294    (if (string-match gdb-stopped-regexp gud-marker-acc)
295      (setq
296
297       ;; Extract the frame position from the marker.
298       gud-last-frame (cons (match-string 2 gud-marker-acc)
299			    (string-to-int (match-string 3 gud-marker-acc)))
300
301       ;; Append any text before the marker to the output we're going
302       ;; to return - we don't include the marker in this text.
303       output (gdbmi-concat-output output
304		      (substring gud-marker-acc 0 (match-beginning 0)))
305
306       ;; Set the accumulator to the remaining text.
307       gud-marker-acc (substring gud-marker-acc (match-end 0))))
308
309    (while (string-match gdb-gdb-regexp gud-marker-acc)
310      (setq
311
312       ;; Append any text up to and including prompt less \n to the output.
313       output (gdbmi-concat-output output
314		      (substring gud-marker-acc 0 (- (match-end 0) 1)))
315
316       ;; Set the accumulator to the remaining text.
317       gud-marker-acc (substring gud-marker-acc (match-end 0)))
318      (gdbmi-prompt))
319
320    (setq output (gdbmi-concat-output output gud-marker-acc))
321    (setq gud-marker-acc "")
322    output))
323
324(defun gdbmi-concat-output (so-far new)
325  (let ((sink gdb-output-sink))
326    (cond
327     ((eq sink 'user) (concat so-far new))
328     ((eq sink 'emacs)
329      (gdb-append-to-partial-output new)
330      so-far)
331     ((eq sink 'inferior)
332      (gdb-append-to-inferior-io new)
333      so-far))))
334
335
336;; Breakpoint buffer : This displays the output of `-break-list'.
337;;
338(def-gdb-auto-updated-buffer gdb-breakpoints-buffer
339  ;; This defines the auto update rule for buffers of type
340  ;; `gdb-breakpoints-buffer'.
341  ;;
342  ;; It defines a function that queues the command below.  That function is
343  ;; called:
344  gdbmi-invalidate-breakpoints
345  ;;
346  ;; To update the buffer, this command is sent to gdb.
347  "-break-list\n"
348  ;;
349  ;; This also defines a function to be the handler for the output
350  ;; from the command above.  That function will copy the output into
351  ;; the appropriately typed buffer.  That function will be called:
352  gdb-break-list-handler
353  ;; buffer specific functions
354  gdb-break-list-custom)
355
356(defconst gdb-break-list-regexp
357"number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
358
359(defun gdb-break-list-handler ()
360  (setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints
361				  gdb-pending-triggers))
362  (let ((breakpoint nil)
363	(breakpoints-list nil))
364    (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
365      (goto-char (point-min))
366      (while (re-search-forward gdb-break-list-regexp nil t)
367	(let ((breakpoint (list (match-string 1)
368				(match-string 2)
369				(match-string 3)
370				(match-string 4)
371				(match-string 5)
372				(match-string 6)
373				(match-string 7)
374				(match-string 8))))
375	  (push breakpoint breakpoints-list))))
376    (let ((buf (gdb-get-buffer 'gdb-breakpoints-buffer)))
377      (and buf (with-current-buffer buf
378		 (let ((p (point))
379		       (buffer-read-only nil))
380		   (erase-buffer)
381		   (insert "Num Type        Disp Enb Func\tFile:Line\tAddr\n")
382		   (dolist (breakpoint breakpoints-list)
383		     (insert (concat
384			      (nth 0 breakpoint) "   "
385			      (nth 1 breakpoint) "  "
386			      (nth 2 breakpoint) "   "
387			      (nth 3 breakpoint) " "
388			      (nth 5 breakpoint) "\t"
389			      (nth 6 breakpoint) ":" (nth 7 breakpoint) "\t"
390			      (nth 4 breakpoint) "\n")))
391		   (goto-char p))))))
392  (gdb-break-list-custom))
393
394;;-put breakpoint icons in relevant margins (even those set in the GUD buffer)
395(defun gdb-break-list-custom ()
396  (let ((flag)(address))
397    ;;
398    ;; remove all breakpoint-icons in source buffers but not assembler buffer
399    (dolist (buffer (buffer-list))
400      (with-current-buffer buffer
401	(if (and (eq gud-minor-mode 'gdbmi)
402		 (not (string-match "\\`\\*.+\\*\\'" (buffer-name))))
403	    (gdb-remove-breakpoint-icons (point-min) (point-max)))))
404    (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer)
405      (save-excursion
406	(goto-char (point-min))
407	(while (< (point) (- (point-max) 1))
408	  (forward-line 1)
409	  (if (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*\\S-*\\s-*\\(\\S-*\\):\\([0-9]+\\)")
410	      (progn
411		(setq flag (char-after (match-beginning 1)))
412		(let ((line (match-string 3)) (buffer-read-only nil)
413		      (file (match-string 2)))
414		  (add-text-properties (point-at-bol) (point-at-eol)
415				       '(mouse-face highlight
416						    help-echo "mouse-2, RET: visit breakpoint"))
417		  (with-current-buffer
418		      (find-file-noselect
419		       (if (file-exists-p file) file
420			 (expand-file-name file gdb-cdir)))
421		    (save-current-buffer
422		      (set (make-local-variable 'gud-minor-mode) 'gdbmi)
423		      (set (make-local-variable 'tool-bar-map)
424			   gud-tool-bar-map))
425		    ;; only want one breakpoint icon at each location
426		    (save-excursion
427		      (goto-line (string-to-number line))
428		      (gdb-put-breakpoint-icon (eq flag ?y)))))))))
429	  (end-of-line)))
430  (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom)))
431
432;; Frames buffer.  This displays a perpetually correct bactrack trace.
433;;
434(def-gdb-auto-updated-buffer gdb-stack-buffer
435  gdbmi-invalidate-frames
436  "-stack-list-frames\n"
437  gdb-stack-list-frames-handler
438  gdb-stack-list-frames-custom)
439
440(defconst gdb-stack-list-frames-regexp
441"level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
442
443(defun gdb-stack-list-frames-handler ()
444  (setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames
445				  gdb-pending-triggers))
446  (let ((frame nil)
447	(call-stack nil))
448    (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
449      (goto-char (point-min))
450      (while (re-search-forward gdb-stack-list-frames-regexp nil t)
451	(let ((frame (list (match-string 1)
452			   (match-string 2)
453			   (match-string 3)
454			   (match-string 4)
455			   (match-string 5))))
456	  (push frame call-stack))))
457    (let ((buf (gdb-get-buffer 'gdb-stack-buffer)))
458      (and buf (with-current-buffer buf
459		 (let ((p (point))
460		       (buffer-read-only nil))
461		   (erase-buffer)
462		   (insert "Level\tFunc\tFile:Line\tAddr\n")
463		   (dolist (frame (nreverse call-stack))
464		     (insert (concat
465			      (nth 0 frame) "\t"
466			      (nth 2 frame) "\t"
467			      (nth 3 frame) ":" (nth 4 frame) "\t"
468			      (nth 1 frame) "\n")))
469		   (goto-char p))))))
470  (gdb-stack-list-frames-custom))
471
472(defun gdb-stack-list-frames-custom ()
473  (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
474    (save-excursion
475      (let ((buffer-read-only nil))
476	(goto-char (point-min))
477	(forward-line 1)
478	(while (< (point) (point-max))
479	  (add-text-properties (point-at-bol) (point-at-eol)
480			     '(mouse-face highlight
481			       help-echo "mouse-2, RET: Select frame"))
482	  (beginning-of-line)
483	  (when (and (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)")
484			 (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)"))
485		     (equal (match-string 1) gdb-current-frame))
486	    (put-text-property (point-at-bol) (point-at-eol)
487			       'face '(:inverse-video t)))
488	  (forward-line 1))))))
489
490;; Locals buffer.
491;; uses "-stack-list-locals 2". Needs GDB 6.1 onwards.
492(def-gdb-auto-updated-buffer gdb-locals-buffer
493  gdbmi-invalidate-locals
494  "-stack-list-locals 2\n"
495  gdb-stack-list-locals-handler
496  gdb-stack-list-locals-custom)
497
498(defconst gdb-stack-list-locals-regexp
499  (concat "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\""))
500
501;; Dont display values of arrays or structures.
502;; These can be expanded using gud-watch.
503(defun gdb-stack-list-locals-handler nil
504  (setq gdb-pending-triggers (delq 'gdbmi-invalidate-locals
505				  gdb-pending-triggers))
506  (let ((local nil)
507	(locals-list nil))
508    (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer)
509      (goto-char (point-min))
510      (while (re-search-forward gdb-stack-list-locals-regexp nil t)
511	(let ((local (list (match-string 1)
512			   (match-string 2)
513			   nil)))
514	  (if (looking-at ",value=\"\\(.*?\\)\"")
515	      (setcar (nthcdr 2 local) (match-string 1)))
516	(push local locals-list))))
517    (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
518      (and buf (with-current-buffer buf
519		 (let ((p (point))
520		       (buffer-read-only nil))
521		   (erase-buffer)
522		   (dolist (local locals-list)
523		     (insert
524		      (concat (car local) "\t" (nth 1 local) "\t"
525			      (or (nth 2 local)
526				  (if (string-match "struct" (nth 1 local))
527				      "(structure)"
528				    "(array)"))
529			      "\n")))
530		   (goto-char p)))))))
531
532(defun gdb-stack-list-locals-custom ()
533  nil)
534
535(defun gdbmi-source-info ()
536  "Find the source file where the program starts and displays it with related
537buffers."
538  (goto-char (point-min))
539  (if (search-forward "source file is " nil t)
540      (if (looking-at "\\S-*")
541	  (setq gdb-main-file (match-string 0)))
542    (setq gdb-view-source nil))
543  (if (search-forward "directory is " nil t)
544      (if (looking-at "\\S-*:\\(\\S-*\\)")
545	  (setq gdb-cdir (match-string 1))
546	(looking-at "\\S-*")
547	(setq gdb-cdir (match-string 0))))
548
549;temporary heuristic
550  (if gdb-main-file
551      (setq gdb-main-file (expand-file-name gdb-main-file gdb-cdir)))
552
553  (if gdb-many-windows
554      (gdb-setup-windows)
555    (gdb-get-create-buffer 'gdb-breakpoints-buffer)
556    (when gdb-show-main
557      (switch-to-buffer gud-comint-buffer)
558      (delete-other-windows)
559      (split-window)
560      (other-window 1)
561      (switch-to-buffer
562       (if gdb-view-source
563	   (gud-find-file gdb-main-file)
564	 (gdb-get-create-buffer 'gdb-assembler-buffer)))
565      (other-window 1))))
566
567(provide 'gdb-mi)
568;;; gdbmi.el ends here
569