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: 606 bytes --]

> Thanks.  This looks like a very good change indeed.  In order for us to
> include it in Emacs, we need a copyright assignment; I hope you will be
> willing to sign one.  I will contact you off-list about how to do this.

My copyright assignment is finally complete.

While I was waiting for that, I found a problem with my patch.  If you
use the gdb command "finish" to exit from a function, gdb replies with
a dump of the returned value (even though gdb-mi will not show it).
My previous patch was failing with a regexp overflow if the return
value was too big.  This new patch will solve this problem.

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

*** trunk/lisp/progmodes/gdb-mi.el	2013-01-25 23:12:00.065758257 -0500
--- trunk-dev/lisp/progmodes/gdb-mi.el	2013-02-28 21:29:15.634063677 -0500
***************
*** 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))
***************
*** 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
***************
*** 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")))
  
***************
*** 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:
!     (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)
! 
!       ;; 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))
! 	(setq gdbmi-bnf-offset (+ 1 newline-pos)))
! 
!       (if gdbmi-debug-mode (message "gdbmi-bnf-incomplete-record-result: %s" (substring gud-marker-acc gdbmi-bnf-offset newline-pos)))
! 
!       ;; 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 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."
***************
*** 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,2235 ----
  
    ;; 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)))))
! 
!   (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))
  
***************
*** 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)))
--- 2237,2247 ----
    (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)))
***************
*** 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."
--- 2254,2260 ----
      (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."
***************
*** 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
--- 2271,2277 ----
      (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
***************
*** 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
--- 2289,2295 ----
    (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
***************
*** 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
--- 2303,2309 ----
  
  ;; -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
***************
*** 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
--- 2389,2401 ----
    (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
***************
*** 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)
--- 2411,2422 ----
      ;; 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)
***************
*** 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
--- 2425,2443 ----
      (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