-;;; gdb-mi.el --- User Interface for running GDB
+;;; gdb-mi.el --- User Interface for running GDB -*- lexical-binding: t -*-
;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
(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))
(defvar gdb-disassembly-position nil)
(defvar gdb-location-alist nil
- "Alist of breakpoint numbers and full filenames. Only used for files that
-Emacs can't find.")
+ "Alist of breakpoint numbers and full filenames.
+Only used for files that Emacs can't find.")
(defvar gdb-active-process nil
"GUD tooltips display variable values when t, and macro definitions otherwise.")
(defvar gdb-error "Non-nil when GDB is reporting an error.")
(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)
It is initialized to `gdb-non-stop-setting' at the beginning of
every GDB session.")
-(defvar gdb-buffer-type nil
+(defvar-local gdb-buffer-type nil
"One of the symbols bound in `gdb-buffer-rules'.")
-(make-variable-buffer-local 'gdb-buffer-type)
(defvar gdb-output-sink 'nil
"The disposition of the output of the current gdb command.
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 (cl-find-if (lambda (handler)
+ (gdb-handler-pending-trigger handler))
+ gdb-handler-list))
+ (progn ,@body)
+ (gdb-wait-for-pending ,@body)))))
;; Publish-subscribe
(funcall (cdr subscriber) signal)))
(defvar gdb-buf-publisher '()
- "Used to invalidate GDB buffers by emitting a signal in
-`gdb-update'.
-
+ "Used to invalidate GDB buffers by emitting a signal in `gdb-update'.
Must be a list of pairs with cars being buffers and cdr's being
valid signal handlers.")
"When in non-stop mode, stopped threads can be examined while
other threads continue to execute.
-GDB session needs to be restarted for this setting to take
-effect."
+GDB session needs to be restarted for this setting to take effect."
:type 'boolean
:group 'gdb-non-stop
:version "23.2")
;; TODO Some commands can't be called with --all (give a notice about
;; it in setting doc)
(defcustom gdb-gud-control-all-threads t
- "When enabled, GUD execution commands affect all threads when
-in non-stop mode. Otherwise, only current thread is affected."
+ "When non-nil, GUD execution commands affect all threads when
+in non-stop mode. Otherwise, only current thread is affected."
:type 'boolean
:group 'gdb-non-stop
:version "23.2")
(defcustom gdb-switch-reasons t
- "List of stop reasons which cause Emacs to switch to the thread
-which caused the stop. When t, switch to stopped thread no matter
-what the reason was. When nil, never switch to stopped thread
-automatically.
+ "List of stop reasons for which Emacs should switch thread.
+When t, switch to stopped thread no matter what the reason was.
+When nil, never switch to stopped thread automatically.
-This setting is used in non-stop mode only. In all-stop mode,
+This setting is used in non-stop mode only. In all-stop mode,
Emacs always switches to the thread which caused the stop."
;; exited, exited-normally and exited-signaled are not
;; thread-specific stop reasons and therefore are not included in
:link '(info-link "(gdb)GDB/MI Async Records"))
(defcustom gdb-switch-when-another-stopped t
- "When nil, Emacs won't switch to stopped thread if some other
+ "When nil, don't switch to stopped thread if some other
stopped thread is already selected."
:type 'boolean
:group 'gdb-non-stop
:version "23.2")
(defcustom gdb-show-threads-by-default nil
- "Show threads list buffer instead of breakpoints list by
-default."
+ "Show threads list buffer instead of breakpoints list by default."
:type 'boolean
:group 'gdb-buffers
:version "23.2")
(defcustom gdb-create-source-file-list t
"Non-nil means create a list of files from which the executable was built.
- Set this to nil if the GUD buffer displays \"initializing...\" in the mode
- line for a long time when starting, possibly because your executable was
- built from a large number of files. This allows quicker initialization
- but means that these files are not automatically enabled for debugging,
- e.g., you won't be able to click in the fringe to set a breakpoint until
- execution has already stopped there."
+Set this to nil if the GUD buffer displays \"initializing...\" in the mode
+line for a long time when starting, possibly because your executable was
+built from a large number of files. This allows quicker initialization
+but means that these files are not automatically enabled for debugging,
+e.g., you won't be able to click in the fringe to set a breakpoint until
+execution has already stopped there."
:type 'boolean
:group 'gdb
:version "23.1")
:group 'gdb
:version "22.1")
+(defvar gdbmi-debug-mode nil
+ "When non-nil, print the messages sent/received from GDB/MI in *Messages*.")
+
(defun gdb-force-mode-line-update (status)
(let ((buffer gud-comint-buffer))
(if (and buffer (buffer-name buffer))
(defmacro gdb-gud-context-call (cmd1 &optional cmd2 noall noarg)
"`gud-call' wrapper which adds --thread/--all options between
-CMD1 and CMD2. NOALL is the same as in `gdb-gud-context-command'.
+CMD1 and CMD2. NOALL is the same as in `gdb-gud-context-command'.
NOARG must be t when this macro is used outside `gud-def'"
`(gud-call
(concat (gdb-gud-context-command ,cmd1 ,noall) " " ,cmd2)
,(when (not noarg) 'arg)))
-(defun gdb--check-interpreter (proc string)
+(defun gdb--check-interpreter (filter proc string)
(unless (zerop (length string))
- (let ((filter (process-get proc 'gud-normal-filter)))
- (set-process-filter proc filter)
- (unless (memq (aref string 0) '(?^ ?~ ?@ ?& ?* ?=))
- ;; Apparently we're not running with -i=mi.
- (let ((msg "Error: you did not specify -i=mi on GDB's command line!"))
- (message msg)
- (setq string (concat (propertize msg 'font-lock-face 'error)
- "\n" string)))
- ;; Use the old gud-gbd filter, not because it works, but because it
- ;; will properly display GDB's answers rather than hanging waiting for
- ;; answers that aren't coming.
- (set (make-local-variable 'gud-marker-filter) #'gud-gdb-marker-filter))
- (funcall filter proc string))))
+ (remove-function (process-filter proc) #'gdb--check-interpreter)
+ (unless (memq (aref string 0) '(?^ ?~ ?@ ?& ?* ?=))
+ ;; Apparently we're not running with -i=mi.
+ (let ((msg "Error: you did not specify -i=mi on GDB's command line!"))
+ (message msg)
+ (setq string (concat (propertize msg 'font-lock-face 'error)
+ "\n" string)))
+ ;; Use the old gud-gbd filter, not because it works, but because it
+ ;; will properly display GDB's answers rather than hanging waiting for
+ ;; answers that aren't coming.
+ (set (make-local-variable 'gud-marker-filter) #'gud-gdb-marker-filter))
+ (funcall filter proc string)))
(defvar gdb-control-level 0)
COMMAND-LINE is the shell command for starting the gdb session.
It should be a string consisting of the name of the gdb
-executable followed by command-line options. The command-line
+executable followed by command line options. The command line
options should include \"-i=mi\" to use gdb's MI text interface.
Note that the old \"--annotate\" option is no longer supported.
-If `gdb-many-windows' is nil (the default value) then gdb just
+If option `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
+If option `gdb-many-windows' is t, regardless of the value of
`gdb-show-main', the layout below will appear. Keybindings are
shown in some of the buffers.
;; Setup a temporary process filter to warn when GDB was not started
;; with -i=mi.
(let ((proc (get-buffer-process gud-comint-buffer)))
- (process-put proc 'gud-normal-filter (process-filter proc))
- (set-process-filter proc #'gdb--check-interpreter))
+ (add-function :around (process-filter proc) #'gdb--check-interpreter))
(set (make-local-variable 'gud-minor-mode) 'gdbmi)
(set (make-local-variable 'gdb-control-level) 0)
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))
gdb-register-names '()
gdb-non-stop gdb-non-stop-setting)
;;
+ (gdbmi-bnf-init)
+ ;;
(setq gdb-buffer-type 'gdbmi)
;;
(gdb-force-mode-line-update
(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)
; 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)))
(cond
((> new previous)
;; Add new children to list.
- (dotimes (dummy previous)
+ (dotimes (_ previous)
(push (pop temp-var-list) var-list))
(dolist (child children)
(let ((varchild
(push varchild var-list))))
;; Remove deleted children from list.
((< new previous)
- (dotimes (dummy new)
+ (dotimes (_ new)
(push (pop temp-var-list) var-list))
- (dotimes (dummy (- previous new))
+ (dotimes (_ (- previous new))
(pop temp-var-list)))))
(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)
(gdb-input
(concat "-inferior-tty-set " tty) 'ignore))))
-(defun gdb-inferior-io-sentinel (proc str)
+(defun gdb-inferior-io-sentinel (proc _str)
(when (eq (process-status proc) 'failed)
;; When the debugged process exits, Emacs gets an EIO error on
;; read from the pty, and stops listening to it. If the gdb
As long as GDB is in the recursive reading loop, it does not expect
commands to be prefixed by \"-interpreter-exec console\".")
+(defun gdb-strip-string-backslash (string)
+ (replace-regexp-in-string "\\\\$" "" string))
+
(defun gdb-send (proc string)
"A comint send filter for gdb."
(with-current-buffer gud-comint-buffer
(remove-text-properties (point-min) (point-max) '(face))))
;; mimic <RET> key to repeat previous command in GDB
(if (not (string= "" string))
- (setq gdb-last-command string)
- (if gdb-last-command (setq string gdb-last-command)))
- (if (or (string-match "^-" string)
- (> gdb-control-level 0))
+ (if gdb-continuation
+ (setq gdb-last-command (concat gdb-continuation
+ (gdb-strip-string-backslash string)
+ " "))
+ (setq gdb-last-command (gdb-strip-string-backslash string)))
+ (if gdb-last-command (setq string gdb-last-command))
+ (setq gdb-continuation nil))
+ (if (and (not gdb-continuation) (or (string-match "^-" string)
+ (> gdb-control-level 0)))
;; Either MI command or we are feeding GDB's recursive reading loop.
(progn
(setq gdb-first-done-or-error t)
(setq gdb-control-level (1- gdb-control-level))))
;; CLI command
(if (string-match "\\\\$" string)
- (setq gdb-continuation (concat gdb-continuation string "\n"))
+ (setq gdb-continuation
+ (concat gdb-continuation (gdb-strip-string-backslash
+ string)
+ " "))
(setq gdb-first-done-or-error t)
(let ((to-send (concat "-interpreter-exec console "
- (gdb-mi-quote string)
+ (gdb-mi-quote (concat gdb-continuation string " "))
"\n")))
(if gdb-enable-debug
(push (cons 'mi-send to-send) gdb-debug-log))
(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."
- (if gdb-enable-debug (push (list 'send-item command handler-function)
- gdb-debug-log))
- (setq gdb-token-number (1+ gdb-token-number))
- (setq command (concat (number-to-string gdb-token-number) command))
- (push (cons gdb-token-number handler-function) gdb-handler-alist)
- (process-send-string (get-buffer-process gud-comint-buffer)
- (concat command "\n")))
+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))
+
+ (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)
"*"))
(defun gdb-current-context-mode-name (mode)
- "Add thread information to MODE which is to be used as
-`mode-name'."
+ "Add thread information to MODE which is to be used as `mode-name'."
(concat mode
(if gdb-thread-number
(format " [thread %s]" gdb-thread-number)
(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.
;; because we may need to update current gud-running value without
;; changing current thread (see gdb-running)
(defun gdb-setq-thread-number (number)
- "Only this function must be used to change `gdb-thread-number'
+ "Set `gdb-thread-number' to NUMBER.
+Only this function must be used to change `gdb-thread-number'
value to NUMBER, because `gud-running' and `gdb-frame-number'
need to be updated appropriately when current thread changes."
;; GDB 6.8 and earlier always output thread-id="0" when stopping.
Note that when `gdb-gud-control-all-threads' is t, `gud-running'
cannot be reliably used to determine whether or not execution
-control buttons should be shown in menu or toolbar. Use
+control buttons should be shown in menu or toolbar. Use
`gdb-running-threads-count' and `gdb-stopped-threads-count'
instead.
(set-window-buffer source-window buffer))
source-window))
-(defun gdb-car< (a b)
- (< (car a) (car b)))
-
-(defvar gdbmi-record-list
- '((gdb-gdb . "(gdb) \n")
- (gdb-done . "\\([0-9]*\\)\\^done,?\\(.*?\\)\n")
- (gdb-starting . "\\([0-9]*\\)\\^running\n")
- (gdb-error . "\\([0-9]*\\)\\^error,\\(.*?\\)\n")
- (gdb-console . "~\\(\".*?\"\\)\n")
- (gdb-internals . "&\\(\".*?\"\\)\n")
- (gdb-stopped . "\\*stopped,?\\(.*?\\)\n")
- (gdb-running . "\\*running,\\(.*?\n\\)")
- (gdb-thread-created . "=thread-created,\\(.*?\n\\)")
- (gdb-thread-selected . "=thread-selected,\\(.*?\\)\n")
- (gdb-thread-exited . "=thread-exited,\\(.*?\n\\)")
- (gdb-ignored-notification . "=[-[:alpha:]]+,?\\(.*?\\)\n")
- (gdb-shell . "\\(\\(?:^.+\n\\)+\\)")))
+
+(defun gdbmi-start-with (str offset match)
+ "Return non-nil if string STR starts with MATCH, else returns nil.
+OFFSET is the position in STR at which the comparison takes place."
+ (let ((match-length (length match))
+ (str-length (- (length str) offset)))
+ (when (>= str-length match-length)
+ (string-equal match (substring str offset (+ offset match-length))))))
+
+(defun gdbmi-same-start (str offset match)
+ "Return non-nil iff STR and MATCH are equal up to the end of either strings.
+OFFSET is the position in STR at which the comparison takes place."
+ (let* ((str-length (- (length str) offset))
+ (match-length (length match))
+ (compare-length (min str-length match-length)))
+ (when (> compare-length 0)
+ (string-equal (substring str offset (+ offset compare-length))
+ (substring match 0 compare-length)))))
+
+(defun gdbmi-is-number (character)
+ "Return non-nil iff CHARACTER is a numerical character between 0 and 9."
+ (and (>= character ?0)
+ (<= character ?9)))
+
+
+(defvar-local gdbmi-bnf-state 'gdbmi-bnf-output
+ "Current GDB/MI output parser state.
+The parser is placed in a different state when an incomplete data steam is
+received from GDB.
+This variable will preserve the state required to resume the parsing
+when more data arrives.")
+
+(defvar-local gdbmi-bnf-offset 0
+ "Offset in `gud-marker-acc' at which the parser is reading.
+This offset is used to be able to parse the GDB/MI message
+in-place, without the need of copying the string in a temporary buffer
+or discarding parsed tokens by substringing the message.")
+
+(defun gdbmi-bnf-init ()
+ "Initialize the GDB/MI message parser."
+ (setq gdbmi-bnf-state 'gdbmi-bnf-output)
+ (setq gdbmi-bnf-offset 0)
+ (setq gud-marker-acc ""))
+
+
+(defun gdbmi-bnf-output ()
+ "Implementation of the following GDB/MI output grammar rule:
+
+ output ==>
+ ( out-of-band-record )* [ result-record ] gdb-prompt"
+
+ (gdbmi-bnf-skip-unrecognized)
+ (while (gdbmi-bnf-out-of-band-record))
+ (gdbmi-bnf-result-record)
+ (gdbmi-bnf-gdb-prompt))
+
+
+(defun gdbmi-bnf-skip-unrecognized ()
+ "Skip characters until is encounters the beginning of a valid record.
+Used as a protection mechanism in case something goes wrong when parsing
+a GDB/MI reply message."
+ (let ((acc-length (length gud-marker-acc))
+ (prefix-offset gdbmi-bnf-offset)
+ (prompt "(gdb) \n"))
+
+ (while (and (< prefix-offset acc-length)
+ (gdbmi-is-number (aref gud-marker-acc prefix-offset)))
+ (setq prefix-offset (1+ prefix-offset)))
+
+ (if (and (< prefix-offset acc-length)
+ (not (memq (aref gud-marker-acc prefix-offset)
+ '(?^ ?* ?+ ?= ?~ ?@ ?&)))
+ (not (gdbmi-same-start gud-marker-acc gdbmi-bnf-offset prompt))
+ (string-match "\\([^^*+=~@&]+\\)" gud-marker-acc
+ gdbmi-bnf-offset))
+ (let ((unrecognized-str (match-string 0 gud-marker-acc)))
+ (setq gdbmi-bnf-offset (match-end 0))
+ (if gdbmi-debug-mode
+ (message "gdbmi-bnf-skip-unrecognized: %s" unrecognized-str))
+ (gdb-shell unrecognized-str)
+ t))))
+
+
+(defun gdbmi-bnf-gdb-prompt ()
+ "Implementation of the following GDB/MI output grammar rule:
+ gdb-prompt ==>
+ '(gdb)' nl
+
+ nl ==>
+ CR | CR-LF"
+
+ (let ((prompt "(gdb) \n"))
+ (when (gdbmi-start-with gud-marker-acc gdbmi-bnf-offset prompt)
+ (if gdbmi-debug-mode (message "gdbmi-bnf-gdb-prompt: %s" prompt))
+ (gdb-gdb prompt)
+ (setq gdbmi-bnf-offset (+ gdbmi-bnf-offset (length prompt)))
+
+ ;; Returns non-nil to tell gud-gdbmi-marker-filter we've reached
+ ;; the end of a GDB reply message.
+ t)))
+
+
+(defun gdbmi-bnf-result-record ()
+ "Implementation of the following GDB/MI output grammar rule:
+
+ result-record ==>
+ [ token ] '^' result-class ( ',' result )* nl
+
+ token ==>
+ any sequence of digits."
+
+ (gdbmi-bnf-result-and-async-record-impl))
+
+
+(defun gdbmi-bnf-out-of-band-record ()
+ "Implementation of the following GDB/MI output grammar rule:
+
+ out-of-band-record ==>
+ async-record | stream-record"
+
+ (or (gdbmi-bnf-async-record)
+ (gdbmi-bnf-stream-record)))
+
+
+(defun gdbmi-bnf-async-record ()
+ "Implementation of the following GDB/MI output grammar rules:
+
+ async-record ==>
+ exec-async-output | status-async-output | notify-async-output
+
+ exec-async-output ==>
+ [ token ] '*' async-output
+
+ status-async-output ==>
+ [ token ] '+' async-output
+
+ notify-async-output ==>
+ [ token ] '=' async-output
+
+ async-output ==>
+ async-class ( ',' result )* nl"
+
+ (gdbmi-bnf-result-and-async-record-impl))
+
+
+(defun gdbmi-bnf-stream-record ()
+ "Implement the following GDB/MI output grammar rule:
+ stream-record ==>
+ console-stream-output | target-stream-output | log-stream-output
+
+ console-stream-output ==>
+ '~' c-string
+
+ target-stream-output ==>
+ '@' c-string
+
+ log-stream-output ==>
+ '&' c-string"
+ (when (< gdbmi-bnf-offset (length gud-marker-acc))
+ (if (and (member (aref gud-marker-acc gdbmi-bnf-offset) '(?~ ?@ ?&))
+ (string-match "\\([~@&]\\)\\(\".*?\"\\)\n" gud-marker-acc
+ gdbmi-bnf-offset))
+ (let ((prefix (match-string 1 gud-marker-acc))
+ (c-string (match-string 2 gud-marker-acc)))
+
+ (setq gdbmi-bnf-offset (match-end 0))
+ (if gdbmi-debug-mode (message "gdbmi-bnf-stream-record: %s"
+ (match-string 0 gud-marker-acc)))
+
+ (cond ((string-equal prefix "~")
+ (gdbmi-bnf-console-stream-output c-string))
+ ((string-equal prefix "@")
+ (gdbmi-bnf-target-stream-output c-string))
+ ((string-equal prefix "&")
+ (gdbmi-bnf-log-stream-output c-string)))
+ t))))
+
+(defun gdbmi-bnf-console-stream-output (c-string)
+ "Handler for the console-stream-output GDB/MI output grammar rule."
+ (gdb-console c-string))
+
+(defun gdbmi-bnf-target-stream-output (_c-string)
+ "Handler for the target-stream-output GDB/MI output grammar rule."
+ ;; Not currently used.
+ )
+
+(defun gdbmi-bnf-log-stream-output (c-string)
+ "Handler for the log-stream-output GDB/MI output grammar rule."
+ ;; Suppress "No registers." GDB 6.8 and earlier
+ ;; duplicates MI error message on internal stream.
+ ;; Don't print to GUD buffer.
+ (if (not (string-equal (read c-string) "No registers.\n"))
+ (gdb-internals c-string)))
+
+
+(defconst gdbmi-bnf-result-state-configs
+ '(("^" . (("done" . (gdb-done . progressive))
+ ("error" . (gdb-error . progressive))
+ ("running" . (gdb-starting . atomic))))
+ ("*" . (("stopped" . (gdb-stopped . atomic))
+ ("running" . (gdb-running . atomic))))
+ ("+" . ())
+ ("=" . (("thread-created" . (gdb-thread-created . atomic))
+ ("thread-selected" . (gdb-thread-selected . atomic))
+ ("thread-existed" . (gdb-ignored-notification . atomic))
+ ('default . (gdb-ignored-notification . atomic)))))
+ "Alist of alists, mapping the type and class of message to a handler function.
+Handler functions are all flagged as either `progressive' or `atomic'.
+`progressive' handlers are capable of parsing incomplete messages.
+They can be called several time with new data chunk as they arrive from GDB.
+`progressive' handlers must have an extra argument that is set to a non-nil
+value when the message is complete.
+
+Implement the following GDB/MI output grammar rule:
+ result-class ==>
+ 'done' | 'running' | 'connected' | 'error' | 'exit'
+
+ async-class ==>
+ 'stopped' | others (where others will be added depending on the needs
+ --this is still in development).")
+
+(defun gdbmi-bnf-result-and-async-record-impl ()
+ "Common implementation of the result-record and async-record rule.
+Both rules share the same syntax. Those records may be very large in size.
+For that reason, the \"result\" part of the record is parsed by
+`gdbmi-bnf-incomplete-record-result', which will keep
+receiving characters as they arrive from GDB until the record is complete."
+ (let ((acc-length (length gud-marker-acc))
+ (prefix-offset gdbmi-bnf-offset))
+
+ (while (and (< prefix-offset acc-length)
+ (gdbmi-is-number (aref gud-marker-acc prefix-offset)))
+ (setq prefix-offset (1+ prefix-offset)))
+
+ (if (and (< prefix-offset acc-length)
+ (member (aref gud-marker-acc prefix-offset) '(?* ?+ ?= ?^))
+ (string-match "\\([0-9]*\\)\\([*+=^]\\)\\(.+?\\)\\([,\n]\\)"
+ gud-marker-acc gdbmi-bnf-offset))
+
+ (let ((token (match-string 1 gud-marker-acc))
+ (prefix (match-string 2 gud-marker-acc))
+ (class (match-string 3 gud-marker-acc))
+ (complete (string-equal (match-string 4 gud-marker-acc) "\n"))
+ class-alist
+ class-command)
+
+ (setq gdbmi-bnf-offset (match-end 0))
+ (if gdbmi-debug-mode (message "gdbmi-bnf-result-record: %s"
+ (match-string 0 gud-marker-acc)))
+
+ (setq class-alist
+ (cdr (assoc prefix gdbmi-bnf-result-state-configs)))
+ (setq class-command (cdr (assoc class class-alist)))
+ (if (null class-command)
+ (setq class-command (cdr (assoc 'default class-alist))))
+
+ (if complete
+ (if class-command
+ (if (equal (cdr class-command) 'progressive)
+ (funcall (car class-command) token "" complete)
+ (funcall (car class-command) token "")))
+ (setq gdbmi-bnf-state
+ (lambda ()
+ (gdbmi-bnf-incomplete-record-result token class-command)))
+ (funcall gdbmi-bnf-state))
+ t))))
+
+(defun gdbmi-bnf-incomplete-record-result (token class-command)
+ "State of the parser used to progressively parse a result-record or async-record
+rule from an incomplete data stream. The parser will stay in this state until
+the end of the current result or async record is reached."
+ (when (< gdbmi-bnf-offset (length gud-marker-acc))
+ ;; Search the data stream for the end of the current record:
+ (let* ((newline-pos (string-match "\n" gud-marker-acc gdbmi-bnf-offset))
+ (is-progressive (equal (cdr class-command) 'progressive))
+ (is-complete (not (null newline-pos)))
+ result-str)
+
+ (when gdbmi-debug-mode
+ (message "gdbmi-bnf-incomplete-record-result: %s"
+ (substring gud-marker-acc gdbmi-bnf-offset newline-pos)))
+
+ ;; Update the gdbmi-bnf-offset only if the current chunk of data can
+ ;; be processed by the class-command handler:
+ (when (or is-complete is-progressive)
+ (setq result-str
+ (substring gud-marker-acc gdbmi-bnf-offset newline-pos))
+
+ ;; Move gdbmi-bnf-offset past the end of the chunk.
+ (setq gdbmi-bnf-offset (+ gdbmi-bnf-offset (length result-str)))
+ (when newline-pos
+ (setq gdbmi-bnf-offset (1+ gdbmi-bnf-offset))))
+
+ ;; Update the parsing state before invoking the handler in class-command
+ ;; to make sure it's not left in an invalid state if the handler was
+ ;; to generate an error.
+ (if is-complete
+ (setq gdbmi-bnf-state 'gdbmi-bnf-output))
+
+ (if class-command
+ (if is-progressive
+ (funcall (car class-command) token result-str is-complete)
+ (if is-complete
+ (funcall (car class-command) token result-str))))
+
+ (unless is-complete
+ ;; Incomplete gdb response: abort parsing until we receive more data.
+ (if gdbmi-debug-mode (message "gdbmi-bnf-incomplete-record-result, aborting: incomplete stream"))
+ (throw 'gdbmi-incomplete-stream nil))
+
+ is-complete)))
+
+
+; The following grammar rules are not yet implemented by this GDBMI-BNF parser.
+; The handling of those rules is currently done by the handlers registered
+; in gdbmi-bnf-result-state-configs
+;
+; result ==>
+; variable "=" value
+;
+; variable ==>
+; string
+;
+; value ==>
+; const | tuple | list
+;
+; const ==>
+; c-string
+;
+; tuple ==>
+; "{}" | "{" result ( "," result )* "}"
+;
+; list ==>
+; "[]" | "[" value ( "," value )* "]" | "[" result ( "," result )* "]"
+
(defun gud-gdbmi-marker-filter (string)
"Filter GDB/MI output."
;; Start accumulating output for the GUD buffer.
(setq gdb-filter-output "")
- (let (output-record-list)
-
- ;; Process all the complete markers in this chunk.
- (dolist (gdbmi-record gdbmi-record-list)
- (while (string-match (cdr gdbmi-record) gud-marker-acc)
- (push (list (match-beginning 0)
- (car gdbmi-record)
- (match-string 1 gud-marker-acc)
- (match-string 2 gud-marker-acc)
- (match-end 0))
- output-record-list)
- (setq gud-marker-acc
- (concat (substring gud-marker-acc 0 (match-beginning 0))
- ;; Pad with spaces to preserve position.
- (make-string (length (match-string 0 gud-marker-acc)) 32)
- (substring gud-marker-acc (match-end 0))))))
-
- (setq output-record-list (sort output-record-list 'gdb-car<))
-
- (dolist (output-record output-record-list)
- (let ((record-type (cadr output-record))
- (arg1 (nth 2 output-record))
- (arg2 (nth 3 output-record)))
- (cond ((eq record-type 'gdb-error)
- (gdb-done-or-error arg2 arg1 'error))
- ((eq record-type 'gdb-done)
- (gdb-done-or-error arg2 arg1 'done))
- ;; Suppress "No registers." GDB 6.8 and earlier
- ;; duplicates MI error message on internal stream.
- ;; Don't print to GUD buffer.
- ((not (and (eq record-type 'gdb-internals)
- (string-equal (read arg1) "No registers.\n")))
- (funcall record-type arg1)))))
- (setq gdb-output-sink 'user)
- ;; Remove padding.
- (string-match "^ *" gud-marker-acc)
- (setq gud-marker-acc (substring gud-marker-acc (match-end 0)))
+ (let ((acc-length (length gud-marker-acc)))
+ (catch 'gdbmi-incomplete-stream
+ (while (and (< gdbmi-bnf-offset acc-length)
+ (funcall gdbmi-bnf-state)))))
- gdb-filter-output))
+ (when (/= gdbmi-bnf-offset 0)
+ (setq gud-marker-acc (substring gud-marker-acc gdbmi-bnf-offset))
+ (setq gdbmi-bnf-offset 0))
+
+ (when (and gdbmi-debug-mode (> (length gud-marker-acc) 0))
+ (message "gud-gdbmi-marker-filter, unparsed string: %s" gud-marker-acc))
+
+ gdb-filter-output)
(defun gdb-gdb (_output-field))
(setq gdb-filter-output
(concat output-field gdb-filter-output)))
-(defun gdb-ignored-notification (_output-field))
+(defun gdb-ignored-notification (_token _output-field))
;; gdb-invalidate-threads is defined to accept 'update-threads signal
-(defun gdb-thread-created (_output-field))
-(defun gdb-thread-exited (output-field)
- "Handle =thread-exited async record: unset `gdb-thread-number'
- if current thread exited and update threads list."
+(defun gdb-thread-created (_token _output-field))
+(defun gdb-thread-exited (_token output-field)
+ "Handle =thread-exited async record.
+Unset `gdb-thread-number' if current thread exited and update threads list."
(let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'id)))
(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))))
-(defun gdb-thread-selected (output-field)
+(defun gdb-thread-selected (_token output-field)
"Handler for =thread-selected MI output record.
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))))
-(defun gdb-running (output-field)
+(defun gdb-running (_token output-field)
(let* ((thread-id
(bindat-get-field (gdb-json-string output-field) 'thread-id)))
;; We reset gdb-frame-number to nil if current thread has gone
(propertize gdb-inferior-status 'face font-lock-type-face))
(when (not gdb-non-stop)
(setq gud-running t))
- (setq gdb-active-process t)
- (gdb-emit-signal gdb-buf-publisher 'update-threads))
+ (setq gdb-active-process t))
-(defun gdb-starting (_output-field)
+(defun gdb-starting (_output-field _result)
;; CLI commands don't emit ^running at the moment so use gdb-running too.
(setq gdb-inferior-status "running")
(gdb-force-mode-line-update
(propertize gdb-inferior-status 'face font-lock-type-face))
(setq gdb-active-process t)
- (setq gud-running t)
- ;; GDB doesn't seem to respond to -thread-info before first stop or
- ;; thread exit (even in non-stop mode), so this is useless.
- ;; Behavior may change in the future.
- (gdb-emit-signal gdb-buf-publisher 'update-threads))
+ (setq gud-running t))
;; -break-insert -t didn't give a reason before gdb 6.9
-(defun gdb-stopped (output-field)
+(defun gdb-stopped (_token output-field)
"Given the contents of *stopped MI async record, select new
current thread and update GDB buffers."
;; Reason is available with target-async only
(setq gdb-filter-output
(gdb-concat-output gdb-filter-output (read output-field))))
-(defun gdb-done-or-error (output-field token-number type)
+(defun gdb-done (token-number output-field is-complete)
+ (gdb-done-or-error token-number 'done output-field is-complete))
+
+(defun gdb-error (token-number output-field is-complete)
+ (gdb-done-or-error token-number 'error output-field is-complete))
+
+(defun gdb-done-or-error (token-number type output-field is-complete)
(if (string-equal token-number "")
;; Output from command entered by user
(progn
;; Output from command from frontend.
(setq gdb-output-sink 'emacs))
- (gdb-clear-partial-output)
-
;; The process may already be dead (e.g. C-d at the gdb prompt).
(let* ((proc (get-buffer-process gud-comint-buffer))
(no-proc (or (null proc)
(memq (process-status proc) '(exit signal)))))
- (when gdb-first-done-or-error
+ (when (and is-complete gdb-first-done-or-error)
(unless (or token-number gud-running no-proc)
(setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
(gdb-update no-proc)
(setq gdb-filter-output
(gdb-concat-output gdb-filter-output output-field))
- (when token-number
+ ;; We are done concatenating to the output sink. Restore it to user sink:
+ (setq gdb-output-sink 'user)
+
+ (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))))
(defun gdb-concat-output (so-far new)
(cond
replaced with semicolons.
If FIX-KEY is non-nil, strip all \"FIX-KEY=\" occurrences from
-partial output. This is used to get rid of useless keys in lists
-in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and
+partial output. This is used to get rid of useless keys in lists
+in MI messages, e.g.: [key=.., key=..]. -stack-list-frames and
-break-info are examples of MI commands which issue such
responses.
(row-properties nil)
(right-align nil))
-(defun gdb-mapcar* (function &rest seqs)
- "Apply FUNCTION to each element of SEQS, and make a list of the results.
-If there are several SEQS, FUNCTION is called with that many
-arguments, and mapping stops as soon as the shortest list runs
-out."
- (let ((shortest (apply #'min (mapcar #'length seqs))))
- (mapcar (lambda (i)
- (apply function
- (mapcar
- (lambda (seq)
- (nth i seq))
- seqs)))
- (number-sequence 0 (1- shortest)))))
-
(defun gdb-table-add-row (table row &optional properties)
"Add ROW of string to TABLE and recalculate column sizes.
(setf (gdb-table-row-properties table)
(append row-properties (list properties)))
(setf (gdb-table-column-sizes table)
- (gdb-mapcar* (lambda (x s)
+ (cl-mapcar (lambda (x s)
(let ((new-x
(max (abs x) (string-width (or s "")))))
(if right-align new-x (- new-x))))
(let ((column-sizes (gdb-table-column-sizes table)))
(mapconcat
'identity
- (gdb-mapcar*
+ (cl-mapcar
(lambda (row properties)
(apply 'propertize
(mapconcat 'identity
- (gdb-mapcar* (lambda (s x) (gdb-pad-string s x))
+ (cl-mapcar (lambda (s x) (gdb-pad-string s x))
row column-sizes)
sep)
properties))
handler-name
&optional signal-list)
"Define a trigger TRIGGER-NAME which sends GDB-COMMAND and sets
-HANDLER-NAME as its handler. HANDLER-NAME is bound to current
+HANDLER-NAME as its handler. HANDLER-NAME is bound to current
buffer with `gdb-bind-function-to-buffer'.
If SIGNAL-LIST is non-nil, GDB-COMMAND is sent only when the
-defined trigger is called with an argument from SIGNAL-LIST. It's
+defined trigger is called with an argument from SIGNAL-LIST. It's
not recommended to define triggers with empty SIGNAL-LIST.
Normally triggers should respond at least to 'update signal.
Normally the trigger defined by this command must be called from
-the buffer where HANDLER-NAME must work. This should be done so
+the buffer where HANDLER-NAME must work. This should be done so
that buffer-local thread number may be used in GDB-COMMAND (by
calling `gdb-current-context-command').
`gdb-bind-function-to-buffer' is used to achieve this, see
(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* ((buffer-read-only nil)
- (window (get-buffer-window (current-buffer) 0))
- (start (window-start window))
- (p (window-point window)))
+ (let* ((inhibit-read-only t)
+ ,@(unless nopreserve
+ '((window (get-buffer-window (current-buffer) 0))
+ (start (window-start window))
+ (p (window-point window)))))
(erase-buffer)
(,custom-defun)
(gdb-update-buffer-name)
- ,(when (not nopreserve)
- '(set-window-start window start)
- '(set-window-point window p)))))
+ ,@(when (not nopreserve)
+ '((set-window-start window start)
+ (set-window-point window p))))))
(defmacro def-gdb-trigger-and-handler (trigger-name gdb-command
handler-name custom-defun
&optional signal-list)
"Define trigger and handler.
-TRIGGER-NAME trigger is defined to send GDB-COMMAND. See
-`def-gdb-auto-update-trigger'.
+TRIGGER-NAME trigger is defined to send GDB-COMMAND.
+See `def-gdb-auto-update-trigger'.
-HANDLER-NAME handler uses customization of CUSTOM-DEFUN. See
-`def-gdb-auto-update-handler'."
+HANDLER-NAME handler uses customization of CUSTOM-DEFUN.
+See `def-gdb-auto-update-handler'."
`(progn
(def-gdb-auto-update-trigger ,trigger-name
,gdb-command
,handler-name ,signal-list)
(def-gdb-auto-update-handler ,handler-name
- ,trigger-name ,custom-defun)))
+ ,custom-defun)))
\f
gdb-running-threads-count
gdb-stopped-threads-count))
- (gdb-table-add-row table
- (list
- (bindat-get-field thread 'id)
- (concat
- (if gdb-thread-buffer-verbose-names
- (concat (bindat-get-field thread 'target-id) " ") "")
- (bindat-get-field thread 'state)
- ;; Include frame information for stopped threads
- (if (not running)
- (concat
- " in " (bindat-get-field thread 'frame 'func)
- (if gdb-thread-buffer-arguments
- (concat
- " ("
- (let ((args (bindat-get-field thread 'frame 'args)))
- (mapconcat
- (lambda (arg)
- (apply #'format "%s=%s"
- (gdb-get-many-fields arg 'name 'value)))
- args ","))
- ")")
- "")
- (if gdb-thread-buffer-locations
- (gdb-frame-location (bindat-get-field thread 'frame)) "")
- (if gdb-thread-buffer-addresses
- (concat " at " (bindat-get-field thread 'frame 'addr)) ""))
- "")))
- (list
- 'gdb-thread thread
- 'mouse-face 'highlight
- 'help-echo "mouse-2, RET: select thread")))
+ (gdb-table-add-row
+ table
+ (list
+ (bindat-get-field thread 'id)
+ (concat
+ (if gdb-thread-buffer-verbose-names
+ (concat (bindat-get-field thread 'target-id) " ") "")
+ (bindat-get-field thread 'state)
+ ;; Include frame information for stopped threads
+ (if (not running)
+ (concat
+ " in " (bindat-get-field thread 'frame 'func)
+ (if gdb-thread-buffer-arguments
+ (concat
+ " ("
+ (let ((args (bindat-get-field thread 'frame 'args)))
+ (mapconcat
+ (lambda (arg)
+ (apply #'format "%s=%s"
+ (gdb-get-many-fields arg 'name 'value)))
+ args ","))
+ ")")
+ "")
+ (if gdb-thread-buffer-locations
+ (gdb-frame-location (bindat-get-field thread 'frame)) "")
+ (if gdb-thread-buffer-addresses
+ (concat " at " (bindat-get-field thread 'frame 'addr)) ""))
+ "")))
+ (list
+ 'gdb-thread thread
+ 'mouse-face 'highlight
+ 'help-echo "mouse-2, RET: select thread")))
(when (string-equal gdb-thread-number
(bindat-get-field thread 'id))
(setq marked-line (length gdb-threads-list))))
"Define a NAME command which will act upon thread on the current line.
CUSTOM-DEFUN may use locally bound `thread' variable, which will
-be the value of 'gdb-thread property of the current line. If
-'gdb-thread is nil, error is signaled."
+be the value of 'gdb-thread property of the current line.
+If `gdb-thread' is nil, error is signaled."
`(defun ,name (&optional event)
,(when doc doc)
(interactive (list last-input-event))
(defun gdb-memory-column-width (size format)
"Return length of string with memory unit of SIZE in FORMAT.
-SIZE is in bytes, as in `gdb-memory-unit'. FORMAT is a string as
+SIZE is in bytes, as in `gdb-memory-unit'. FORMAT is a string as
in `gdb-memory-format'."
(let ((format-base (cdr (assoc format
'(("x" . 16)
(def-gdb-auto-update-handler
gdb-disassembly-handler
- gdb-invalidate-disassembly
gdb-disassembly-handler-custom
t)
(error "Not recognized as break/watchpoint line")))))
(defun gdb-goto-breakpoint (&optional event)
- "Go to the location of breakpoint at current line of
-breakpoints buffer."
+ "Go to the location of breakpoint at current line of breakpoints buffer."
(interactive (list last-input-event))
(if event (posn-set-point (event-end event)))
;; Hack to stop gdb-goto-breakpoint displaying in GUD buffer.
;; 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
(defun gdb-get-source-file-list ()
"Create list of source files for current GDB session.
-If buffers already exist for any of these files, gud-minor-mode
+If buffers already exist for any of these files, `gud-minor-mode'
is set in them."
(goto-char (point-min))
(while (re-search-forward gdb-source-file-regexp nil t)
(gdb-init-buffer)))))
(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))))
+ "Trigger for `gdb-frame-handler' which uses main current thread.
+Called from `gdb-update'."
+ (gdb-input (gdb-current-context-command "-stack-info-frame")
+ 'gdb-frame-handler
+ 'gdb-get-main-selected-frame))
(defun gdb-frame-handler ()
- "Sets `gdb-selected-frame' and `gdb-selected-file' to show
+ "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))
(defun gdb-preempt-existing-or-display-buffer (buf &optional split-horizontal)
"Find window displaying a buffer with the same
-`gdb-buffer-type' as BUF and show BUF there. If no such window
-exists, just call `gdb-display-buffer' for BUF. If the window
+`gdb-buffer-type' as BUF and show BUF there. If no such window
+exists, just call `gdb-display-buffer' for BUF. If the window
found is already dedicated, split window according to
SPLIT-HORIZONTAL and show BUF in the new window."
(if buf
(set-window-dedicated-p window t))
(defun gdb-setup-windows ()
- "Layout the window pattern for `gdb-many-windows'."
+ "Layout the window pattern for option `gdb-many-windows'."
(gdb-get-buffer-create 'gdb-locals-buffer)
(gdb-get-buffer-create 'gdb-stack-buffer)
(gdb-get-buffer-create 'gdb-breakpoints-buffer)
(defun gdb-restore-windows ()
"Restore the basic arrangement of windows used by gdb.
-This arrangement depends on the value of `gdb-many-windows'."
+This arrangement depends on the value of option `gdb-many-windows'."
(interactive)
(switch-to-buffer gud-comint-buffer) ;Select the right window and frame.
(delete-other-windows)
(gud-gdb-fetch-lines-break (length context))
(gud-gdb-fetched-lines nil)
;; This filter dumps output lines to `gud-gdb-fetched-lines'.
- (gud-marker-filter #'gud-gdbmi-fetch-lines-filter)
- complete-list)
+ (gud-marker-filter #'gud-gdbmi-fetch-lines-filter))
(with-current-buffer (gdb-get-buffer 'gdb-partial-output-buffer)
(gdb-input (concat "complete " context command)
(lambda () (setq gud-gdb-fetch-lines-in-progress nil)))