bug#10580: 24.0.92; gdb initialization takes more than one minute at 100

[Jean-Philippe Gravel <jpgravel@gmail.com>]

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

Here is my patch.

As stated previously, I only re-wrote gud-gdbmi-marker-filter.  This
function now parses the GDB/MI records in the order of arrival.  Only
the signature of each record is read by the new parser.  The actual
content of the record (i.e. result strings) is still parsed by the
original code (which I will refer to as the record handlers below).

The new parser is based on the GDB/MI output BNF grammar available at:
ftp://ftp.gnu.org/pub/old-gnu/Manuals/gdb/html_node/gdb_214.html#SEC221

Records that are too large to be received in one data chunk can be
parsed progressively by the record handlers, if they support it.  The
global configuration alist “gdbmi-bnf-result-state-configs” defines
the mapping between record types and record handlers.  This structure
flags all the handlers as either progressive or atomic.

Progressive handlers are invokes as soon as a partial data chunks are
received.  Atomic handlers on the other hand will not be invoked until
the whole record is received.  This design allowed me to progressively
attack the optimization problem: the ^done / ^error messages being the
biggest bottleneck (the reply to -file-list-exec-source-files), I
started by only converting those to progressive parsing.  If we find
that other messages cause performance issue, we can always convert
them to progressive parsing as well.

That being said, while the handler for ^done and ^error
(gdb-done-or-error) do receive the data progressively, it doesn’t
parse it on the fly.  Instead, it accumulates the data chunks in a
temporary buffer and parses its content only when the record is
complete.  This is sub-optimal, but my tests showed that optimizing
this part would have only a minimal effect compared to fixing
gud-gdbmi-marker-filter.  I decided to keep this as a separate
optimization task, to be done later.

For performance reason, I tried to keep processing and data copy to a
minimum.  I therefore work in-place, directly in the gud-marker-acc
string, instead of copying the string to a temporary buffer.  The
parser walks in the string using an offset stored in gdbmi-bnf-offset.
 By looking at the character at this offset, I can quickly detect the
type of record we received, BEFORE trying to parse it with
string-match.

Note: I am a little confused about when the parser states should be
(re)initialized.  I would have expected the states to be initialized
before the GDB process is started (before gud-common-init) because
once the process starts, the marker-filter can be invoked at any time.
 Instead, I find that the gdb-mi variables are all initialized in
gdb-init-1, which runs after the process is started.  I added a new
function gdbmi-bnf-init that is invoked from within gdb-init-1, but
that doesn’t seem right.  Does anyone have an opinion on this?  I
certainly do think there is currently a problem because if the GDB/MI
initialization is interrupted expectedly (for instance because of an
error), it seems to restart in a very bad state the next time (I think
that's true even before my fix)…

Jean-Philippe

[-- Attachment #2: gdb-mi-optimization-1.patch --]
[-- Type: application/octet-stream, Size: 23973 bytes --]

=== modified file 'lisp/progmodes/gdb-mi.el'
*** lisp/progmodes/gdb-mi.el	2012-10-18 19:46:18 +0000
--- lisp/progmodes/gdb-mi.el	2012-12-18 04:32:26 +0000
*************** Also display the main routine in the dis
*** 507,512 ****
--- 507,519 ----
    :group 'gdb
    :version "22.1")
  
+ (defcustom gdbmi-debug-mode nil
+   "When non-nil, all the messages sent or received from GDB/MI are printed in
+ the *Messages* buffer."
+   :type 'boolean
+   :group 'gud
+   :version "24.3")
+ 
  (defun gdb-force-mode-line-update (status)
    (let ((buffer gud-comint-buffer))
      (if (and buffer (buffer-name buffer))
*************** detailed description of this mode.
*** 846,851 ****
--- 853,860 ----
          gdb-register-names '()
          gdb-non-stop gdb-non-stop-setting)
    ;;
+   (gdbmi-bnf-init)
+   ;;
    (setq gdb-buffer-type 'gdbmi)
    ;;
    (gdb-force-mode-line-update
*************** complete."
*** 1739,1744 ****
--- 1748,1754 ----
    (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)
+   (if gdbmi-debug-mode (message "gdb-input: %s" command))
    (process-send-string (get-buffer-process gud-comint-buffer)
  		       (concat command "\n")))
  
*************** is running."
*** 1874,1896 ****
        (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 gud-gdbmi-marker-filter (string)
    "Filter GDB/MI output."
--- 1884,2205 ----
        (set-window-buffer source-window buffer))
      source-window))
  
  
! (defun gdbmi-start-with (str offset match)
!   "Returns 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)
!   "Returns non-nil if STR and MATCH are equal up to the end of either strings, else returns nil.
! 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)
! "Returns non-nil if CHARACTER is a numerical character between 0 and 9,
! else returns nil."
!   (and (>= character ?0)
!        (<= character ?9)))
! 
! 
! (defvar 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.")
! (make-variable-buffer-local 'gdbmi-bnf-state)
! 
! (defvar 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.")
! (make-variable-buffer-local 'gdbmi-bnf-offset)
! 
! (defun gdbmi-bnf-init ()
!   "Initializes 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 ()
! "Used as a protection mechanism in case something goes wrong when parsing
! a GDB/MI reply message.  This function will skip characters until is encounters
! the beginning of a valid record."
!   (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 (member (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)))))
!   "Two dimensional alist, 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' handler 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 rule 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:
!     (if (string-match "\\([^\n]*\\)\\(\n?\\)" gud-marker-acc gdbmi-bnf-offset)
! 
!         (let ((result (match-string 1 gud-marker-acc))
!               (is-complete (string-equal (match-string 2 gud-marker-acc) "\n"))
!               (is-progressive (equal (cdr class-command) 'progressive)))
! 
!           ;; Update the gdbmi-bnf-offset only if the current chunk of data can
!           ;; be processed by the class-command handler:
!           (if (or is-complete is-progressive)
!               (setq gdbmi-bnf-offset (match-end 0)))
! 
! 	  (if gdbmi-debug-mode (message "gdbmi-bnf-incomplete-record-result: %s" (match-string 0 gud-marker-acc)))
! 
!           ;; 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 is-complete)
!                 (if is-complete
!                     (funcall (car class-command) token result))))
! 
!           (unless is-complete ;; Incomplete gdb response: abort the 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."
*************** is running."
*** 1907,1952 ****
  
    ;; 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)))
  
!     gdb-filter-output))
  
  (defun gdb-gdb (_output-field))
  
--- 2216,2234 ----
  
    ;; Start accumulating output for the GUD buffer.
    (setq gdb-filter-output "")
  
!   (let ((acc-length (length gud-marker-acc)))
!     (catch 'gdbmi-incomplete-stream
!       (while (and (< gdbmi-bnf-offset acc-length)
! 		  (funcall gdbmi-bnf-state)))))
  
!   (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))
  
*************** is running."
*** 1954,1964 ****
    (setq gdb-filter-output
          (concat output-field gdb-filter-output)))
  
! (defun gdb-ignored-notification (_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."
    (let* ((thread-id (bindat-get-field (gdb-json-string output-field) 'id)))
--- 2236,2246 ----
    (setq gdb-filter-output
          (concat output-field gdb-filter-output)))
  
! (defun gdb-ignored-notification (_token _output-field))
  
  ;; gdb-invalidate-threads is defined to accept 'update-threads signal
! (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)))
*************** is running."
*** 1971,1977 ****
      (gdb-wait-for-pending
       (gdb-emit-signal gdb-buf-publisher 'update-threads))))
  
! (defun gdb-thread-selected (output-field)
    "Handler for =thread-selected MI output record.
  
  Sets `gdb-thread-number' to new id."
--- 2253,2259 ----
      (gdb-wait-for-pending
       (gdb-emit-signal gdb-buf-publisher 'update-threads))))
  
! (defun gdb-thread-selected (_token output-field)
    "Handler for =thread-selected MI output record.
  
  Sets `gdb-thread-number' to new id."
*************** Sets `gdb-thread-number' to new id."
*** 1988,1994 ****
      (gdb-wait-for-pending
       (gdb-update))))
  
! (defun gdb-running (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
--- 2270,2276 ----
      (gdb-wait-for-pending
       (gdb-update))))
  
! (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
*************** Sets `gdb-thread-number' to new id."
*** 2006,2012 ****
    (setq gdb-active-process t)
    (gdb-emit-signal gdb-buf-publisher 'update-threads))
  
! (defun gdb-starting (_output-field)
    ;; CLI commands don't emit ^running at the moment so use gdb-running too.
    (setq gdb-inferior-status "running")
    (gdb-force-mode-line-update
--- 2288,2294 ----
    (setq gdb-active-process t)
    (gdb-emit-signal gdb-buf-publisher 'update-threads))
  
! (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
*************** Sets `gdb-thread-number' to new id."
*** 2020,2026 ****
  
  ;; -break-insert -t didn't give a reason before gdb 6.9
  
! (defun gdb-stopped (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
--- 2302,2308 ----
  
  ;; -break-insert -t didn't give a reason before gdb 6.9
  
! (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
*************** current thread and update GDB buffers."
*** 2106,2112 ****
    (setq gdb-filter-output
  	(gdb-concat-output gdb-filter-output (read output-field))))
  
! (defun gdb-done-or-error (output-field token-number type)
    (if (string-equal token-number "")
        ;; Output from command entered by user
        (progn
--- 2388,2400 ----
    (setq gdb-filter-output
  	(gdb-concat-output gdb-filter-output (read output-field))))
  
! (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
*************** current thread and update GDB buffers."
*** 2122,2135 ****
      ;; 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
        (unless (or token-number gud-running no-proc)
  	(setq gdb-filter-output (concat gdb-filter-output gdb-prompt-name)))
        (gdb-update no-proc)
--- 2410,2421 ----
      ;; Output from command from frontend.
      (setq gdb-output-sink 'emacs))
  
    ;; 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 (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)
*************** current thread and update GDB buffers."
*** 2138,2150 ****
      (setq gdb-filter-output
  	  (gdb-concat-output gdb-filter-output output-field))
  
!     (when token-number
        (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)))))
  
  (defun gdb-concat-output (so-far new)
    (cond
--- 2424,2442 ----
      (setq gdb-filter-output
  	  (gdb-concat-output gdb-filter-output output-field))
  
!     ;; 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)))
! 
!   (when is-complete
!     (gdb-clear-partial-output))))
  
  (defun gdb-concat-output (so-far new)
    (cond