Re: Extend gdb to filter registers

[Yuan Fu <casouri@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1022 bytes --]

If anyone is interested, please try these out:

1. register.patch

Adds register filters to register buffer. There will be [-|+] buttons
on the header line of the register buffer. Click them and chose what to
include/exclude.

2. memory.patch

Adds support for multiple memory buffers. Add support for expressions as
memory address. Call out the first memory buffer by
‘gdb-display-memory-buffer’ like before, call out additional ones by
‘gdb-display-new-memory-buffer’. To use an expression as address, click
on the address button like before and enter expressions like x, x + 1,
$rsp, etc. gdb-mi will display an error if the expression you entered is
invalid or it can’t read memory. You need to also apply the
unwind-protect patch for this to work properly.


3. unwind-protect.patch

Fixes a bug where one error could mess up the whole gdb-mi session. The
previous unwind-protect.patch doesn’t solve the bug fully and this one
should.

Any comment is welcome. Thanks.

Yuan


[-- Attachment #2: register.patch --]
[-- Type: text/x-patch, Size: 7677 bytes --]

From 5010df825853b0d393f74388371d2bb0e3d5c723 Mon Sep 17 00:00:00 2001
From: Yuan Fu <casouri@gmail.com>
Date: Sun, 6 Oct 2019 14:10:14 -0400
Subject: [PATCH] Add register filters to gdb-mi

Add filtering feature to register buffer of gdb-mi.
User can add or remove registers they want to see.

* lisp/progmodes/gdb-mi.el (gdb-display-these-registers,
(gdb-registers-add-to-display, gdb-registers-remove-from-display): new
(gdb-registers-handler-custom): add condition check before adding
register to display
(gdb-registers-mode-map): add "+" and "-" keybinding
(gdb-registers-header): add "[-|+]" button
---
 lisp/progmodes/gdb-mi.el | 111 ++++++++++++++++++++++++++++++++++-----
 1 file changed, 99 insertions(+), 12 deletions(-)

diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 60852e4ad6..6b9f448dbe 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -200,6 +200,13 @@ gdb-error
 (defvar gdb-macro-info nil
   "Non-nil if GDB knows that the inferior includes preprocessor macro info.")
 (defvar gdb-register-names nil "List of register names.")
+(defvar-local gdb-display-these-registers t
+  "Registers that are displayed in register buffer.
+Can be a list, a function or t/nil.
+If a list, registers which names can be found in the list are displayed.
+If a function, it is passed with a register name and should
+return t to display and nil to not display.
+If t/nil, display all registers / none of the registers.")
 (defvar gdb-changed-registers nil
   "List of changed register numbers (strings).")
 (defvar gdb-buffer-fringe-width nil)
@@ -4238,6 +4245,62 @@ gdb-frame-locals-buffer
  'gdb-registers-mode
  'gdb-invalidate-registers)
 
+(defun gdb-registers-add-to-display (event)
+  "Add register to display in register buffer.
+
+Register is a string representing the name of the register.
+By default the register buffer displays all the registers.
+register can also be 'all, which configures gdb to display all registers.
+Also see `gdb-registers-remove-from-display'.
+
+This function is intended to be used from clicking header line
+of register buffer, hence the EVENT."
+  (interactive "e")
+  (save-selected-window
+    ;; make sure we are in the right buffer
+    (select-window (posn-window (event-start event)))
+    (let ((register (completing-read "Register: "
+                                     (append gdb-register-names
+                                             '("all")))))
+      ;; if `gdb-display-these-registers' is a function,
+      ;; just override it with list
+      (if (equal register "all")
+          (setq gdb-display-these-registers t)
+        (if (listp gdb-display-these-registers)
+            (add-to-list 'gdb-display-these-registers register)
+          (setq gdb-display-these-registers (list register))))
+      ;; update register buffer
+      (gdb-invalidate-registers 'update))))
+
+(defun gdb-registers-remove-from-display (event)
+  "Remove register from display in register buffer.
+
+Register is a string representing the name of the register.
+By default the register buffer displays all the registers.
+REGISTER can also be 'all, which configures gdb to hide all registers.
+also see `gdb-registers-add-to-display'.
+
+This function is intended to be used from clicking header line
+of register buffer, hence the EVENT."
+  (interactive "e")
+  (save-selected-window
+    ;; make sure we are in the right buffer
+    (select-window (posn-window (event-start event)))
+    (let ((register (completing-read "Register: "
+                                     (append gdb-register-names
+                                             '("all")))))
+      (if (equal register "all")
+          (setq gdb-display-these-registers nil)
+        (cond ((listp gdb-display-these-registers)
+               (setq gdb-display-these-registers
+                     (remove register gdb-display-these-registers)))
+              ((eq gdb-display-these-registers t)
+               (setq gdb-display-these-registers
+                     (remove register gdb-register-names)))
+              (t (user-error "`gdb-display-these-registers' is not a list, can’t remove anything from it"))))
+      ;; update register buffer
+      (gdb-invalidate-registers 'update))))
+
 (defun gdb-registers-handler-custom ()
   (when gdb-register-names
     (let ((register-values
@@ -4248,17 +4311,22 @@ gdb-registers-handler-custom
                (value (bindat-get-field register 'value))
                (register-name (nth (string-to-number register-number)
                                    gdb-register-names)))
-          (gdb-table-add-row
-           table
-           (list
-            (propertize register-name
-                        'font-lock-face font-lock-variable-name-face)
-            (if (member register-number gdb-changed-registers)
-                (propertize value 'font-lock-face font-lock-warning-face)
-              value))
-           `(mouse-face highlight
-                        help-echo "mouse-2: edit value"
-                        gdb-register-name ,register-name))))
+          (when (cond ((listp gdb-display-these-registers) ; consider nil as empty list
+                       (member register-name gdb-display-these-registers))
+                      ((functionp gdb-display-these-registers)
+                       (funcall gdb-display-these-registers register-name))
+                      (t gdb-display-these-registers))
+            (gdb-table-add-row
+             table
+             (list
+              (propertize register-name
+                          'font-lock-face font-lock-variable-name-face)
+              (if (member register-number gdb-changed-registers)
+                  (propertize value 'font-lock-face font-lock-warning-face)
+                value))
+             `(mouse-face highlight
+                          help-echo "mouse-2: edit value"
+                          gdb-register-name ,register-name)))))
       (insert (gdb-table-string table " ")))
     (setq mode-name
           (gdb-current-context-mode-name "Registers"))))
@@ -4287,6 +4355,8 @@ gdb-registers-mode-map
                             (gdb-get-buffer-create
                              'gdb-locals-buffer
                              gdb-thread-number) t)))
+    (define-key map "+" #'gdb-registers-add-to-display)
+    (define-key map "-" #'gdb-registers-remove-from-display)
     map))
 
 (defvar gdb-registers-header
@@ -4296,7 +4366,24 @@ gdb-registers-header
                           mode-line-inactive)
    " "
    (gdb-propertize-header "Registers" gdb-registers-buffer
-			  nil nil mode-line)))
+			  nil nil mode-line)
+   " ["
+   (propertize "-"
+               'face font-lock-warning-face
+               'help-echo "mouse-1: remove register from display filter"
+               'mouse-face 'mode-line-highlight
+               'local-map (gdb-make-header-line-mouse-map
+                           'mouse-1
+                           #'gdb-registers-remove-from-display))
+   "|"
+   (propertize "+"
+               'face font-lock-warning-face
+               'help-echo "mouse-1: add register to display filter"
+               'mouse-face 'mode-line-highlight
+               'local-map (gdb-make-header-line-mouse-map
+                           'mouse-1
+                           #'gdb-registers-add-to-display))
+   "]"))
 
 (define-derived-mode gdb-registers-mode gdb-parent-mode "Registers"
   "Major mode for gdb registers."
-- 
2.23.0


[-- Attachment #3: memory.patch --]
[-- Type: text/x-patch, Size: 13243 bytes --]

From f6db7853075e048affc245f07e7a4c6153e71237 Mon Sep 17 00:00:00 2001
From: Yuan Fu <casouri@gmail.com>
Date: Sat, 5 Oct 2019 13:53:24 -0400
Subject: [PATCH 1/5] Allow multiple memory buffers to co-exist
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

lisp/progmodes/gdb-mi.el (gdb-memory-address, gdb-memory-next-page,
  gdb-memory-prev-page): change to buffer local.
  (gdb-update-buffer-name, gdb-get-buffer-create): allow
    ‘rename-buffer’ to generate unique new buffer names
  (gdb-get-buffer-create): Add an option to force create new buffer
  (gdb-display-new-memory-buffer): new
---
 lisp/progmodes/gdb-mi.el | 27 ++++++++++++++++++---------
 1 file changed, 18 insertions(+), 9 deletions(-)

diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 60852e4ad6..8235c7d2ee 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -105,12 +105,12 @@ tool-bar-map
 (defvar speedbar-initial-expansion-list-name)
 (defvar speedbar-frame)
 
-(defvar	gdb-memory-address "main")
-(defvar	gdb-memory-last-address nil
+(defvar-local gdb-memory-address "main")
+(defvar-local gdb-memory-last-address nil
   "Last successfully accessed memory address.")
-(defvar	gdb-memory-next-page nil
+(defvar-local gdb-memory-next-page nil
   "Address of next memory page for program memory buffer.")
-(defvar	gdb-memory-prev-page nil
+(defvar-local gdb-memory-prev-page nil
   "Address of previous memory page for program memory buffer.")
 
 (defvar gdb-thread-number nil
@@ -1421,7 +1421,8 @@ gdb-update-buffer-name
 it in `gdb-buffer-rules'."
   (let ((f (gdb-rules-name-maker (assoc gdb-buffer-type
                                         gdb-buffer-rules))))
-    (when f (rename-buffer (funcall f)))))
+    ;; allow multiple memory buffers to co-exist
+    (when f (rename-buffer (funcall f) t))))
 
 (defun gdb-current-buffer-rules ()
   "Get `gdb-buffer-rules' entry for current buffer type."
@@ -1462,7 +1463,7 @@ gdb-get-buffer
                        (equal gdb-thread-number thread)))
           (throw 'found buffer))))))
 
-(defun gdb-get-buffer-create (buffer-type &optional thread)
+(defun gdb-get-buffer-create (buffer-type &optional thread new)
   "Create a new GDB buffer of the type specified by BUFFER-TYPE.
 The buffer-type should be one of the cars in `gdb-buffer-rules'.
 
@@ -1473,8 +1474,10 @@ gdb-get-buffer-create
 
 If buffer has trigger associated with it in `gdb-buffer-rules',
 this trigger is subscribed to `gdb-buf-publisher' and called with
-'update argument."
-  (or (gdb-get-buffer buffer-type thread)
+'update argument.
+
+If NEW is non-nil, create a new buffer regardless."
+  (or (and (not new) (gdb-get-buffer buffer-type thread))
       (let ((rules (assoc buffer-type gdb-buffer-rules))
             (new (generate-new-buffer "limbo")))
 	(with-current-buffer new
@@ -1487,7 +1490,8 @@ gdb-get-buffer-create
 	    (set (make-local-variable 'gud-minor-mode)
 		 (buffer-local-value 'gud-minor-mode gud-comint-buffer))
 	    (set (make-local-variable 'tool-bar-map) gud-tool-bar-map)
-            (rename-buffer (funcall (gdb-rules-name-maker rules)))
+            ;; allow multiple memory buffers to co-exist
+            (rename-buffer (funcall (gdb-rules-name-maker rules)) t)
 	    (when trigger
               (gdb-add-subscriber gdb-buf-publisher
                                   (cons (current-buffer)
@@ -3786,6 +3790,11 @@ gdb-display-memory-buffer
   (interactive)
   (gdb-display-buffer (gdb-get-buffer-create 'gdb-memory-buffer thread)))
 
+(defun gdb-display-new-memory-buffer (&optional thread)
+  "Display GDB memory contents in a new gdb buffer."
+  (interactive)
+  (gdb-display-buffer (gdb-get-buffer-create 'gdb-memory-buffer thread t)))
+
 (defun gdb-frame-memory-buffer ()
   "Display memory contents in another frame."
   (interactive)
-- 
2.23.0


From 9166f87de72153c71a92c162a1311c31771051ae Mon Sep 17 00:00:00 2001
From: Yuan Fu <casouri@gmail.com>
Date: Sat, 5 Oct 2019 22:42:07 -0400
Subject: [PATCH 2/5] Enhance support for expressions as memory address
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Before the memory buffer evaluates the expression as address
and use the fixed result in each stop. This change stores the
expression itself and reevaluates it in each stop for an address.
Then displays the value of the memory at that address.

lisp/progmodes/gdb-mi.el (gdb-memory-address-expression): new
  (gdb-memory-address): change default value, add docstring
  (def-gdb-trigger-and-handler gdb-invalidate-memory,
  gdb-memory-set-address): replace ’gdb-memory-address’ with
    ’gdb-memory-address-expression’
  (gdb-memory-header): Add display for ’gdb-memory-address-expression’,
    move the mouse event from address to expression
---
 lisp/progmodes/gdb-mi.el | 27 +++++++++++++++++----------
 1 file changed, 17 insertions(+), 10 deletions(-)

diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 8235c7d2ee..0f89422156 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -105,7 +105,11 @@ tool-bar-map
 (defvar speedbar-initial-expansion-list-name)
 (defvar speedbar-frame)
 
-(defvar-local gdb-memory-address "main")
+(defvar-local gdb-memory-address-expression "main"
+  "This expression is passed to gdb.
+Possible value: main, $rsp, x+3.")
+(defvar-local gdb-memory-address nil
+  "Address of memory display.")
 (defvar-local gdb-memory-last-address nil
   "Last successfully accessed memory address.")
 (defvar-local gdb-memory-next-page nil
@@ -3448,7 +3452,7 @@ gdb-memory-unit
 (def-gdb-trigger-and-handler
   gdb-invalidate-memory
   (format "-data-read-memory %s %s %d %d %d"
-          gdb-memory-address
+          (gdb-mi-quote gdb-memory-address-expression)
           gdb-memory-format
           gdb-memory-unit
           gdb-memory-rows
@@ -3538,7 +3542,7 @@ gdb-memory-set-address
   "Set the start memory address."
   (interactive)
   (let ((arg (read-from-minibuffer "Memory address: ")))
-    (setq gdb-memory-address arg))
+    (setq gdb-memory-address-expression arg))
   (gdb-invalidate-memory 'update))
 
 (defmacro def-gdb-set-positive-number (name variable echo-string &optional doc)
@@ -3721,7 +3725,15 @@ gdb-memory-font-lock-keywords
 (defvar gdb-memory-header
   '(:eval
     (concat
-     "Start address["
+     "Start address "
+     (propertize gdb-memory-address-expression
+                 'face font-lock-warning-face
+                 'help-echo "mouse-1: set start address"
+                 'mouse-face 'mode-line-highlight
+                 'local-map (gdb-make-header-line-mouse-map
+                             'mouse-1
+                             #'gdb-memory-set-address-event))
+     " ["
      (propertize "-"
                  'face font-lock-warning-face
                  'help-echo "mouse-1: decrement address"
@@ -3739,12 +3751,7 @@ gdb-memory-header
                              #'gdb-memory-show-next-page))
      "]: "
      (propertize gdb-memory-address
-                 'face font-lock-warning-face
-                 'help-echo "mouse-1: set start address"
-                 'mouse-face 'mode-line-highlight
-                 'local-map (gdb-make-header-line-mouse-map
-                             'mouse-1
-                             #'gdb-memory-set-address-event))
+                 'face font-lock-warning-face)
      "  Rows: "
      (propertize (number-to-string gdb-memory-rows)
                  'face font-lock-warning-face
-- 
2.23.0


From 8166dafcfed0d2d4259232f90d64b1a12a10f840 Mon Sep 17 00:00:00 2001
From: Yuan Fu <casouri@gmail.com>
Date: Mon, 7 Oct 2019 20:36:23 -0400
Subject: [PATCH 3/5] Fix memory buffer code in gdb-mi
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* lisp/progmodes/gdb-mi.el (gdb-read-memory-custom):
Break infinite loop. Change ’error’ to ’user-error’
---
 lisp/progmodes/gdb-mi.el | 8 +++++---
 1 file changed, 5 insertions(+), 3 deletions(-)

diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 0f89422156..18a33f4933 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -3505,10 +3505,12 @@ gdb-read-memory-custom
                                             gdb-memory-format)))))
             (newline)))
       ;; Show last page instead of empty buffer when out of bounds
-      (progn
-        (let ((gdb-memory-address gdb-memory-last-address))
+      (when gdb-memory-last-address
+        (let ((gdb-memory-address-expression gdb-memory-last-address))
+          ;; avoid infinite loop
+          (setq gdb-memory-last-address nil)
           (gdb-invalidate-memory 'update)
-          (error err-msg))))))
+          (user-error "Error when retrieving memory: %s Displaying last successful page" err-msg))))))
 
 (defvar gdb-memory-mode-map
   (let ((map (make-sparse-keymap)))
-- 
2.23.0


From e4918f6ac82c4e2d1b4a9b860b4520953851f46d Mon Sep 17 00:00:00 2001
From: Yuan Fu <casouri@gmail.com>
Date: Mon, 7 Oct 2019 20:52:15 -0400
Subject: [PATCH 4/5] Protect against nil memory address in gdb-mi

* lisp/progmodes/gdb-mi.el (gdb-memory-header):
Protect against nil value
---
 lisp/progmodes/gdb-mi.el | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 18a33f4933..65abf9d174 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -3728,7 +3728,7 @@ gdb-memory-header
   '(:eval
     (concat
      "Start address "
-     (propertize gdb-memory-address-expression
+     (propertize (or gdb-memory-address-expression "N/A")
                  'face font-lock-warning-face
                  'help-echo "mouse-1: set start address"
                  'mouse-face 'mode-line-highlight
@@ -3752,7 +3752,7 @@ gdb-memory-header
                              'mouse-1
                              #'gdb-memory-show-next-page))
      "]: "
-     (propertize gdb-memory-address
+     (propertize (or gdb-memory-address "N/A")
                  'face font-lock-warning-face)
      "  Rows: "
      (propertize (number-to-string gdb-memory-rows)
-- 
2.23.0


From 479ef100475d453f3fa03d8110263a7c04ab54f5 Mon Sep 17 00:00:00 2001
From: Yuan Fu <casouri@gmail.com>
Date: Mon, 7 Oct 2019 21:17:01 -0400
Subject: [PATCH 5/5] =?UTF-8?q?Display=20warning=20when=20address=20expres?=
 =?UTF-8?q?sion=20and=20address=20doesn=E2=80=99t=20match?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* lisp/progmodes/gdb-mi.el (gdb--memory-display-warning): new
(gdb-read-memory-custom, gdb-memory-header): Add warning
---
 lisp/progmodes/gdb-mi.el | 15 ++++++++++++++-
 1 file changed, 14 insertions(+), 1 deletion(-)

diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 65abf9d174..7b3b05a633 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -116,6 +116,12 @@ gdb-memory-next-page
   "Address of next memory page for program memory buffer.")
 (defvar-local gdb-memory-prev-page nil
   "Address of previous memory page for program memory buffer.")
+(defvar-local gdb--memory-display-warning nil
+  "Display warning on memory header if t.
+
+When error occurs when retrieving memory, gdb-mi displays the last
+successful page. In that case the expression might not match the
+memory displayed.")
 
 (defvar gdb-thread-number nil
   "Main current thread.
@@ -3492,6 +3498,9 @@ gdb-read-memory-custom
          (err-msg (bindat-get-field res 'msg)))
     (if (not err-msg)
         (let ((memory (bindat-get-field res 'memory)))
+          (when gdb-memory-last-address
+            ;; nil means last retrieve emits error or just started the session
+            (setq gdb--memory-display-warning nil))
           (setq gdb-memory-address (bindat-get-field res 'addr))
           (setq gdb-memory-next-page (bindat-get-field res 'next-page))
           (setq gdb-memory-prev-page (bindat-get-field res 'prev-page))
@@ -3508,7 +3517,8 @@ gdb-read-memory-custom
       (when gdb-memory-last-address
         (let ((gdb-memory-address-expression gdb-memory-last-address))
           ;; avoid infinite loop
-          (setq gdb-memory-last-address nil)
+          (setq gdb-memory-last-address nil
+                gdb--memory-display-warning t)
           (gdb-invalidate-memory 'update)
           (user-error "Error when retrieving memory: %s Displaying last successful page" err-msg))))))
 
@@ -3735,6 +3745,9 @@ gdb-memory-header
                  'local-map (gdb-make-header-line-mouse-map
                              'mouse-1
                              #'gdb-memory-set-address-event))
+     (if gdb--memory-display-warning
+         (propertize " !" 'face '(:inherit error :weight bold))
+       "")
      " ["
      (propertize "-"
                  'face font-lock-warning-face
-- 
2.23.0


[-- Attachment #4: unwind-protect.patch --]
[-- Type: text/x-patch, Size: 1190 bytes --]

From 9d7dce80836fa39fbd9a75261a2b66c8f8dfb552 Mon Sep 17 00:00:00 2001
From: Yuan Fu <casouri@gmail.com>
Date: Mon, 7 Oct 2019 18:47:54 -0400
Subject: [PATCH] Protect against errors in handlers in gdb-mi
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* lisp/progmodes/gdb-mi.el (gdb-handle-reply):
Handle error in ’handler-function’ so the cleanup code after it
runs safely.
---
 lisp/progmodes/gdb-mi.el | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el
index 60852e4ad6..5baf4e1690 100644
--- a/lisp/progmodes/gdb-mi.el
+++ b/lisp/progmodes/gdb-mi.el
@@ -324,7 +324,10 @@ gdb-handle-reply
 by the reception of this reply."
   (let ((handler-function (gdb-get-handler-function token-number)))
     (when handler-function
-      (funcall handler-function)
+      (condition-case err
+          ;; protect against errors in handler-function
+          (funcall handler-function)
+        (error (message (error-message-string err))))
       (gdb-delete-handler token-number))))
 
 (defun gdb-remove-all-pending-triggers ()
-- 
2.23.0