| ;;; gdb-mi.el (internally gdbmi6.el) - (24th May 2004) |
| |
| ;; Run gdb with GDB/MI (-interp=mi) and access CLI using "cli-command" |
| ;; (could use "-interpreter-exec console cli-command") |
| |
| ;; Author: Nick Roberts <nickrob@gnu.org> |
| ;; Maintainer: Nick Roberts <nickrob@gnu.org> |
| ;; Keywords: unix, tools |
| |
| ;; Copyright (C) 2004 Free Software Foundation, Inc. |
| |
| ;; This file is part of GNU GDB. |
| |
| ;; GNU GDB is free software; you can redistribute it and/or modify |
| ;; it under the terms of the GNU General Public License as published by |
| ;; the Free Software Foundation; either version 2, or (at your option) |
| ;; any later version. |
| |
| ;; This program is distributed in the hope that it will be useful, |
| ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| ;; GNU General Public License for more details. |
| |
| ;;; Commentary: |
| |
| ;; This mode acts as a graphical user interface to GDB and requires GDB 6.1 |
| ;; onwards. You can interact with GDB through the GUD buffer in the usual way, |
| ;; but there are also buffers which control the execution and describe the |
| ;; state of your program. It separates the input/output of your program from |
| ;; that of GDB and displays expressions and their current values in their own |
| ;; buffers. It also uses features of Emacs 21 such as the fringe/display |
| ;; margin for breakpoints, and the toolbar (see the GDB Graphical Interface |
| ;; section in the Emacs info manual). |
| |
| ;; Start the debugger with M-x gdbmi. |
| |
| ;; This file uses GDB/MI as the primary interface to GDB. It is still under |
| ;; development and is part of a process to migrate Emacs from annotations |
| ;; (as used in gdb-ui.el) to GDB/MI. |
| |
| ;; Known Bugs: |
| ;; |
| |
| ;;; Code: |
| |
| (require 'gud) |
| (require 'gdb-ui) |
| |
| |
| ;;;###autoload |
| (defun gdbmi (command-line) |
| "Run gdb on program FILE in buffer *gud-FILE*. |
| The directory containing FILE becomes the initial working directory |
| and source-file directory for your debugger. |
| |
| If `gdb-many-windows' is nil (the default value) then gdb just |
| pops up the GUD buffer unless `gdb-show-main' is t. In this case |
| it starts with two windows: one displaying the GUD buffer and the |
| other with the source file with the main routine of the inferior. |
| |
| If `gdb-many-windows' is t, regardless of the value of |
| `gdb-show-main', the layout below will appear. Keybindings are |
| given in relevant buffer. |
| |
| Watch expressions appear in the speedbar/slowbar. |
| |
| The following interactive lisp functions help control operation : |
| |
| `gdb-many-windows' - Toggle the number of windows gdb uses. |
| `gdb-restore-windows' - To restore the window layout. |
| |
| See Info node `(emacs)GDB Graphical Interface' for a more |
| detailed description of this mode. |
| |
| |
| --------------------------------------------------------------------- |
| GDB Toolbar |
| --------------------------------------------------------------------- |
| GUD buffer (I/O of GDB) | Locals buffer |
| | |
| | |
| | |
| --------------------------------------------------------------------- |
| Source buffer | Input/Output (of inferior) buffer |
| | (comint-mode) |
| | |
| | |
| | |
| | |
| | |
| | |
| --------------------------------------------------------------------- |
| Stack buffer | Breakpoints buffer |
| RET gdb-frames-select | SPC gdb-toggle-breakpoint |
| | RET gdb-goto-breakpoint |
| | d gdb-delete-breakpoint |
| --------------------------------------------------------------------- |
| " |
| ;; |
| (interactive (list (gud-query-cmdline 'gdbmi))) |
| ;; |
| ;; Let's start with a basic gud-gdb buffer and then modify it a bit. |
| (gdb command-line) |
| ;; |
| (setq gdb-debug-log nil) |
| (set (make-local-variable 'gud-minor-mode) 'gdbmi) |
| (set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter) |
| ;; |
| (gud-def gud-break (if (not (string-equal mode-name "Machine")) |
| (gud-call "-break-insert %f:%l" arg) |
| (save-excursion |
| (beginning-of-line) |
| (forward-char 2) |
| (gud-call "-break-insert *%a" arg))) |
| "\C-b" "Set breakpoint at current line or address.") |
| ;; |
| (gud-def gud-remove (if (not (string-equal mode-name "Machine")) |
| (gud-call "clear %f:%l" arg) |
| (save-excursion |
| (beginning-of-line) |
| (forward-char 2) |
| (gud-call "clear *%a" arg))) |
| "\C-d" "Remove breakpoint at current line or address.") |
| ;; |
| (gud-def gud-until (if (not (string-equal mode-name "Machine")) |
| (gud-call "until %f:%l" arg) |
| (save-excursion |
| (beginning-of-line) |
| (forward-char 2) |
| (gud-call "until *%a" arg))) |
| "\C-u" "Continue to current line or address.") |
| |
| (define-key gud-minor-mode-map [left-margin mouse-1] |
| 'gdb-mouse-toggle-breakpoint) |
| (define-key gud-minor-mode-map [left-fringe mouse-1] |
| 'gdb-mouse-toggle-breakpoint) |
| |
| (setq comint-input-sender 'gdbmi-send) |
| ;; |
| ;; (re-)initialise |
| (setq gdb-main-file nil) |
| (setq gdb-current-address "main") |
| (setq gdb-previous-address nil) |
| (setq gdb-previous-frame nil) |
| (setq gdb-current-frame "main") |
| (setq gdb-view-source t) |
| (setq gdb-selected-view 'source) |
| (setq gdb-var-list nil) |
| (setq gdb-var-changed nil) |
| (setq gdb-prompting nil) |
| (setq gdb-current-item nil) |
| (setq gdb-pending-triggers nil) |
| (setq gdb-output-sink 'user) |
| (setq gdb-server-prefix nil) |
| ;; |
| (setq gdb-buffer-type 'gdbmi) |
| ;; |
| ;; FIXME: use tty command to separate io. |
| ;;(gdb-clear-inferior-io) |
| ;; |
| (if (eq window-system 'w32) |
| (gdb-enqueue-input (list "-gdb-set new-console off\n" 'ignore))) |
| ;; find source file and compilation directory here |
| (gdb-enqueue-input (list "list main\n" 'ignore)) ; C program |
| (gdb-enqueue-input (list "list MAIN__\n" 'ignore)) ; Fortran program |
| (gdb-enqueue-input (list "info source\n" 'gdbmi-source-info)) |
| ;; |
| (run-hooks 'gdbmi-mode-hook)) |
| |
| ; Force nil till fixed. |
| (defconst gdbmi-use-inferior-io-buffer nil) |
| |
| ; uses --all-values Needs GDB 6.1 onwards. |
| (defun gdbmi-var-list-children (varnum) |
| (gdb-enqueue-input |
| (list (concat "-var-update " varnum "\n") 'ignore)) |
| (gdb-enqueue-input |
| (list (concat "-var-list-children --all-values " |
| varnum "\n") |
| `(lambda () (gdbmi-var-list-children-handler ,varnum))))) |
| |
| (defconst gdbmi-var-list-children-regexp |
| "name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",value=\"\\(.*?\\)\"" |
| ) |
| |
| (defun gdbmi-var-list-children-handler (varnum) |
| (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) |
| (goto-char (point-min)) |
| (let ((var-list nil)) |
| (catch 'child-already-watched |
| (dolist (var gdb-var-list) |
| (if (string-equal varnum (cadr var)) |
| (progn |
| (push var var-list) |
| (while (re-search-forward gdbmi-var-list-children-regexp nil t) |
| (let ((varchild (list (match-string 2) |
| (match-string 1) |
| (match-string 3) |
| nil |
| (match-string 4) |
| nil))) |
| (if (looking-at ",type=\"\\(.*?\\)\"") |
| (setcar (nthcdr 3 varchild) (match-string 1))) |
| (dolist (var1 gdb-var-list) |
| (if (string-equal (cadr var1) (cadr varchild)) |
| (throw 'child-already-watched nil))) |
| (push varchild var-list)))) |
| (push var var-list))) |
| (setq gdb-var-changed t) |
| (setq gdb-var-list (nreverse var-list)))))) |
| |
| ;(defun gdbmi-send (proc string) |
| ; "A comint send filter for gdb." |
| ; (setq gdb-output-sink 'user) |
| ; (setq gdb-prompting nil) |
| ; (process-send-string proc (concat "-interpreter-exec console \"" string "\""))) |
| |
| (defun gdbmi-send (proc string) |
| "A comint send filter for gdb." |
| (setq gdb-output-sink 'user) |
| (setq gdb-prompting nil) |
| (process-send-string proc (concat string "\n"))) |
| |
| (defcustom gud-gdbmi-command-name "~/gdb/gdb/gdb -interp=mi" |
| "Default command to execute an executable under the GDB-UI debugger." |
| :type 'string |
| :group 'gud) |
| |
| (defconst gdb-stopped-regexp |
| "\\((gdb) \n\\*stopped\\|^\\^done\\),reason=.*,file=\"\\(.*\\)\",line=\"\\(.*\\)\".*") |
| |
| (defconst gdb-console-regexp "~\"\\(.*\\)\\\\n\"") |
| |
| (defconst gdb-internals-regexp "&\".*\\n\"\n") |
| |
| (defconst gdb-gdb-regexp "(gdb) \n") |
| |
| (defconst gdb-running-regexp "^\\^running") |
| |
| (defun gdbmi-prompt () |
| "This handler terminates the any collection of output. It also |
| sends the next command (if any) to gdb." |
| (unless gdb-pending-triggers |
| (gdb-get-current-frame) |
| (gdbmi-invalidate-frames) |
| (gdbmi-invalidate-breakpoints) |
| (gdbmi-invalidate-locals) |
| (dolist (frame (frame-list)) |
| (when (string-equal (frame-parameter frame 'name) "Speedbar") |
| (setq gdb-var-changed t) ; force update |
| (dolist (var gdb-var-list) |
| (setcar (nthcdr 5 var) nil)))) |
| (gdb-var-update)) |
| (let ((sink gdb-output-sink)) |
| (when (eq sink 'emacs) |
| (let ((handler |
| (car (cdr gdb-current-item)))) |
| (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) |
| (funcall handler))))) |
| (let ((input (gdb-dequeue-input))) |
| (if input |
| (gdb-send-item input) |
| (progn |
| (setq gud-running nil) |
| (setq gdb-prompting t) |
| (gud-display-frame))))) |
| |
| (defun gud-gdbmi-marker-filter (string) |
| "Filter GDB/MI output." |
| (if gdb-enable-debug-log (push (cons 'recv string) gdb-debug-log)) |
| ;; Recall the left over gud-marker-acc from last time |
| (setq gud-marker-acc (concat gud-marker-acc string)) |
| ;; Start accumulating output for the GUD buffer |
| (let ((output "")) |
| |
| (if (string-match gdb-running-regexp gud-marker-acc) |
| (setq gud-marker-acc (substring gud-marker-acc (match-end 0)) |
| gud-running t)) |
| |
| ;; Remove the trimmings from the console stream. |
| (while (string-match gdb-console-regexp gud-marker-acc) |
| (setq |
| gud-marker-acc (concat (substring gud-marker-acc 0 (match-beginning 0)) |
| (match-string 1 gud-marker-acc) |
| (substring gud-marker-acc (match-end 0))))) |
| |
| ;; Remove log stream containing debugging messages being produced by GDB's |
| ;; internals. |
| (while (string-match gdb-internals-regexp gud-marker-acc) |
| (setq |
| gud-marker-acc (concat (substring gud-marker-acc 0 (match-beginning 0)) |
| (substring gud-marker-acc (match-end 0))))) |
| |
| (if (string-match gdb-stopped-regexp gud-marker-acc) |
| (setq |
| |
| ;; Extract the frame position from the marker. |
| gud-last-frame (cons (match-string 2 gud-marker-acc) |
| (string-to-int (match-string 3 gud-marker-acc))) |
| |
| ;; Append any text before the marker to the output we're going |
| ;; to return - we don't include the marker in this text. |
| output (gdbmi-concat-output output |
| (substring gud-marker-acc 0 (match-beginning 0))) |
| |
| ;; Set the accumulator to the remaining text. |
| gud-marker-acc (substring gud-marker-acc (match-end 0)))) |
| |
| (while (string-match gdb-gdb-regexp gud-marker-acc) |
| (setq |
| |
| ;; Append any text up to and including prompt less \n to the output. |
| output (gdbmi-concat-output output |
| (substring gud-marker-acc 0 (- (match-end 0) 1))) |
| |
| ;; Set the accumulator to the remaining text. |
| gud-marker-acc (substring gud-marker-acc (match-end 0))) |
| (gdbmi-prompt)) |
| |
| (setq output (gdbmi-concat-output output gud-marker-acc)) |
| (setq gud-marker-acc "") |
| output)) |
| |
| (defun gdbmi-concat-output (so-far new) |
| (let ((sink gdb-output-sink)) |
| (cond |
| ((eq sink 'user) (concat so-far new)) |
| ((eq sink 'emacs) |
| (gdb-append-to-partial-output new) |
| so-far) |
| ((eq sink 'inferior) |
| (gdb-append-to-inferior-io new) |
| so-far)))) |
| |
| |
| ;; Breakpoint buffer : This displays the output of `-break-list'. |
| ;; |
| (def-gdb-auto-updated-buffer gdb-breakpoints-buffer |
| ;; This defines the auto update rule for buffers of type |
| ;; `gdb-breakpoints-buffer'. |
| ;; |
| ;; It defines a function that queues the command below. That function is |
| ;; called: |
| gdbmi-invalidate-breakpoints |
| ;; |
| ;; To update the buffer, this command is sent to gdb. |
| "-break-list\n" |
| ;; |
| ;; This also defines a function to be the handler for the output |
| ;; from the command above. That function will copy the output into |
| ;; the appropriately typed buffer. That function will be called: |
| gdb-break-list-handler |
| ;; buffer specific functions |
| gdb-break-list-custom) |
| |
| (defconst gdb-break-list-regexp |
| "number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"") |
| |
| (defun gdb-break-list-handler () |
| (setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints |
| gdb-pending-triggers)) |
| (let ((breakpoint nil) |
| (breakpoints-list nil)) |
| (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) |
| (goto-char (point-min)) |
| (while (re-search-forward gdb-break-list-regexp nil t) |
| (let ((breakpoint (list (match-string 1) |
| (match-string 2) |
| (match-string 3) |
| (match-string 4) |
| (match-string 5) |
| (match-string 6) |
| (match-string 7) |
| (match-string 8)))) |
| (push breakpoint breakpoints-list)))) |
| (let ((buf (gdb-get-buffer 'gdb-breakpoints-buffer))) |
| (and buf (with-current-buffer buf |
| (let ((p (point)) |
| (buffer-read-only nil)) |
| (erase-buffer) |
| (insert "Num Type Disp Enb Func\tFile:Line\tAddr\n") |
| (dolist (breakpoint breakpoints-list) |
| (insert (concat |
| (nth 0 breakpoint) " " |
| (nth 1 breakpoint) " " |
| (nth 2 breakpoint) " " |
| (nth 3 breakpoint) " " |
| (nth 5 breakpoint) "\t" |
| (nth 6 breakpoint) ":" (nth 7 breakpoint) "\t" |
| (nth 4 breakpoint) "\n"))) |
| (goto-char p)))))) |
| (gdb-break-list-custom)) |
| |
| ;;-put breakpoint icons in relevant margins (even those set in the GUD buffer) |
| (defun gdb-break-list-custom () |
| (let ((flag)(address)) |
| ;; |
| ;; remove all breakpoint-icons in source buffers but not assembler buffer |
| (dolist (buffer (buffer-list)) |
| (with-current-buffer buffer |
| (if (and (eq gud-minor-mode 'gdbmi) |
| (not (string-match "\\`\\*.+\\*\\'" (buffer-name)))) |
| (gdb-remove-breakpoint-icons (point-min) (point-max))))) |
| (with-current-buffer (gdb-get-buffer 'gdb-breakpoints-buffer) |
| (save-excursion |
| (goto-char (point-min)) |
| (while (< (point) (- (point-max) 1)) |
| (forward-line 1) |
| (if (looking-at "[0-9]*\\s-*\\S-*\\s-*\\S-*\\s-*\\(.\\)\\s-*\\S-*\\s-*\\(\\S-*\\):\\([0-9]+\\)") |
| (progn |
| (setq flag (char-after (match-beginning 1))) |
| (let ((line (match-string 3)) (buffer-read-only nil) |
| (file (match-string 2))) |
| (add-text-properties (point-at-bol) (point-at-eol) |
| '(mouse-face highlight |
| help-echo "mouse-2, RET: visit breakpoint")) |
| (with-current-buffer |
| (find-file-noselect |
| (if (file-exists-p file) file |
| (expand-file-name file gdb-cdir))) |
| (save-current-buffer |
| (set (make-local-variable 'gud-minor-mode) 'gdbmi) |
| (set (make-local-variable 'tool-bar-map) |
| gud-tool-bar-map)) |
| ;; only want one breakpoint icon at each location |
| (save-excursion |
| (goto-line (string-to-number line)) |
| (gdb-put-breakpoint-icon (eq flag ?y))))))))) |
| (end-of-line))) |
| (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-custom))) |
| |
| ;; Frames buffer. This displays a perpetually correct bactrack trace. |
| ;; |
| (def-gdb-auto-updated-buffer gdb-stack-buffer |
| gdbmi-invalidate-frames |
| "-stack-list-frames\n" |
| gdb-stack-list-frames-handler |
| gdb-stack-list-frames-custom) |
| |
| (defconst gdb-stack-list-frames-regexp |
| "level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"") |
| |
| (defun gdb-stack-list-frames-handler () |
| (setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames |
| gdb-pending-triggers)) |
| (let ((frame nil) |
| (call-stack nil)) |
| (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) |
| (goto-char (point-min)) |
| (while (re-search-forward gdb-stack-list-frames-regexp nil t) |
| (let ((frame (list (match-string 1) |
| (match-string 2) |
| (match-string 3) |
| (match-string 4) |
| (match-string 5)))) |
| (push frame call-stack)))) |
| (let ((buf (gdb-get-buffer 'gdb-stack-buffer))) |
| (and buf (with-current-buffer buf |
| (let ((p (point)) |
| (buffer-read-only nil)) |
| (erase-buffer) |
| (insert "Level\tFunc\tFile:Line\tAddr\n") |
| (dolist (frame (nreverse call-stack)) |
| (insert (concat |
| (nth 0 frame) "\t" |
| (nth 2 frame) "\t" |
| (nth 3 frame) ":" (nth 4 frame) "\t" |
| (nth 1 frame) "\n"))) |
| (goto-char p)))))) |
| (gdb-stack-list-frames-custom)) |
| |
| (defun gdb-stack-list-frames-custom () |
| (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer) |
| (save-excursion |
| (let ((buffer-read-only nil)) |
| (goto-char (point-min)) |
| (forward-line 1) |
| (while (< (point) (point-max)) |
| (add-text-properties (point-at-bol) (point-at-eol) |
| '(mouse-face highlight |
| help-echo "mouse-2, RET: Select frame")) |
| (beginning-of-line) |
| (when (and (or (looking-at "^#[0-9]*\\s-*\\S-* in \\(\\S-*\\)") |
| (looking-at "^#[0-9]*\\s-*\\(\\S-*\\)")) |
| (equal (match-string 1) gdb-current-frame)) |
| (put-text-property (point-at-bol) (point-at-eol) |
| 'face '(:inverse-video t))) |
| (forward-line 1)))))) |
| |
| ;; Locals buffer. |
| ;; uses "-stack-list-locals 2". Needs GDB 6.1 onwards. |
| (def-gdb-auto-updated-buffer gdb-locals-buffer |
| gdbmi-invalidate-locals |
| "-stack-list-locals 2\n" |
| gdb-stack-list-locals-handler |
| gdb-stack-list-locals-custom) |
| |
| (defconst gdb-stack-list-locals-regexp |
| (concat "name=\"\\(.*?\\)\",type=\"\\(.*?\\)\"")) |
| |
| ;; Dont display values of arrays or structures. |
| ;; These can be expanded using gud-watch. |
| (defun gdb-stack-list-locals-handler nil |
| (setq gdb-pending-triggers (delq 'gdbmi-invalidate-locals |
| gdb-pending-triggers)) |
| (let ((local nil) |
| (locals-list nil)) |
| (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) |
| (goto-char (point-min)) |
| (while (re-search-forward gdb-stack-list-locals-regexp nil t) |
| (let ((local (list (match-string 1) |
| (match-string 2) |
| nil))) |
| (if (looking-at ",value=\"\\(.*?\\)\"") |
| (setcar (nthcdr 2 local) (match-string 1))) |
| (push local locals-list)))) |
| (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) |
| (and buf (with-current-buffer buf |
| (let ((p (point)) |
| (buffer-read-only nil)) |
| (erase-buffer) |
| (dolist (local locals-list) |
| (insert |
| (concat (car local) "\t" (nth 1 local) "\t" |
| (or (nth 2 local) |
| (if (string-match "struct" (nth 1 local)) |
| "(structure)" |
| "(array)")) |
| "\n"))) |
| (goto-char p))))))) |
| |
| (defun gdb-stack-list-locals-custom () |
| nil) |
| |
| (defun gdbmi-source-info () |
| "Find the source file where the program starts and displays it with related |
| buffers." |
| (goto-char (point-min)) |
| (if (search-forward "source file is " nil t) |
| (if (looking-at "\\S-*") |
| (setq gdb-main-file (match-string 0))) |
| (setq gdb-view-source nil)) |
| (if (search-forward "directory is " nil t) |
| (if (looking-at "\\S-*:\\(\\S-*\\)") |
| (setq gdb-cdir (match-string 1)) |
| (looking-at "\\S-*") |
| (setq gdb-cdir (match-string 0)))) |
| |
| ;temporary heuristic |
| (if gdb-main-file |
| (setq gdb-main-file (expand-file-name gdb-main-file gdb-cdir))) |
| |
| (if gdb-many-windows |
| (gdb-setup-windows) |
| (gdb-get-create-buffer 'gdb-breakpoints-buffer) |
| (when gdb-show-main |
| (switch-to-buffer gud-comint-buffer) |
| (delete-other-windows) |
| (split-window) |
| (other-window 1) |
| (switch-to-buffer |
| (if gdb-view-source |
| (gud-find-file gdb-main-file) |
| (gdb-get-create-buffer 'gdb-assembler-buffer))) |
| (other-window 1)))) |
| |
| (provide 'gdb-mi) |
| ;;; gdbmi.el ends here |