From aeea8b774057c96bec4973d7bd582226e204ef56 Mon Sep 17 00:00:00 2001 From: Nick Roberts Date: Tue, 25 May 2004 20:03:05 +0000 Subject: [PATCH] New file. --- gdb/gdb-mi.el | 568 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 568 insertions(+) create mode 100644 gdb/gdb-mi.el diff --git a/gdb/gdb-mi.el b/gdb/gdb-mi.el new file mode 100644 index 0000000000..8780e8aa4a --- /dev/null +++ b/gdb/gdb-mi.el @@ -0,0 +1,568 @@ +;;; 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 +;; Maintainer: Nick Roberts +;; 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 -- 2.34.1