This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
another [PATCH] gdb-mi.el
- From: Nick Roberts <nickrob at snap dot net dot nz>
- To: gdb-patches at sourceware dot org
- Date: Tue, 14 Feb 2006 11:08:50 +1300
- Subject: another [PATCH] gdb-mi.el
OK to commit?
Nick
2006-02-14 Nick Roberts <nickrob@snap.net.nz>
* mi/gdb-mi.el: Use more functions from gdb-ui.el.
(gdb-break-list-regexp): Match "what" field if present.
(gdb-stack-list-frames-regexp): Match "from" if present field.
(gdb-stack-list-frames-handler): Present output like "info
breakpoints" so regexps can be shared with gdb-ui
*** gdb-mi.el 10 Feb 2006 19:16:48 +1300 1.5
--- gdb-mi.el 14 Feb 2006 00:40:51 +1300
***************
*** 58,67 ****
(require 'gud)
(require 'gdb-ui)
- (defvar gdb-source-file-list nil)
- (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)
--- 58,63 ----
***************
*** 190,196 ****
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
--- 186,191 ----
***************
*** 207,213 ****
;; find source file and compilation directory here
(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))
--- 202,209 ----
;; 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))
***************
*** 219,287 ****
(setq gdb-locals-font-lock-keywords gdb-locals-font-lock-keywords-2)
(run-hooks 'gdbmi-mode-hook))
- ; Force nil till fixed.
- (defconst gdbmi-use-inferior-io-buffer nil)
-
- ; Uses "-var-list-children --all-values". Needs GDB 6.1 onwards.
- (defun gdbmi-var-list-children (varnum)
- (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=\\(\".*?\"\\),type=\"\\(.+?\\)\"}")
-
- (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)
- (match-string 5)
- (read (match-string 4))
- nil)))
- (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))))))
-
- ; 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-found-1
- (let ((num 0))
- (dolist (var gdb-var-list)
- (if (string-equal varnum (cadr var))
- (progn
- (setcar (nthcdr 5 var) t)
- (setcar (nthcdr 4 var) (read (match-string 2)))
- (setcar (nthcdr num gdb-var-list) var)
- (throw 'var-found-1 nil)))
- (setq num (+ num 1))))))
- (setq gdb-var-changed t)))
- (with-current-buffer gud-comint-buffer
- (speedbar-timer-fn)))
(defun gdbmi-send (proc string)
"A comint send filter for gdb."
--- 215,220 ----
***************
*** 335,347 ****
(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."
--- 268,280 ----
(setq gdb-var-changed t) ; force update
(dolist (var gdb-var-list)
(setcar (nthcdr 5 var) nil))
! (gdb-var-update-1))
(gdbmi-get-selected-frame)
(gdbmi-invalidate-frames)
(gdbmi-invalidate-breakpoints)
(gdb-get-changed-registers)
! (gdb-invalidate-registers-1)
! (gdb-invalidate-locals-1)))
(defun gdbmi-prompt2 ()
"Handle any output and send next GDB command."
***************
*** 468,475 ****
(defconst gdb-break-list-regexp
"number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",\
! addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",fullname=\".*?\",\
! line=\"\\(.*?\\)\"")
(defun gdb-break-list-handler ()
(setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints
--- 401,409 ----
(defconst gdb-break-list-regexp
"number=\"\\(.*?\\)\",type=\"\\(.*?\\)\",disp=\"\\(.*?\\)\",enabled=\"\\(.\\)\",\
! addr=\"\\(.*?\\)\",\
! \\(?:func=\"\\(.*?\\)\",file=\"\\(.*?\\)\",fullname=\".*?\",line=\"\\(.*?\\)\",\
! \\|\\(?:what=\"\\(.*?\\)\",\\)*\\)times=\"\\(.*?\\)\"")
(defun gdb-break-list-handler ()
(setq gdb-pending-triggers (delq 'gdbmi-invalidate-breakpoints
***************
*** 485,568 ****
(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) (bptno))
! ;;
! ;; 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 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"))
! (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)))
!
! (defvar gdbmi-source-file-regexp "fullname=\"\\(.*?\\)\"")
(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 gdbmi-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)
--- 419,455 ----
(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)
***************
*** 591,597 ****
(defconst gdb-stack-list-frames-regexp
"level=\"\\(.*?\\)\",addr=\"\\(.*?\\)\",func=\"\\(.*?\\)\",\
! file=\".*?\",fullname=\"\\(.*?\\)\",line=\"\\(.*?\\)\"")
(defun gdb-stack-list-frames-handler ()
(setq gdb-pending-triggers (delq 'gdbmi-invalidate-frames
--- 478,485 ----
(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
***************
*** 605,624 ****
(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))
--- 493,516 ----
(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"
! (nth 2 frame) "\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))
***************
*** 639,781 ****
'face '(:inverse-video t)))
(forward-line 1))))))
- ;; Locals buffer.
- ;; uses "-stack-list-locals --simple-values". Needs GDB 6.1 onwards.
- (def-gdb-auto-update-trigger gdbmi-invalidate-locals
- (gdb-get-buffer 'gdb-locals-buffer)
- "-stack-list-locals --simple-values\n"
- gdb-stack-list-locals-handler)
-
- (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) (read (match-string 1))))
- (push local locals-list))))
- (let ((buf (gdb-get-buffer 'gdb-locals-buffer)))
- (and buf (with-current-buffer buf
- (let* ((window (get-buffer-window buf 0))
- (p (window-point window))
- (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")))
- (set-window-point window p)))))))
-
-
- ;; Registers buffer.
- ;;
- (def-gdb-auto-update-trigger gdbmi-invalidate-registers
- (gdb-get-buffer 'gdb-registers-buffer)
- "-data-list-register-values x\n"
- gdb-data-list-register-values-handler)
-
- (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)))))))
- (gdb-data-list-register-values-custom))
-
- (defun gdb-data-list-register-values-custom ()
- (with-current-buffer (gdb-get-buffer 'gdb-registers-buffer)
- (save-excursion
- (let ((buffer-read-only nil)
- bl)
- (goto-char (point-min))
- (while (< (point) (point-max))
- (setq bl (line-beginning-position))
- (when (looking-at "^[^\t]+")
- (put-text-property bl (match-end 0)
- 'face font-lock-variable-name-face))
- (forward-line 1))))))
-
- (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))))
-
- (defconst gdb-data-list-register-names-regexp "\"\\(.*?\\)\"")
-
- (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))))
-
- (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)
!
(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 gdbmi-source-file-regexp nil t)
(setq gdb-main-file (match-string 1)))
(if gdb-many-windows
(gdb-setup-windows)
--- 531,543 ----
'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)
***************
*** 784,795 ****
(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 gdbmi-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
--- 546,551 ----
***************
*** 825,830 ****
--- 581,650 ----
(setq gdb-prompt-name nil)
(re-search-forward gdb-prompt-name-regexp nil t)
(setq gdb-prompt-name (match-string 1)))
+
+ ;; For debugging Emacs only (assumes that usual stack buffer already exists).
+ (gdb-set-buffer-rules 'gdb-xbacktrace-buffer
+ 'gdb-xbacktrace-buffer-name
+ 'gdb-xbacktrace-mode)
+
+ (defun gdb-xbacktrace-buffer-name ()
+ (with-current-buffer gud-comint-buffer
+ (concat "*xbacktrace of " (gdb-get-target-string) "*")))
+
+ (defun gdb-xbacktrace-mode ()
+ "Major mode for gdb xbacktrace.
+
+ \\{gdb-xbacktrace-mode-map}"
+ (kill-all-local-variables)
+ (setq major-mode 'gdb-mode)
+ (setq mode-name "Xbacktrace")
+ (use-local-map gdb-xbacktrace-mode-map)
+ (setq buffer-read-only t)
+ (run-mode-hooks 'gdb-xbacktrace-mode-hook))
+
+ (defun gdbmi-xbacktrace ()
+ "Generate a full lisp level backtrace with arguments."
+ (interactive)
+ (with-current-buffer (gdb-get-create-buffer 'gdb-xbacktrace-buffer)
+ (let ((buffer-read-only nil))
+ (erase-buffer)))
+ (let ((frames nil)
+ (frame-number gdb-frame-number))
+ (with-current-buffer (gdb-get-buffer 'gdb-stack-buffer)
+ (save-excursion
+ (goto-char (point-min))
+ (while (search-forward "Ffuncall" nil t)
+ (goto-char (line-beginning-position))
+ (looking-at "^\\([0-9]+\\)")
+ (push (match-string-no-properties 1) frames)
+ (forward-line 1))))
+ (dolist (frame frames)
+ (gdb-enqueue-input (list (concat "frame " frame "\n")
+ 'ignore))
+ (gdb-enqueue-input (list "-interpreter-exec console ppargs\n"
+ 'gdb-get-arguments)))
+ (gdb-enqueue-input (list (concat "frame " frame-number "\n")
+ 'ignore))))
+
+ (defun gdb-get-arguments ()
+ (with-current-buffer (gdb-get-buffer 'gdb-xbacktrace-buffer)
+ (let ((buffer-read-only nil))
+ (insert-buffer-substring (gdb-get-buffer 'gdb-partial-output-buffer)))))
+
+ (defun gdb-frame-xbacktrace-buffer ()
+ "Display GUD buffer in a new frame."
+ (interactive)
+ (let ((special-display-regexps (append special-display-regexps '(".*")))
+ (special-display-frame-alist gdb-frame-parameters)
+ (same-window-regexps nil))
+ (display-buffer (gdb-get-create-buffer 'gdb-xbacktrace-buffer)))
+ (gdbmi-xbacktrace))
+
+ (defvar gdb-xbacktrace-mode-map
+ (let ((map (make-sparse-keymap)))
+ (suppress-keymap map)
+ (define-key map "q" 'kill-this-buffer)
+ map))
(provide 'gdb-mi)
;;; gdbmi.el ends here