From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.bugs Subject: bug#10580: 24.0.92; gdb initialization takes more than one minute at 100 Date: Mon, 11 Mar 2013 13:14:09 -0400 Message-ID: References: <87pq242gvz.fsf@gnu.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1363022127 17182 80.91.229.3 (11 Mar 2013 17:15:27 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Mon, 11 Mar 2013 17:15:27 +0000 (UTC) Cc: Chong Yidong , 10580-done@debbugs.gnu.org To: Jean-Philippe Gravel Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Mon Mar 11 18:15:49 2013 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1UF6K7-0001Ld-6h for geb-bug-gnu-emacs@m.gmane.org; Mon, 11 Mar 2013 18:15:43 +0100 Original-Received: from localhost ([::1]:49382 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UF6Jk-0002fx-Uj for geb-bug-gnu-emacs@m.gmane.org; Mon, 11 Mar 2013 13:15:20 -0400 Original-Received: from eggs.gnu.org ([208.118.235.92]:42690) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UF6Jd-0002fa-Pw for bug-gnu-emacs@gnu.org; Mon, 11 Mar 2013 13:15:18 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1UF6JY-0006U6-Sn for bug-gnu-emacs@gnu.org; Mon, 11 Mar 2013 13:15:13 -0400 Original-Received: from debbugs.gnu.org ([140.186.70.43]:42515) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1UF6JY-0006Tw-Pp for bug-gnu-emacs@gnu.org; Mon, 11 Mar 2013 13:15:08 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.72) (envelope-from ) id 1UF6KR-0003JP-HL for bug-gnu-emacs@gnu.org; Mon, 11 Mar 2013 13:16:03 -0400 Resent-From: Stefan Monnier Original-Sender: debbugs-submit-bounces@debbugs.gnu.org Resent-To: bug-gnu-emacs@gnu.org Resent-Date: Mon, 11 Mar 2013 17:16:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: cc-closed 10580 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Mail-Followup-To: 10580@debbugs.gnu.org, monnier@iro.umontreal.ca, dov.grobgeld@gmail.com Original-Received: via spool by 10580-done@debbugs.gnu.org id=D10580.136302212212678 (code D ref 10580); Mon, 11 Mar 2013 17:16:02 +0000 Original-Received: (at 10580-done) by debbugs.gnu.org; 11 Mar 2013 17:15:22 +0000 Original-Received: from localhost ([127.0.0.1]:46621 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1UF6Ji-0003IO-Jm for submit@debbugs.gnu.org; Mon, 11 Mar 2013 13:15:22 -0400 Original-Received: from ironport2-out.teksavvy.com ([206.248.154.182]:19357) by debbugs.gnu.org with esmtp (Exim 4.72) (envelope-from ) id 1UF6Jd-0003I8-Aw for 10580-done@debbugs.gnu.org; Mon, 11 Mar 2013 13:15:15 -0400 X-IronPort-Anti-Spam-Filtered: true X-IronPort-Anti-Spam-Result: Av8EABK/CFHO+KL9/2dsb2JhbABEvw4Xc4IeAQEEARo8IwULCzQSFA0LDSQTh38DCQa3Sw2JVYwShHgDklqBXY0PgzSBXoMTgUok X-IPAS-Result: Av8EABK/CFHO+KL9/2dsb2JhbABEvw4Xc4IeAQEEARo8IwULCzQSFA0LDSQTh38DCQa3Sw2JVYwShHgDklqBXY0PgzSBXoMTgUok X-IronPort-AV: E=Sophos;i="4.84,565,1355115600"; d="scan'208";a="4218555" Original-Received: from 206-248-162-253.dsl.teksavvy.com (HELO ceviche.home) ([206.248.162.253]) by ironport2-out.teksavvy.com with ESMTP/TLS/ADH-AES256-SHA; 11 Mar 2013 13:14:09 -0400 Original-Received: by ceviche.home (Postfix, from userid 20848) id 7AE4E660E5; Mon, 11 Mar 2013 13:14:09 -0400 (EDT) In-Reply-To: (Jean-Philippe Gravel's message of "Thu, 28 Feb 2013 22:31:03 -0500") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3.50 (gnu/linux) X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.13 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-Received-From: 140.186.70.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Xref: news.gmane.org gmane.emacs.bugs:72320 Archived-At: > 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. Thank you. I just installed it with the following changes (see patch below): - gdbmi-debug-mode is a defvar (such debug stuff doesn't deserve a defcustom). - Use the imperative "Return ..." rather than the present tense "Returns ..." in docstrings, as is the convention. I also integrated a few other suggestions from C-u M-x checkdoc-current-buffer (some of which affect code doesn't come from your patch, and there's more to fix). - Use the new defvar-local. - Fit within 80 columns. - Use lexical-binding for closures. and the following ChangeLog entry: 2013-03-11 Jean-Philippe Gravel * progmodes/gdb-mi.el: Speed up initialization (bug#10580). Use lexical-binding. Fix up docstring according to conventions. (gdbmi-debug-mode): New var. (gdbmi-start-with, gdbmi-same-start, gdbmi-is-number, gdbmi-bnf-init) (gdbmi-bnf-output, gdbmi-bnf-skip-unrecognized, gdbmi-bnf-gdb-prompt) (gdbmi-bnf-result-record, gdbmi-bnf-out-of-band-record) (gdbmi-bnf-async-record, gdbmi-bnf-stream-record) (gdbmi-bnf-console-stream-output, gdbmi-bnf-target-stream-output) (gdbmi-bnf-log-stream-output, gdbmi-bnf-result-and-async-record-impl) (gdbmi-bnf-incomplete-record-result): New functions. (gdb-car<): Remove function. (gdbmi-record-list): Remove variable. (gdbmi-bnf-state, gdbmi-bnf-offset): New vars. (gdbmi-bnf-result-state-configs): New const. (gud-gdbmi-marker-filter): Rewrite. (gdb-ignored-notification, gdb-thread-created, gdb-thread-exited) (gdb-thread-selected, gdb-running, gdb-starting, gdb-stopped): Add `token' argument. (gdb-done, gdb-error): New functions. (gdb-done-or-error): Add `is-complete' argument. Change arg order. Thank you very much for your help, Stefan --- lisp/progmodes/gdb-mi.el 2013-03-11 11:37:36.315869212 -0400 +++ lisp/progmodes/gdb-mi.el.new 2013-03-11 11:37:16.117759642 -0400 @@ -1,4 +1,4 @@ -;;; 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. @@ -192,8 +192,8 @@ (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.") @@ -294,9 +294,7 @@ (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.") @@ -327,8 +325,7 @@ "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") @@ -336,19 +333,18 @@ ;; 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 @@ -404,7 +400,7 @@ :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 @@ -447,8 +443,7 @@ :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") @@ -490,12 +485,12 @@ (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") @@ -507,12 +502,8 @@ :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") +(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)) @@ -577,7 +568,7 @@ (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 @@ -610,7 +601,7 @@ 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. @@ -1263,7 +1254,7 @@ (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 @@ -1277,9 +1268,9 @@ (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))) @@ -1511,7 +1502,7 @@ (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 @@ -1771,8 +1762,7 @@ "*")) (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) @@ -1819,7 +1809,8 @@ ;; 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. @@ -1834,7 +1825,7 @@ 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. @@ -1886,7 +1877,7 @@ (defun gdbmi-start-with (str offset match) - "Returns non-nil if string STR starts with MATCH, else returns nil. + "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))) @@ -1894,7 +1885,7 @@ (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. + "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)) @@ -1904,28 +1895,26 @@ (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." + "Return non-nil iff CHARACTER is a numerical character between 0 and 9." (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. +(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.") -(make-variable-buffer-local 'gdbmi-bnf-state) -(defvar gdbmi-bnf-offset 0 - "Offset in gud-marker-acc at which the parser is reading. +(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.") -(make-variable-buffer-local 'gdbmi-bnf-offset) (defun gdbmi-bnf-init () - "Initializes the GDB/MI message parser" + "Initialize the GDB/MI message parser." (setq gdbmi-bnf-state 'gdbmi-bnf-output) (setq gdbmi-bnf-offset 0) (setq gud-marker-acc "")) @@ -1937,16 +1926,16 @@ 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)) + (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." + "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")) @@ -1956,12 +1945,15 @@ (setq prefix-offset (1+ prefix-offset))) (if (and (< prefix-offset acc-length) - (not (member (aref gud-marker-acc prefix-offset) '(?^ ?* ?+ ?= ?~ ?@ ?&))) + (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)) + (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)) + (if gdbmi-debug-mode + (message "gdbmi-bnf-skip-unrecognized: %s" unrecognized-str)) (gdb-shell unrecognized-str) t)))) @@ -2043,12 +2035,14 @@ '&' 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)) + (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))) + (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)) @@ -2059,16 +2053,16 @@ t)))) (defun gdbmi-bnf-console-stream-output (c-string) - "Handler for the console-stream-output GDB/MI output grammar rule" + "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" +(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" + "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. @@ -2087,23 +2081,26 @@ ("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. + "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).") + '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 + "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)) @@ -2114,7 +2111,8 @@ (if (and (< prefix-offset acc-length) (member (aref gud-marker-acc prefix-offset) '(?* ?+ ?= ?^)) - (string-match "\\([0-9]*\\)\\([*+=^]\\)\\(.+?\\)\\([,\n]\\)" gud-marker-acc gdbmi-bnf-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)) @@ -2124,9 +2122,11 @@ 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))) + (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-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)))) @@ -2136,14 +2136,16 @@ (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))) + (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." +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)) @@ -2154,10 +2156,13 @@ ;; 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 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))) + (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 @@ -2171,7 +2176,8 @@ (if is-complete (funcall (car class-command) token result-str)))) - (unless is-complete ;; Incomplete gdb response: abort the parsing until we receive more data. + (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)) @@ -2242,8 +2248,8 @@ ;; 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." + "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)) @@ -2289,7 +2295,7 @@ (setq gdb-active-process t) (gdb-emit-signal gdb-buf-publisher 'update-threads)) -(defun gdb-starting (_output-field result) +(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 @@ -2462,8 +2468,8 @@ 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. @@ -2630,16 +2636,16 @@ 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 @@ -2668,32 +2674,33 @@ Delete ((current-buffer) . TRIGGER-NAME) from `gdb-pending-triggers', erase current buffer and evaluate -CUSTOM-DEFUN. Then `gdb-update-buffer-name' is called. +CUSTOM-DEFUN. Then `gdb-update-buffer-name' is called. 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 @@ -3050,37 +3057,38 @@ 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)))) @@ -3096,8 +3104,8 @@ "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)) @@ -3246,7 +3254,7 @@ (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) @@ -3748,8 +3756,7 @@ (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. @@ -4133,7 +4140,7 @@ (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) @@ -4144,8 +4151,8 @@ (gdb-init-buffer))))) (defun gdb-get-main-selected-frame () - "Trigger for `gdb-frame-handler' which uses main current -thread. Called from `gdb-update'." + "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") @@ -4153,7 +4160,7 @@ (gdb-add-pending '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))) @@ -4214,8 +4221,8 @@ (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 @@ -4603,8 +4610,7 @@ (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)))