OpenE2K/binutils-gdb
12
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
57f6e0bcfb
binutils-gdb/gdb/mi/gdb-mi.el
Joel Brobecker 0fb0cc7590 Updated copyright notices for most files.
2009-01-03 05:58:08 +00:00

610 lines
22 KiB
EmacsLisp
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; gdb-mi.el
;; Author: Nick Roberts <nickrob@gnu.org>
;; Maintainer: Nick Roberts <nickrob@gnu.org>
;; Keywords: unix, tools
;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009
;; 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 works with Emacs
;; 22.x and the version of GDB with which it is distributed. 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. It runs gdb with GDB/MI (-interp=mi) and
;; access CLI using "-interpreter-exec console cli-command".
;; This mode acts on top of gdb-ui.el. After the release of 22.1,
;; mainline Emacs in the CVS repository will have a file also called gdb-mi.el
;; which will *replace* gdb-ui.el. If you are interested in developing
;; this mode you should get this version.
;;
;; Known Bugs:
;;
;; 1) To handle program input, if required, and to avoid extra output in the
;; GUD buffer you must not use run, step, next or continue etc but their MI
;; counterparts through gud-run, gud-step etc, e.g clicking on the appropriate
;; icon in the toolbar.
;; 2) Some commands send extra prompts to the GUD buffer.
;; 3) Doesn't list catchpoints in breakpoints buffer.
;;
;; TODO:
;; 1) Prefix MI commands with a token instead of queueing commands.
;; 2) Use MI command -data-read-memory for memory window.
;; 3) Use MI command -data-disassemble for disassembly window.
;; 4) Allow separate buffers for Inferior IO and GDB IO.
;; 5) Watch windows to work with threads.
;;
;;; Code:
(require 'gud)
(require 'gdb-ui)
(defvar gdb-last-command nil)
(defvar gdb-prompt-name nil)
;;;###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 commands 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 |
| |
| |
| |
| |
| |
| |
| |
+-------------------------------+------------------------------+
| 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-ring nil)
(set (make-local-variable 'gud-minor-mode) 'gdbmi)
(set (make-local-variable 'gud-marker-filter) 'gud-gdbmi-marker-filter)
;;
(gud-def gud-step "-exec-step %p" "\C-s"
"Step one source line with display.")
(gud-def gud-stepi "-exec-step-instruction %p" "\C-i"
"Step one instruction with display.")
(gud-def gud-next "-exec-next %p" "\C-n"
"Step one line (skip functions).")
(gud-def gud-cont "-exec-continue" "\C-r"
"Continue with display.")
(gud-def gud-finish "-exec-finish" "\C-f"
"Finish executing current function.")
(gud-def gud-run "-exec-run" nil "Run the program.")
(gud-def gud-break (if (not (string-equal mode-name "Machine"))
(gud-call "break %f:%l" arg)
(save-excursion
(beginning-of-line)
(forward-char 2)
(gud-call "break *%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 "-exec-until %f:%l" arg)
(save-excursion
(beginning-of-line)
(forward-char 2)
(gud-call "-exec-until *%a" arg)))
"\C-u" "Continue to current line or address.")
(define-key gud-minor-mode-map [left-margin mouse-1]
'gdb-mouse-set-clear-breakpoint)
(define-key gud-minor-mode-map [left-fringe mouse-1]
'gdb-mouse-set-clear-breakpoint)
(define-key gud-minor-mode-map [left-fringe mouse-2]
'gdb-mouse-until)
(define-key gud-minor-mode-map [left-fringe drag-mouse-1]
'gdb-mouse-until)
(define-key gud-minor-mode-map [left-margin mouse-3]
'gdb-mouse-toggle-breakpoint-margin)
(define-key gud-minor-mode-map [left-fringe mouse-3]
'gdb-mouse-toggle-breakpoint-fringe)
(setq comint-input-sender 'gdbmi-send)
;;
;; (re-)initialise
(setq gdb-pc-address (if gdb-show-main "main" nil)
gdb-previous-frame-address nil
gdb-memory-address "main"
gdb-previous-frame nil
gdb-selected-frame nil
gdb-frame-number nil
gdb-var-list nil
gdb-prompting nil
gdb-input-queue nil
gdb-current-item nil
gdb-pending-triggers nil
gdb-output-sink 'user
gdb-server-prefix nil
gdb-flush-pending-output nil
gdb-location-alist nil
gdb-source-file-list nil
gdb-last-command nil
gdb-prompt-name nil
gdb-buffer-fringe-width (car (window-fringes)))
gdb-debug-ring nil
gdb-source-window nil
gdb-inferior-status nil
gdb-continuation 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)))
(gdb-enqueue-input (list "-gdb-set height 0\n" 'ignore))
;; find source file and compilation directory here
(gdb-enqueue-input
; Needs GDB 6.2 onwards.
(list "-file-list-exec-source-files\n"
'gdb-set-gud-minor-mode-existing-buffers-1))
(gdb-enqueue-input
; Needs GDB 6.0 onwards.
(list "-file-list-exec-source-file\n" 'gdb-get-source-file))
(gdb-enqueue-input
(list "-data-list-register-names\n" 'gdb-get-register-names))
(gdb-enqueue-input
(list "-gdb-show prompt\n" 'gdb-get-prompt))
;;
(setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2)
(run-hooks 'gdbmi-mode-hook))
(defun gdbmi-send (proc string)
"A comint send filter for gdb."
(if gud-running
(process-send-string proc (concat string "\n"))
(with-current-buffer gud-comint-buffer
(let ((inhibit-read-only t))
(remove-text-properties (point-min) (point-max) '(face))))
(setq gdb-output-sink 'user)
(setq gdb-prompting nil)
;; mimic <RET> key to repeat previous command in GDB
(if (not (string-match "^\\s+$" string))
(setq gdb-last-command string)
(if gdb-last-command (setq string gdb-last-command)))
(if gdb-enable-debug
(push (cons 'mi-send (concat string "\n")) gdb-debug-ring))
(if (string-match "^-" string)
;; MI command
(process-send-string proc (concat string "\n"))
;; CLI command
(if (string-match "\\\\$" string)
(setq gdb-continuation (concat gdb-continuation string "\n"))
(process-send-string proc
(concat "-interpreter-exec console \""
gdb-continuation string "\"\n"))
(setq gdb-continuation nil)))))
(defcustom gud-gdbmi-command-name "gdb -interp=mi"
"Default command to execute an executable under the GDB-UI debugger."
:type 'string
:group 'gud)
(defconst gdb-gdb-regexp "(gdb) \n")
(defconst gdb-running-regexp (concat "\\^running\n" gdb-gdb-regexp))
;; fullname added GDB 6.4+.
;; Probably not needed. -stack-info-frame computes filename and line.
(defconst gdb-stopped-regexp
"\\*stopped,reason=.*?,file=\".*?\"\
,fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"}\n")
(defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)\n")
(defconst gdb-done-regexp "\\^done,*\n*")
(defconst gdb-console-regexp "~\\(\".*?[^\\]\"\\)\n")
(defconst gdb-internals-regexp "&\\(\".*?\\n\"\\)\n")
(defun gdbmi-prompt1 ()
"Queue any GDB commands that the user interface needs."
(unless gdb-pending-triggers
(gdbmi-get-selected-frame)
(gdbmi-invalidate-frames)
(gdbmi-invalidate-breakpoints)
(gdb-get-changed-registers)
(gdb-invalidate-registers-1)
(gdb-invalidate-locals-1)
(if (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
(gdb-var-update-1))))
(defun gdbmi-prompt2 ()
"Handle any output and send next GDB command."
(let ((sink gdb-output-sink))
(when (eq sink 'emacs)
(let ((handler
(car (cdr gdb-current-item))))
(with-current-buffer (gdb-get-buffer-create '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-flush-pending-output
nil
(if gdb-enable-debug (push (cons 'recv (list string gdb-output-sink))
gdb-debug-ring))
;; 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 "") running)
(if (string-match gdb-running-regexp gud-marker-acc)
(setq
gud-marker-acc
(concat (substring gud-marker-acc 0 (match-beginning 0))
(substring gud-marker-acc (match-end 0)))
running t))
(if (string-match gdb-stopped-regexp gud-marker-acc)
(setq
;; Extract the frame position from the marker.
gud-last-frame (cons (match-string 1 gud-marker-acc)
(string-to-number
(match-string 2 gud-marker-acc)))
gud-marker-acc
(concat (substring gud-marker-acc 0 (match-beginning 0))
(substring gud-marker-acc (match-end 0)))))
;; Filter error messages going to GUD buffer and
;; display in minibuffer.
(when (eq gdb-output-sink 'user)
(while (string-match gdb-error-regexp gud-marker-acc)
(message (read (match-string 1 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-done-regexp gud-marker-acc)
(setq
gud-marker-acc
(concat (substring gud-marker-acc 0 (match-beginning 0))
(substring gud-marker-acc (match-end 0))))))
(when (string-match gdb-gdb-regexp gud-marker-acc)
(setq
gud-marker-acc
(concat (substring gud-marker-acc 0 (match-beginning 0))
(substring gud-marker-acc (match-end 0))))
;; 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))
(read (match-string 1 gud-marker-acc))
(substring gud-marker-acc (match-end 0)))))
;; Remove the trimmings from log stream containing debugging messages
;; being produced by GDB's internals and use warning face.
(while (string-match gdb-internals-regexp gud-marker-acc)
(setq
gud-marker-acc
(concat (substring gud-marker-acc 0 (match-beginning 0))
(let ((error-message
(read (match-string 1 gud-marker-acc))))
(put-text-property
0 (length error-message)
'face font-lock-warning-face
error-message)
error-message)
(substring gud-marker-acc (match-end 0)))))
(setq output (gdbmi-concat-output output gud-marker-acc))
(setq gud-marker-acc "")
(gdbmi-prompt1)
(unless gdb-input-queue
(setq output (concat output gdb-prompt-name)))
(gdbmi-prompt2)
(setq gud-running running))
(when gud-running
(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-update-trigger gdbmi-invalidate-breakpoints
(gdb-get-buffer 'gdb-breakpoints-buffer)
"-break-list\n"
gdb-break-list-handler)
(defconst gdb-break-list-regexp
"bkpt={.*?number=\"\\(.*?\\)\",.*?type=\"\\(.*?\\)\",.*?disp=\"\\(.*?\\)\",.*?\
enabled=\"\\(.\\)\",.*?addr=\"\\(.*?\\)\",\\(?:.*?func=\"\\(.*?\\)\",.*?\
file=\"\\(.*?\\)\",.*?fullname=\".*?\",.*?line=\"\\(.*?\\)\",\
\\|\\(?:.*?what=\"\\(.*?\\)\",\\)*\\).*?times=\"\\(.*?\\)\".*?}")
(defun gdb-break-list-handler ()
(setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints
gdb-pending-triggers))
(let ((breakpoint) (breakpoints-list))
(with-current-buffer (gdb-get-buffer-create '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)
(match-string 9)
(match-string 10))))
(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 Hits Addr What\n")
(dolist (breakpoint breakpoints-list)
(insert
(concat
(nth 0 breakpoint) " "
(nth 1 breakpoint) " "
(nth 2 breakpoint) " "
(nth 3 breakpoint) " "
(nth 9 breakpoint) " "
(nth 4 breakpoint) " "
(if (nth 5 breakpoint)
(concat "in " (nth 5 breakpoint) " at " (nth 6 breakpoint) ":" (nth 7 breakpoint) "\n")
(concat (nth 8 breakpoint) "\n")))))
(goto-char p))))))
(gdb-info-breakpoints-custom))
(defun gdbmi-get-location (bptno line flag)
"Find the directory containing the relevant source file.
Put in buffer and place breakpoint icon."
(goto-char (point-min))
(catch 'file-not-found
(if (re-search-forward gdb-source-file-regexp-1 nil t)
(delete (cons bptno "File not found") gdb-location-alist)
(push (cons bptno (match-string 1)) gdb-location-alist)
(gdb-resync)
(unless (assoc bptno gdb-location-alist)
(push (cons bptno "File not found") gdb-location-alist)
(message-box "Cannot find source file for breakpoint location.
Add directory to search path for source files using the GDB command, dir."))
(throw 'file-not-found nil))
(with-current-buffer
(find-file-noselect (match-string 1))
(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) bptno)))))
;; Frames buffer. This displays a perpetually correct bactrack trace.
;;
(def-gdb-auto-update-trigger gdbmi-invalidate-frames
(gdb-get-buffer 'gdb-stack-buffer)
"-stack-list-frames\n"
gdb-stack-list-frames-handler)
(defconst gdb-stack-list-frames-regexp
"{.*?level=\"\\(.*?\\)\",.*?addr=\"\\(.*?\\)\",.*?func=\"\\(.*?\\)\",\
\\(?:.*?file=\".*?\",.*?fullname=\"\\(.*?\\)\",.*?line=\"\\(.*?\\)\".*?}\\|\
from=\"\\(.*?\\)\"\\)")
(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-buffer-create '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)
(match-string 6))))
(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\tAddr\tFunc\tFile:Line\n")
(dolist (frame (nreverse call-stack))
(insert
(concat
(nth 0 frame) "\t"
(nth 1 frame) "\t"
(propertize (nth 2 frame)
'face font-lock-function-name-face) "\t"
(if (nth 3 frame)
(concat "at "(nth 3 frame) ":" (nth 4 frame) "\n")
(concat "from " (nth 5 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 (looking-at "^[0-9]+\\s-+\\(\\S-+\\)")
(equal (match-string 1) gdb-selected-frame))
(put-text-property (point-at-bol) (point-at-eol)
'face '(:inverse-video t)))
(forward-line 1))))))
;; gdb-ui.el uses "info source" to find out if macro information is present.
(defun gdb-get-source-file ()
"Find the source file where the program starts and display it with related
buffers, if required."
(goto-char (point-min))
(if (re-search-forward gdb-source-file-regexp-1 nil t)
(setq gdb-main-file (match-string 1)))
(if gdb-many-windows
(gdb-setup-windows)
(gdb-get-buffer-create 'gdb-breakpoints-buffer)
(if gdb-show-main
(let ((pop-up-windows t))
(display-buffer (gud-find-file gdb-main-file))))))
(defun gdbmi-get-selected-frame ()
(if (not (member 'gdbmi-get-selected-frame gdb-pending-triggers))
(progn
(gdb-enqueue-input
(list "-stack-info-frame\n" 'gdbmi-frame-handler))
(push 'gdbmi-get-selected-frame
gdb-pending-triggers))))
(defun gdbmi-frame-handler ()
(setq gdb-pending-triggers
(delq 'gdbmi-get-selected-frame gdb-pending-triggers))
(with-current-buffer (gdb-get-buffer-create 'gdb-partial-output-buffer)
(goto-char (point-min))
(when (re-search-forward gdb-stack-list-frames-regexp nil t)
(setq gdb-frame-number (match-string 1))
(setq gdb-pc-address (match-string 2))
(setq gdb-selected-frame (match-string 3))
(when (match-string 4)
(setq gud-last-frame
(cons (match-string 4) (string-to-number (match-string 5))))
(gud-display-frame)
(if gud-overlay-arrow-position
(let ((buffer (marker-buffer gud-overlay-arrow-position))
(position (marker-position gud-overlay-arrow-position)))
(when buffer
(with-current-buffer buffer
(setq fringe-indicator-alist
(if (string-equal gdb-frame-number "0")
nil
'((overlay-arrow . hollow-right-triangle))))
(setq gud-overlay-arrow-position (make-marker))
(set-marker gud-overlay-arrow-position position))))))
(if (gdb-get-buffer 'gdb-locals-buffer)
(with-current-buffer (gdb-get-buffer 'gdb-locals-buffer)
(setq mode-name (concat "Locals:" gdb-selected-frame))))
(if (gdb-get-buffer 'gdb-assembler-buffer)
(with-current-buffer (gdb-get-buffer 'gdb-assembler-buffer)
(setq mode-name (concat "Machine:" gdb-selected-frame)))))))
(defvar gdb-prompt-name-regexp "value=\"\\(.*?\\)\"")
(defun gdb-get-prompt ()
"Find prompt for GDB session."
(goto-char (point-min))
(setq gdb-prompt-name nil)
(re-search-forward gdb-prompt-name-regexp nil t)
(setq gdb-prompt-name (match-string 1)))
(provide 'gdb-mi)
;;; gdbmi.el ends here
Reference in New Issue View Git Blame Copy Permalink