diff options
| -rw-r--r-- | gdb/mi/gdb-mi.el | 636 |
1 files changed, 448 insertions, 188 deletions
diff --git a/gdb/mi/gdb-mi.el b/gdb/mi/gdb-mi.el index 8780e8a..ce6411c 100644 --- a/gdb/mi/gdb-mi.el +++ b/gdb/mi/gdb-mi.el @@ -1,13 +1,10 @@ -;;; 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") +;;; gdb-mi.el ;; Author: Nick Roberts <nickrob@gnu.org> ;; Maintainer: Nick Roberts <nickrob@gnu.org> ;; Keywords: unix, tools -;; Copyright (C) 2004 Free Software Foundation, Inc. +;; Copyright (C) 2004, 2005 Free Software Foundation, Inc. ;; This file is part of GNU GDB. @@ -23,29 +20,49 @@ ;;; 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). +;; 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. - +;; 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". +;; ;; 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. +;; +;; 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-register-names nil "List of register names.") +(defvar gdb-changed-registers nil + "List of changed register numbers (strings).") +(defvar gdb-last-command nil) +(defvar gdb-prompt-name nil) ;;;###autoload (defun gdbmi (command-line) @@ -106,12 +123,23 @@ GUD buffer (I/O of GDB) | Locals buffer (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-insert %f:%l" arg) + (gud-call "break %f:%l" arg) (save-excursion (beginning-of-line) (forward-char 2) - (gud-call "-break-insert *%a" arg))) + (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")) @@ -123,35 +151,43 @@ GUD buffer (I/O of GDB) | Locals buffer "\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) + (gud-call "-exec-until %f:%l" arg) (save-excursion (beginning-of-line) (forward-char 2) - (gud-call "until *%a" arg))) + (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-toggle-breakpoint) + '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-margin mouse-3] '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-frame-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-var-changed 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-find-file-unhook nil + gdb-source-file-list nil + gdb-last-command nil + gdb-prompt-name nil) ;; (setq gdb-buffer-type 'gdbmi) ;; @@ -160,28 +196,34 @@ GUD buffer (I/O of GDB) | Locals buffer ;; (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 (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)) + (gdb-enqueue-input + ; Needs GDB 6.2 onwards. + (list "-file-list-exec-source-files\n" 'gdb-get-source-file-list)) + (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)) ;; (run-hooks 'gdbmi-mode-hook)) ; Force nil till fixed. (defconst gdbmi-use-inferior-io-buffer nil) -; uses --all-values Needs GDB 6.1 onwards. +; Uses "-var-list-children --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=\"\\(.*?\\)\"" -) +"name=\"\\(.*?\\)\",exp=\"\\(.*?\\)\",numchild=\"\\(.*?\\)\",\ +value=\"\\(.*?\\)\"") (defun gdbmi-var-list-children-handler (varnum) (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) @@ -208,49 +250,93 @@ GUD buffer (I/O of GDB) | Locals buffer (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 "\""))) +; Uses "-var-update --all-values". Needs CVS GDB (6.4+). +(defun gdbmi-var-update () + (gdb-enqueue-input + (list "-var-update --all-values *\n" 'gdbmi-var-update-handler))) + +(defconst gdbmi-var-update-regexp "name=\"\\(.*?\\)\",value=\"\\(.*?\\)\"") + +(defun gdbmi-var-update-handler () + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (goto-char (point-min)) + (while (re-search-forward gdbmi-var-update-regexp nil t) + (let ((varnum (match-string 1))) + (catch 'var-found1 + (let ((num 0)) + (dolist (var gdb-var-list) + (if (string-equal varnum (cadr var)) + (progn + (setcar (nthcdr 5 var) t) + (setcar (nthcdr 4 var) (match-string 2)) + (setcar (nthcdr num gdb-var-list) var) + (throw 'var-found1 nil))) + (setq num (+ num 1)))))) + (setq gdb-var-changed t)))) + (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" + (if gud-running + (process-send-string proc (concat string "\n")) + (with-current-buffer gud-comint-buffer + (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 (string-match "\\S+" string) + (setq gdb-last-command string) + (if gdb-last-command (setq string gdb-last-command))) + (if gdb-enable-debug-log + (push (cons 'mi-send (concat string "\n")) gdb-debug-log)) + (process-send-string + proc + (if (string-match "^-" string) + ;; MI command + (concat string "\n") + ;; CLI command + (concat "-interpreter-exec console \"" string "\"\n"))))) + +(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-stopped-regexp - "\\((gdb) \n\\*stopped\\|^\\^done\\),reason=.*,file=\"\\(.*\\)\",line=\"\\(.*\\)\".*") +(defconst gdb-gdb-regexp "(gdb) \n") -(defconst gdb-console-regexp "~\"\\(.*\\)\\\\n\"") +(defconst gdb-running-regexp (concat "\\^running\n" gdb-gdb-regexp)) -(defconst gdb-internals-regexp "&\".*\\n\"\n") +;; 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-gdb-regexp "(gdb) \n") +(defconst gdb-error-regexp "\\^error,msg=\\(\".+\"\\)\n") + +(defconst gdb-done-regexp "\\^done,*\n*") -(defconst gdb-running-regexp "^\\^running") +(defconst gdb-console-regexp "~\\(\".*?[^\\]\"\\)\n") -(defun gdbmi-prompt () - "This handler terminates the any collection of output. It also - sends the next command (if any) to gdb." +(defconst gdb-internals-regexp "&\\(\".*?\\n\"\\)\n") + +(defun gdbmi-prompt1 () + "Queue any GDB commands that the user interface needs." (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)) + (when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)) + (setq gdb-var-changed t) ; force update + (dolist (var gdb-var-list) + (setcar (nthcdr 5 var) nil)) + (gdbmi-var-update)) + (gdbmi-get-selected-frame) + (gdbmi-invalidate-frames) + (gdbmi-invalidate-breakpoints) + (gdb-get-changed-registers) + (gdbmi-invalidate-registers) + (gdbmi-invalidate-locals))) + +(defun gdbmi-prompt2 () + "Handle any output and send next GDB command." (let ((sink gdb-output-sink)) (when (eq sink 'emacs) (let ((handler @@ -267,59 +353,91 @@ GUD buffer (I/O of GDB) | Locals buffer (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)) + (if gdb-flush-pending-output + nil + (if gdb-enable-debug-log (push (cons 'recv (list string gdb-output-sink)) + 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 + (concat (substring gud-marker-acc 0 (match-beginning 0)) + (substring gud-marker-acc (match-end 0))) + gud-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. + (if (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)) + + (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)) @@ -354,13 +472,13 @@ GUD buffer (I/O of GDB) | Locals buffer gdb-break-list-custom) (defconst gdb-break-list-regexp -"number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"") +"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)) + (let ((breakpoint) (breakpoints-list)) (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) @@ -393,7 +511,7 @@ GUD buffer (I/O of GDB) | Locals buffer ;;-put breakpoint icons in relevant margins (even those set in the GUD buffer) (defun gdb-break-list-custom () - (let ((flag)(address)) + (let ((flag) (bptno)) ;; ;; remove all breakpoint-icons in source buffers but not assembler buffer (dolist (buffer (buffer-list)) @@ -406,29 +524,65 @@ GUD buffer (I/O of GDB) | Locals buffer (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]+\\)") + (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))) + (setq bptno (match-string 1)) + (setq flag (char-after (match-beginning 2))) + (let ((line (match-string 4)) (buffer-read-only nil) + (file (match-string 3))) (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))) + '(mouse-face highlight + help-echo "mouse-2, RET: visit breakpoint")) + (unless (file-exists-p file) + (setq file (cdr (assoc bptno gdb-location-alist)))) + (if (and file + (not (string-equal file "File not found"))) + (with-current-buffer (find-file-noselect file) + (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))) + (gdb-enqueue-input + (list (concat "list " + (match-string-no-properties 3) ":1\n") + 'ignore)) + (gdb-enqueue-input + (list "-file-list-exec-source-file\n" + `(lambda () (gdbmi-get-location + ,bptno ,line ,flag)))))))))) + (end-of-line))) (if (gdb-get-buffer 'gdb-assembler-buffer) (gdb-assembler-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 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-updated-buffer gdb-stack-buffer @@ -438,7 +592,8 @@ GUD buffer (I/O of GDB) | Locals buffer gdb-stack-list-frames-custom) (defconst gdb-stack-list-frames-regexp -"level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",line=\"\\(.*?\\)\"") +"level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",\ +file=\".*?\",fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"") (defun gdb-stack-list-frames-handler () (setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames @@ -480,18 +635,17 @@ GUD buffer (I/O of GDB) | Locals buffer '(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)) + (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)))))) ;; Locals buffer. -;; uses "-stack-list-locals 2". Needs GDB 6.1 onwards. +;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards. (def-gdb-auto-updated-buffer gdb-locals-buffer gdbmi-invalidate-locals - "-stack-list-locals 2\n" + "-stack-list-locals --simple-values\n" gdb-stack-list-locals-handler gdb-stack-list-locals-custom) @@ -516,7 +670,7 @@ GUD buffer (I/O of GDB) | Locals buffer (push local locals-list)))) (let ((buf (gdb-get-buffer 'gdb-locals-buffer))) (and buf (with-current-buffer buf - (let ((p (point)) + (let ((p (window-point (get-buffer-window buf 0))) (buffer-read-only nil)) (erase-buffer) (dolist (local locals-list) @@ -527,42 +681,148 @@ GUD buffer (I/O of GDB) | Locals buffer "(structure)" "(array)")) "\n"))) - (goto-char p))))))) + (set-window-point (get-buffer-window buf 0) 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." + +;; Registers buffer. +;; +(def-gdb-auto-updated-buffer gdb-registers-buffer + gdbmi-invalidate-registers + "-data-list-register-values x\n" + gdb-data-list-register-values-handler + gdb-data-list-register-values-custom) + +(defconst gdb-data-list-register-values-regexp + "number=\"\\(.*?\\)\",value=\"\\(.*?\\)\"") + +(defun gdb-data-list-register-values-handler () + (setq gdb-pending-triggers (delq 'gdbmi-invalidate-registers + gdb-pending-triggers)) + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (goto-char (point-min)) + (if (re-search-forward gdb-error-regexp nil t) + (progn + (let ((match nil)) + (setq match (match-string 1)) + (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer) + (let ((buffer-read-only nil)) + (erase-buffer) + (insert match) + (goto-char (point-min)))))) + (let ((register-list (reverse gdb-register-names)) + (register nil) (register-string nil) (register-values nil)) + (goto-char (point-min)) + (while (re-search-forward gdb-data-list-register-values-regexp nil t) + (setq register (pop register-list)) + (setq register-string (concat register "\t" (match-string 2) "\n")) + (if (member (match-string 1) gdb-changed-registers) + (put-text-property 0 (length register-string) + 'face 'font-lock-warning-face + register-string)) + (setq register-values + (concat register-values register-string))) + (let ((buf (gdb-get-buffer 'gdb-registers-buffer))) + (with-current-buffer buf + (let ((p (window-point (get-buffer-window buf 0))) + (buffer-read-only nil)) + (erase-buffer) + (insert register-values) + (set-window-point (get-buffer-window buf 0) p)))))))) + +(defun gdb-data-list-register-values-custom ()) + +(defun gdb-get-changed-registers () + (if (and (gdb-get-buffer 'gdb-registers-buffer) + (not (member 'gdb-get-changed-registers gdb-pending-triggers))) + (progn + (gdb-enqueue-input + (list + "-data-list-changed-registers\n" + 'gdb-get-changed-registers-handler)) + (push 'gdb-get-changed-registers gdb-pending-triggers)))) + +(defun gdb-get-changed-registers-handler () + (setq gdb-pending-triggers + (delq 'gdb-get-changed-registers gdb-pending-triggers)) + (setq gdb-changed-registers nil) + (with-current-buffer (gdb-get-create-buffer 'gdb-partial-output-buffer) + (goto-char (point-min)) + (while (re-search-forward gdb-data-list-register-names-regexp nil t) + (push (match-string 1) gdb-changed-registers)))) + + +(defconst gdb-data-list-register-names-regexp "\"\\(.*?\\)\"") + +(defun gdb-get-register-names () + "Create a list of register names." + (goto-char (point-min)) + (setq gdb-register-names nil) + (while (re-search-forward gdb-data-list-register-names-regexp nil t) + (push (match-string 1) gdb-register-names))) + +;; these functions/variables may go into gdb-ui.el in the near future +;; (from gdb-nui.el) + +(defvar gdb-source-file-list nil) +(defvar gdb-source-file-regexp "fullname=\"\\(.*?\\)\"") + +(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 (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 + (if (re-search-forward gdb-source-file-regexp nil t) + (setq gdb-main-file (match-string 1))) + (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)))) + (gdb-get-create-buffer 'gdb-breakpoints-buffer) + (if gdb-show-main + (let ((pop-up-windows t)) + (display-buffer (gud-find-file gdb-main-file)))))) +(defun gdb-get-source-file-list () + "Create list of source files for current GDB session." + (goto-char (point-min)) + (while (re-search-forward gdb-source-file-regexp nil t) + (push (match-string 1) gdb-source-file-list))) + +(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-create-buffer '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-frame-address (match-string 2)) + (setq gdb-selected-frame (match-string 3)) + (setq gud-last-frame + (cons (match-string 4) (string-to-number (match-string 5)))) + (gud-display-frame) + (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 |