old-cross-binutils/gdb/mi/gdb-mi.el

569 lines
19 KiB
EmacsLisp
Raw Normal View History

2004-05-25 20:03:05 +00:00
;;; 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