Commit 53267cca authored by Jean-Philippe Gravel's avatar Jean-Philippe Gravel

* progmodes/gdb-mi.el: Fix non-responsive gud commands (bug#13845)

(gdb-handler-alist, gdb-handler-number): Remove variables.
(gdb-handler-list): New variable.
(gdb-add-handler, gdb-delete-handler, gdb-get-handler-function)
(gdb-pending-handler-p, gdb-handle-reply)
(gdb-remove-all-pending-triggers): New functions.
(gdb-discard-unordered-replies): New defcustom.
(gdb-handler): New defstruct.
(gdb-wait-for-pending): Fix invalid backquote.  Use gdb-handler-list.
instead of gdb-pending-triggers.  Update docstring.
(gdb-init-1): Remove dead variables.  Initialize gdb-handler-list.
(gdb-speedbar-update, gdb-speedbar-timer-fn, gdb-var-update)
(gdb-var-update-handler, def-gdb-auto-update-trigger)
(def-gdb-auto-update-handler, gdb-get-changed-registers)
(gdb-changed-registers-handler, gdb-get-main-selected-frame)
(gdb-frame-handler): Pending triggers are now automatically managed.
(def-gdb-trigger-and-handler, def-gdb-auto-update-handler):
Remove argument.
(gdb-input): Automatically handles pending triggers.  Update docstring.
(gdb-resync): Replace gdb-pending-triggers by gdb-handler-list.
(gdb-thread-exited, gdb-thread-selected, gdb-register-names-handler):
Update comments.
(gdb-done-or-error): Now use gdb-handle-reply.
parent d04ce803
2013-05-14 Jean-Philippe Gravel <jpgravel@gmail.com>
* progmodes/gdb-mi.el: Fix non-responsive gud commands (bug#13845)
(gdb-handler-alist, gdb-handler-number): Remove variables.
(gdb-handler-list): New variable.
(gdb-add-handler, gdb-delete-handler, gdb-get-handler-function)
(gdb-pending-handler-p, gdb-handle-reply)
(gdb-remove-all-pending-triggers): New functions.
(gdb-discard-unordered-replies): New defcustom.
(gdb-handler): New defstruct.
(gdb-wait-for-pending): Fix invalid backquote. Use gdb-handler-list.
instead of gdb-pending-triggers. Update docstring.
(gdb-init-1): Remove dead variables. Initialize gdb-handler-list.
(gdb-speedbar-update, gdb-speedbar-timer-fn, gdb-var-update)
(gdb-var-update-handler, def-gdb-auto-update-trigger)
(def-gdb-auto-update-handler, gdb-get-changed-registers)
(gdb-changed-registers-handler, gdb-get-main-selected-frame)
(gdb-frame-handler): Pending triggers are now automatically managed.
(def-gdb-trigger-and-handler, def-gdb-auto-update-handler):
Remove argument.
(gdb-input): Automatically handles pending triggers. Update docstring.
(gdb-resync): Replace gdb-pending-triggers by gdb-handler-list.
(gdb-thread-exited, gdb-thread-selected, gdb-register-names-handler):
Update comments.
(gdb-done-or-error): Now use gdb-handle-reply.
2013-05-14 Jean-Philippe Gravel <jpgravel@gmail.com>
* progmodes/gdb-mi.el (gdb-input): Include token numbers in
......
......@@ -91,7 +91,7 @@
(require 'gud)
(require 'json)
(require 'bindat)
(eval-when-compile (require 'cl-lib))
(require 'cl-lib)
(declare-function speedbar-change-initial-expansion-list
"speedbar" (new-default))
......@@ -206,8 +206,8 @@ Only used for files that Emacs can't find.")
(defvar gdb-last-command nil)
(defvar gdb-prompt-name nil)
(defvar gdb-token-number 0)
(defvar gdb-handler-alist '())
(defvar gdb-handler-number nil)
(defvar gdb-handler-list '()
"List of gdb-handler keeping track of all pending GDB commands.")
(defvar gdb-source-file-list nil
"List of source files for the current executable.")
(defvar gdb-first-done-or-error t)
......@@ -242,33 +242,114 @@ Possible values are these symbols:
disposition of output generated by commands that
gdb mode sends to gdb on its own behalf.")
;; Pending triggers prevent congestion: Emacs won't send two similar
;; consecutive requests.
(defvar gdb-pending-triggers '()
"A list of trigger functions which have not yet been handled.
Elements are either function names or pairs (buffer . function)")
(defmacro gdb-add-pending (item)
`(push ,item gdb-pending-triggers))
(defmacro gdb-pending-p (item)
`(member ,item gdb-pending-triggers))
(defmacro gdb-delete-pending (item)
`(setq gdb-pending-triggers
(delete ,item gdb-pending-triggers)))
(defcustom gdb-discard-unordered-replies t
"Non-nil means discard any out-of-order GDB replies.
This protects against lost GDB replies, assuming that GDB always
replies in the same order as Emacs sends commands. When receiving a
reply with a given token-number, assume any pending messages with a
lower token-number are out-of-order."
:type 'boolean
:group 'gud
:version "24.4")
(cl-defstruct gdb-handler
"Data required to handle the reply of a command sent to GDB."
;; Prefix of the command sent to GDB. The GDB reply for this command
;; will be prefixed with this same TOKEN-NUMBER
(token-number nil :read-only t)
;; Callback to invoke when the reply is received from GDB
(function nil :read-only t)
;; PENDING-TRIGGER is used to prevent congestion: Emacs won't send
;; two requests with the same PENDING-TRIGGER until a reply is received
;; for the first one."
(pending-trigger nil))
(defun gdb-add-handler (token-number handler-function &optional pending-trigger)
"Insert a new GDB command handler in `gdb-handler-list'.
Handlers are used to keep track of the commands sent to GDB
and to handle the replies received.
Upon reception of a reply prefixed with TOKEN-NUMBER,
invoke the callback HANDLER-FUNCTION.
If PENDING-TRIGGER is specified, no new GDB commands will be
sent with this same PENDING-TRIGGER until a reply is received
for this handler."
(push (make-gdb-handler :token-number token-number
:function handler-function
:pending-trigger pending-trigger)
gdb-handler-list))
(defun gdb-delete-handler (token-number)
"Remove the handler TOKEN-NUMBER from `gdb-handler-list'.
Additionally, if `gdb-discard-unordered-replies' is non-nil,
discard all handlers having a token number less than TOKEN-NUMBER."
(if gdb-discard-unordered-replies
(setq gdb-handler-list
(cl-delete-if
(lambda (handler)
"Discard any HANDLER with a token number `<=' than TOKEN-NUMBER."
(when (< (gdb-handler-token-number handler) token-number)
(message (format
"WARNING! Discarding GDB handler with token #%d\n"
(gdb-handler-token-number handler))))
(<= (gdb-handler-token-number handler) token-number))
gdb-handler-list))
(setq gdb-handler-list
(cl-delete-if
(lambda (handler)
"Discard any HANDLER with a token number `eq' to TOKEN-NUMBER."
(eq (gdb-handler-token-number handler) token-number))
gdb-handler-list))))
(defun gdb-get-handler-function (token-number)
"Return the function callback registered with the handler TOKEN-NUMBER."
(gdb-handler-function
(cl-find-if (lambda (handler) (eq (gdb-handler-token-number handler)
token-number))
gdb-handler-list)))
(defun gdb-pending-handler-p (pending-trigger)
"Return non-nil if a command handler is pending with trigger PENDING-TRIGGER."
(cl-find-if (lambda (handler) (eq (gdb-handler-pending-trigger handler)
pending-trigger))
gdb-handler-list))
(defun gdb-handle-reply (token-number)
"Handle the GDB reply TOKEN-NUMBER.
This invokes the handler registered with this token number
in `gdb-handler-list' and clears all pending handlers invalidated
by the reception of this reply."
(let ((handler-function (gdb-get-handler-function token-number)))
(when handler-function
(funcall handler-function)
(gdb-delete-handler token-number))))
(defun gdb-remove-all-pending-triggers ()
"Remove all pending triggers from gdb-handler-list.
The handlers are left in gdb-handler-list so that replies received
from GDB could still be handled. However, removing the pending triggers
allows Emacs to send new commands even if replies of previous commands
were not yet received."
(dolist (handler gdb-handler-list)
(setf (gdb-handler-pending-trigger handler) nil)))
(defmacro gdb-wait-for-pending (&rest body)
"Wait until `gdb-pending-triggers' is empty and evaluate FORM.
This function checks `gdb-pending-triggers' value every
`gdb-wait-for-pending' seconds."
(run-with-timer
0.5 nil
`(lambda ()
(if (not gdb-pending-triggers)
(progn ,@body)
(gdb-wait-for-pending ,@body)))))
"Wait for all pending GDB commands to finish and evaluate BODY.
This function checks every 0.5 seconds if there are any pending
triggers in `gdb-handler-list'."
`(run-with-timer
0.5 nil
'(lambda ()
(if (not (gdb-find-if (lambda (handler)
(gdb-handler-pending-trigger handler))
gdb-handler-list))
(progn ,@body)
(gdb-wait-for-pending ,@body)))))
;; Publish-subscribe
......@@ -820,14 +901,12 @@ detailed description of this mode.
gdb-frame-number nil
gdb-thread-number nil
gdb-var-list nil
gdb-pending-triggers nil
gdb-output-sink 'user
gdb-location-alist nil
gdb-source-file-list nil
gdb-last-command nil
gdb-token-number 0
gdb-handler-alist '()
gdb-handler-number nil
gdb-handler-list '()
gdb-prompt-name nil
gdb-first-done-or-error t
gdb-buffer-fringe-width (car (window-fringes))
......@@ -1107,17 +1186,15 @@ With arg, enter name of variable to be watched in the minibuffer."
(message-box "No symbol \"%s\" in current context." expr))))
(defun gdb-speedbar-update ()
(when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame)
(not (gdb-pending-p 'gdb-speedbar-timer)))
(when (and (boundp 'speedbar-frame) (frame-live-p speedbar-frame))
;; Dummy command to update speedbar even when idle.
(gdb-input "-environment-pwd" 'gdb-speedbar-timer-fn)
;; Keep gdb-pending-triggers non-nil till end.
(gdb-add-pending 'gdb-speedbar-timer)))
(gdb-input "-environment-pwd"
'gdb-speedbar-timer-fn
'gdb-speedbar-update)))
(defun gdb-speedbar-timer-fn ()
(if gdb-speedbar-auto-raise
(raise-frame speedbar-frame))
(gdb-delete-pending 'gdb-speedbar-timer)
(speedbar-timer-fn))
(defun gdb-var-evaluate-expression-handler (varnum changed)
......@@ -1207,9 +1284,9 @@ With arg, enter name of variable to be watched in the minibuffer."
; Uses "-var-update --all-values". Needs GDB 6.4 onwards.
(defun gdb-var-update ()
(if (not (gdb-pending-p 'gdb-var-update))
(gdb-input "-var-update --all-values *" 'gdb-var-update-handler))
(gdb-add-pending 'gdb-var-update))
(gdb-input "-var-update --all-values *"
'gdb-var-update-handler
'gdb-var-update))
(defun gdb-var-update-handler ()
(let ((changelist (bindat-get-field (gdb-json-partial-output) 'changelist)))
......@@ -1272,8 +1349,6 @@ With arg, enter name of variable to be watched in the minibuffer."
(push var1 var-list))
(setq var1 (pop temp-var-list)))
(setq gdb-var-list (nreverse var-list))))))))
(setq gdb-pending-triggers
(delq 'gdb-var-update gdb-pending-triggers))
(gdb-speedbar-update))
(defun gdb-speedbar-expand-node (text token indent)
......@@ -1727,19 +1802,25 @@ All embedded quotes, newlines, and backslashes are preceded with a backslash."
(setq string (replace-regexp-in-string "\n" "\\n" string t t))
(concat "\"" string "\""))
(defun gdb-input (command handler-function)
(defun gdb-input (command handler-function &optional trigger-name)
"Send COMMAND to GDB via the MI interface.
Run the function HANDLER-FUNCTION, with no arguments, once the command is
complete."
(setq gdb-token-number (1+ gdb-token-number))
(setq command (concat (number-to-string gdb-token-number) command))
complete. Do not send COMMAND to GDB if TRIGGER-NAME is non-nil and
Emacs is still waiting for a reply from another command previously
sent with the same TRIGGER-NAME."
(when (or (not trigger-name)
(not (gdb-pending-handler-p trigger-name)))
(setq gdb-token-number (1+ gdb-token-number))
(setq command (concat (number-to-string gdb-token-number) command))
(if gdb-enable-debug (push (list 'send-item command handler-function)
gdb-debug-log))
(if gdb-enable-debug (push (list 'send-item command handler-function)
gdb-debug-log))
(push (cons gdb-token-number handler-function) gdb-handler-alist)
(if gdbmi-debug-mode (message "gdb-input: %s" command))
(process-send-string (get-buffer-process gud-comint-buffer)
(concat command "\n")))
(gdb-add-handler gdb-token-number handler-function trigger-name)
(if gdbmi-debug-mode (message "gdb-input: %s" command))
(process-send-string (get-buffer-process gud-comint-buffer)
(concat command "\n"))))
;; NOFRAME is used for gud execution control commands
(defun gdb-current-context-command (command)
......@@ -1775,7 +1856,7 @@ If `gdb-thread-number' is nil, just wrap NAME in asterisks."
(defun gdb-resync()
(setq gud-running nil)
(setq gdb-output-sink 'user)
(setq gdb-pending-triggers nil))
(gdb-remove-all-pending-triggers))
(defun gdb-update (&optional no-proc)
"Update buffers showing status of debug session.
......@@ -2256,9 +2337,9 @@ Unset `gdb-thread-number' if current thread exited and update threads list."
(if (string= gdb-thread-number thread-id)
(gdb-setq-thread-number nil))
;; When we continue current thread and it quickly exits,
;; gdb-pending-triggers left after gdb-running disallow us to
;; properly call -thread-info without --thread option. Thus we
;; need to use gdb-wait-for-pending.
;; the pending triggers in gdb-handler-list left after gdb-running
;; disallow us to properly call -thread-info without --thread option.
;; Thus we need to use gdb-wait-for-pending.
(gdb-wait-for-pending
(gdb-emit-signal gdb-buf-publisher 'update-threads))))
......@@ -2273,9 +2354,10 @@ Sets `gdb-thread-number' to new id."
;; by `=thread-selected` notification. `^done` causes `gdb-update`
;; as usually. Things happen to fast and second call (from
;; gdb-thread-selected handler) gets cut off by our beloved
;; gdb-pending-triggers.
;; Solution is `gdb-wait-for-pending` macro: it guarantees that its
;; body will get executed when `gdb-pending-triggers` is empty.
;; pending triggers.
;; Solution is `gdb-wait-for-pending' macro: it guarantees that its
;; body will get executed when `gdb-handler-list' if free of
;; pending triggers.
(gdb-wait-for-pending
(gdb-update))))
......@@ -2439,10 +2521,7 @@ current thread and update GDB buffers."
(when (and token-number is-complete)
(with-current-buffer
(gdb-get-buffer-create 'gdb-partial-output-buffer)
(funcall
(cdr (assoc (string-to-number token-number) gdb-handler-alist))))
(setq gdb-handler-alist
(assq-delete-all token-number gdb-handler-alist)))
(gdb-handle-reply (string-to-number token-number))))
(when is-complete
(gdb-clear-partial-output))))
......@@ -2660,27 +2739,23 @@ trigger argument when describing buffer types with
(when
(or (not ,signal-list)
(memq signal ,signal-list))
(when (not (gdb-pending-p
(cons (current-buffer) ',trigger-name)))
(gdb-input ,gdb-command
(gdb-bind-function-to-buffer ',handler-name (current-buffer)))
(gdb-add-pending (cons (current-buffer) ',trigger-name))))))
(gdb-input ,gdb-command
(gdb-bind-function-to-buffer ',handler-name (current-buffer))
(cons (current-buffer) ',trigger-name)))))
;; Used by disassembly buffer only, the rest use
;; def-gdb-trigger-and-handler
(defmacro def-gdb-auto-update-handler (handler-name trigger-name custom-defun
(defmacro def-gdb-auto-update-handler (handler-name custom-defun
&optional nopreserve)
"Define a handler HANDLER-NAME for TRIGGER-NAME with CUSTOM-DEFUN.
"Define a handler HANDLER-NAME calling CUSTOM-DEFUN.
Handlers are normally called from the buffers they put output in.
Delete ((current-buffer) . TRIGGER-NAME) from
`gdb-pending-triggers', erase current buffer and evaluate
CUSTOM-DEFUN. Then `gdb-update-buffer-name' is called.
Erase current buffer and evaluate CUSTOM-DEFUN.
Then call `gdb-update-buffer-name'.
If NOPRESERVE is non-nil, window point is not restored after CUSTOM-DEFUN."
`(defun ,handler-name ()
(gdb-delete-pending (cons (current-buffer) ',trigger-name))
(let* ((inhibit-read-only t)
,@(unless nopreserve
'((window (get-buffer-window (current-buffer) 0))
......@@ -2708,7 +2783,7 @@ See `def-gdb-auto-update-handler'."
,gdb-command
,handler-name ,signal-list)
(def-gdb-auto-update-handler ,handler-name
,trigger-name ,custom-defun)))
,custom-defun)))
......@@ -3625,7 +3700,6 @@ DOC is an optional documentation string."
(def-gdb-auto-update-handler
gdb-disassembly-handler
gdb-invalidate-disassembly
gdb-disassembly-handler-custom
t)
......@@ -4117,21 +4191,19 @@ member."
;; Needs GDB 6.4 onwards (used to fail with no stack).
(defun gdb-get-changed-registers ()
(when (and (gdb-get-buffer 'gdb-registers-buffer)
(not (gdb-pending-p 'gdb-get-changed-registers)))
(when (gdb-get-buffer 'gdb-registers-buffer)
(gdb-input "-data-list-changed-registers"
'gdb-changed-registers-handler)
(gdb-add-pending 'gdb-get-changed-registers)))
'gdb-changed-registers-handler
'gdb-get-changed-registers)))
(defun gdb-changed-registers-handler ()
(gdb-delete-pending 'gdb-get-changed-registers)
(setq gdb-changed-registers nil)
(dolist (register-number
(bindat-get-field (gdb-json-partial-output) 'changed-registers))
(push register-number gdb-changed-registers)))
(defun gdb-register-names-handler ()
;; Don't use gdb-pending-triggers because this handler is called
;; Don't use pending triggers because this handler is called
;; only once (in gdb-init-1)
(setq gdb-register-names nil)
(dolist (register-name
......@@ -4155,16 +4227,13 @@ is set in them."
(defun gdb-get-main-selected-frame ()
"Trigger for `gdb-frame-handler' which uses main current thread.
Called from `gdb-update'."
(if (not (gdb-pending-p 'gdb-get-main-selected-frame))
(progn
(gdb-input (gdb-current-context-command "-stack-info-frame")
'gdb-frame-handler)
(gdb-add-pending 'gdb-get-main-selected-frame))))
(gdb-input (gdb-current-context-command "-stack-info-frame")
'gdb-frame-handler
'gdb-get-main-selected-frame))
(defun gdb-frame-handler ()
"Set `gdb-selected-frame' and `gdb-selected-file' to show
overlay arrow in source buffer."
(gdb-delete-pending 'gdb-get-main-selected-frame)
(let ((frame (bindat-get-field (gdb-json-partial-output) 'frame)))
(when frame
(setq gdb-selected-frame (bindat-get-field frame 'func))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment