Add a selector function as a way to avoid running all the tasks

* lisp/emacs-lisp/erb.el (erb-task-select-function): New variable.
(erb--benchmark-one-commit): Use it.

benchmark/lisp/cus-theme-tasks.el

@@ -0,0 +1,30 @@
+;;; cus-theme-tasks.el --- Custom Themes -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell <gazally@runbox.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'erb-task)
+
+(erb-deftask cus-theme-tasks-load-tango ()
+  "Load the tango theme."
+  (:version "1.0" :special own-process)
+  (erb-task-time (load-theme 'tango)))
+
+(provide 'cus-theme-tasks)
+;;; cus-theme-tasks.el ends here

benchmark/lisp/emacs-lisp/bytecomp-tasks.el

@@ -0,0 +1,100 @@
+ ;;; bytecomp-tasks.el --- Byte Compilation -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell <gazally@runbox.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'erb-task)
+(require 'bytecomp)
+
+(defvar bytecomp-tasks-doctor-doc
+  '(defun doctor-doc ()
+     (cond
+      ((equal doctor-sent '(foo))
+       (doctor-type '(bar! (doc$ doctor--please) (doc$ doctor--continue) \.)))
+      ((member doctor-sent doctor--howareyoulst)
+       (doctor-type '(i\'m ok \.  (doc$ doctor--describe) yourself \.)))
+      ((or (member doctor-sent '((good bye) (see you later) (i quit) (so long)
+                                 (go away) (get lost)))
+           (memq (car doctor-sent)
+                 '(bye halt break quit done exit goodbye
+                       bye\, stop pause goodbye\, stop pause)))
+       (doctor-type (doc$ doctor--bye)))
+      ((and (eq (car doctor-sent) 'you)
+            (memq (cadr doctor-sent) doctor--abusewords))
+       (setq doctor-found (cadr doctor-sent))
+       (doctor-type (doc$ doctor--abuselst)))
+      ((eq (car doctor-sent) 'whatmeans)
+       (doctor-def (cadr doctor-sent)))
+      ((equal doctor-sent '(parse))
+       (doctor-type (list  'subj '= doctor-subj ",  "
+                           'verb '= doctor-verb "\n"
+                           'object 'phrase '= doctor-obj ","
+                           'noun 'form '=  doctor-object "\n"
+                           'current 'keyword 'is doctor-found
+                           ", "
+                           'most 'recent 'possessive
+                           'is doctor-owner "\n"
+                           'sentence 'used 'was
+                           "..."
+                           '(doc// doctor--bak))))
+      ((memq (car doctor-sent) '(are is do has have how when where who why))
+       (doctor-type (doc$ doctor--qlist)))
+      ;;   ((eq (car sent) 'forget)
+      ;;    (set (cadr sent) nil)
+      ;;    (doctor-type '((doc$ doctor--isee) (doc$ doctor--please)
+      ;;     (doc$ doctor--continue)\.)))
+      (t
+       (if (doctor-defq doctor-sent) (doctor-define doctor-sent doctor-found))
+       (if (> (length doctor-sent) 12)
+           (setq doctor-sent (doctor-shorten doctor-sent)))
+       (setq doctor-sent (doctor-correct-spelling
+                          (doctor-replace doctor-sent doctor--replist)))
+       (cond ((and (not (memq 'me doctor-sent)) (not (memq 'i doctor-sent))
+                   (memq 'am doctor-sent))
+              (setq doctor-sent (doctor-replace doctor-sent '((am . (are)))))))
+       (cond ((equal (car doctor-sent) 'yow) (doctor-zippy))
+             ((< (length doctor-sent) 2)
+              (cond ((eq (doctor-meaning (car doctor-sent)) 'howdy)
+                     (doctor-howdy))
+                    (t (doctor-short))))
+             (t
+              (if (memq 'am doctor-sent)
+                  (setq doctor-sent (doctor-replace doctor-sent '((me . (i))))))
+              (setq doctor-sent (doctor-fixup doctor-sent))
+              (if (and (eq (car doctor-sent) 'do) (eq (cadr doctor-sent) 'not))
+                  (cond ((zerop (random 3))
+                         (doctor-type '(are you (doc$ doctor--afraidof) that \?)))
+                        ((zerop (random 2))
+                         (doctor-type '(don\'t tell me what to do \. i am the
+                                               doctor here!))
+                         (doctor-rthing))
+                        (t
+                         (doctor-type '((doc$ doctor--whysay) that i shouldn\'t
+                                        (cddr doctor-sent)
+                                        \?))))
+                (doctor-go (doctor-wherego doctor-sent)))))))))
+
+(erb-deftask bytecomp-tasks-compile-doc ()
+  "Byte compile a function."
+  (:version "1.0" :discard-first-sample t)
+  (let ((byte-compile-warnings nil))
+    (erb-task-time (byte-compile bytecomp-tasks-doctor-doc))))
+
+(provide 'bytecomp-tasks)
+;;; bytecomp-tasks.el ends here

benchmark/lisp/kmacro-tasks.el

@@ -0,0 +1,44 @@
+ ;;; kmacro-tasks.el --- Enhanced Keyboard Macros -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell <gazally@runbox.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'erb-task)
+(require 'kmacro)
+
+(erb-deftask kmacro-tasks-edit-lines ()
+  "Edit lines of text using a keyboard macro."
+  (:version "1.0" :discard-first-sample t)
+  (with-temp-buffer
+    (let ((last-kbd-macro (vconcat (kbd "C-s . ")
+                                   [return]
+                                   (kbd "C-f C-SPC C-a C-w C-e M-b")
+                                   [backspace backspace]
+                                   (kbd "C-SPC C-e C-w C-a C-y SPC C-n C-a"))))
+      (dotimes (i 10) (insert (format "%s. Flintstone, Fred\n" i)))
+      (pop-to-buffer (current-buffer))
+
+      (erb-task-time
+       (goto-char (point-min))
+       (ignore-errors (kmacro-call-macro 0 nil))
+       (goto-char (point-max))
+       (forward-line -1)))))
+
+(provide 'kmacro-tasks)
+;;; kmacro-tasks.el ends here

benchmark/lisp/textmodes/fill-tasks.el

@@ -0,0 +1,38 @@
+;;; fill-tasks.el --- Fill Commands -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell <gazally@runbox.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'erb-task)
+
+(erb-deftask fill-tasks-fill-paragraph ()
+  "Create a long single line paragraph and use fill-paragraph."
+  (:version "1.0")
+  (with-temp-buffer
+    (dotimes (_i 100)
+      (insert "Lorem ipsum dolor sit amet, consectetur adipiscing elit.  "))
+    (insert "\n")
+    (pop-to-buffer (current-buffer))
+
+    (erb-task-time
+     (goto-char (point-min))
+     (fill-paragraph))))
+
+(provide 'fill-tasks)
+;;; fill-tasks.el ends here

benchmark/src/cmds-tasks.el

@@ -0,0 +1,40 @@
+;;; cmds-tasks.el --- Simple Editing Commands -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell <gazally@runbox.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'erb-task)
+
+(defun cmds-tasks-setup-buffer (count)
+  (dotimes (i count)
+      (insert (format "%s. Lorem ipsum dolor sit amet, consectetur adipiscing elit.\n" i)))
+    (pop-to-buffer (current-buffer)))
+
+(erb-deftask cmds-tasks-forward-line ()
+  "Use forward-line to navigate through a buffer."
+  (:version "1.0")
+  (with-temp-buffer
+    (cmds-tasks-setup-buffer 10000)
+    (erb-task-time
+     (goto-char (point-min))
+     (while (< (point) (point-max))
+       (forward-line)))))
+
+(provide 'cmds-tasks)
+;;; cmds-tasks.el ends here

benchmark/src/data-tasks.el

@@ -0,0 +1,40 @@
+;;; data-tasks.el --- Primitive Operations on Lisp Data Types -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell <gazally@runbox.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'erb-task)
+
+(erb-deftask data-tasks-prime-p ()
+  "Verify that a large prime number is prime."
+  (:version "1.0")
+  (erb-task-time (data-tasks-prime-p 2305843009)))
+
+(defun data-tasks-prime-p (n)
+  (or (= n 2)
+      (and (> n 2)
+           (= 1 (% n 2))
+           (catch 'not-prime
+             (dotimes (i (1+ (truncate (sqrt n))))
+               (when (and (> i 2) (zerop (% n i)))
+                 (throw 'not-prime nil)))
+             t))))
+
+(provide 'data-tasks)
+;;; data-tasks.el ends here

benchmark/src/emacs-tasks.el

@@ -0,0 +1,29 @@
+;;; emacs-tasks.el --- Emacs Startup and Shutdown -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell <gazally@runbox.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'erb-task)
+
+(erb-deftask emacs-tasks-startup ()
+  "Start up and shut down Emacs."
+  (:version "1.0" :special startup))
+
+(provide 'emacs-tasks)
+;;; emacs-tasks.el ends here

benchmark/src/syntax-tasks.el

@@ -0,0 +1,50 @@
+;;; syntax-tasks.el --- Syntax Tables -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell <gazally@runbox.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'erb-task)
+
+(defun syntax-tasks-setup-buffer (count)
+  (dotimes (i count)
+      (insert (format "%s. Lorem ipsum dolor sit amet, consectetur adipiscing elit.\n" i)))
+    (pop-to-buffer (current-buffer)))
+
+(erb-deftask syntax-tasks-forward-word ()
+  "Use `forward-word' to navigate through a buffer."
+  (:version "1.0")
+  (with-temp-buffer
+    (syntax-tasks-setup-buffer 1000)
+    (erb-task-time
+     (goto-char (point-min))
+     (while (< (point) (point-max))
+       (forward-word)))))
+
+(erb-deftask syntax-tasks-backward-word ()
+  "Use `forward-word' to navigate backwards through a buffer."
+  (:version "1.0")
+  (with-temp-buffer
+    (syntax-tasks-setup-buffer 1000)
+    (erb-task-time
+     (goto-char (point-max))
+     (while (> (point) (point-min))
+       (forward-word -1)))))
+
+(provide 'syntax-tasks)
+;;; syntax-tasks.el ends here

lisp/emacs-lisp/debug.el

@@ -169,14 +169,28 @@ first will be printed into the backtrace buffer."
    (inhibit-redisplay
     ;; Don't really try to enter debugger within an eval from redisplay.
     debugger-value)
-   ((and (eq t (framep (selected-frame)))
-         (equal "initial_terminal" (terminal-name)))
+   ((or (and (eq t (framep (selected-frame)))
+             (equal "initial_terminal" (terminal-name)))
+        (and (bound-and-true-p main-thread)
+             (not (eq main-thread (current-thread)))))
+    ;; Either:
     ;; We're in the initial-frame (where `message' just outputs to stdout) so
     ;; there's no tty or GUI frame to display the backtrace and interact with
-    ;; it: just dump a backtrace to stdout.
+    ;; it.
+    ;;
     ;; This happens for example while handling an error in code from
     ;; early-init.el with --debug-init.
+    ;;
+    ;; Or:
+    ;; We're in a non-main thread, in which keyboard interaction is currently
+    ;; not implemented.
+    ;;
+    ;; So:
+    ;; Just dump a backtrace to stdout/Messages.
     (message "Error: %S" args)
+    (when (and (bound-and-true-p main-thread)
+               (not (eq main-thread (current-thread))))
+      (message "Thread: %s" (current-thread)))
     (let ((print-escape-newlines t)
           (print-escape-control-characters t)
           (print-level 8)

lisp/emacs-lisp/erb-task.el

@@ -0,0 +1,299 @@
+;;; erb-task.el --- Emacs Regression Benchmarking -*- lexical-binding: t -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell
+;; Keywords: lisp, tools
+;; Version: 1.0
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; ERB is a tool for automated benchmarking in Emacs Lisp.  This file
+;; implements defining and running benchmark tasks within an Emacs
+;; instance.
+
+;; See the file erb.el for the rest of ERB, which implements a user
+;; interface for building older versions of Emacs, running the
+;; benchmark tasks in them, managing a database of results, and
+;; presenting them.
+
+;; For usage information, see ERB's info manual.
+
+;; Significant changes to benchmark.el over the years:
+;;   In Emacs 21 500ae43022, benchmark.el was added.
+;;   In Emacs 23 e2bac5f625, benchmark-elapse was changed to use
+;;     float-time and time-subtract.
+;;   In Emacs 26 c7d2a0dd76, repetitions is allowed to be a symbol.
+
+;;; Code:
+
+;; Since it is necessary to load this file into older versions of
+;; Emacs in order to define benchmark tasks for them to run, the code
+;; in this file must avoid using features or libraries which are not
+;; present in those older versions.
+(require 'benchmark)
+
+;;; Define benchmark tasks
+
+(defmacro erb-deftask (name _arglist &rest docstring-keys-and-body)
+  "Define NAME (a symbol) as a benchmark task.
+
+BODY is evaluated as a `progn' when the task is run.  It should
+contain a `erb-task-time' form wrapping the code to be
+benchmarked.  Any setup or cleanup work done outside of the
+`erb-task-time' form will not be benchmarked.
+
+DOCSTRING-KEYS-AND-BODY may begin with an optional docstring and
+an optional plist.  Valid keywords for use as properties in the
+plist are:
+
+:version
+
+  A version number for this task, which should be increased if the
+  task is changed sufficiently to invalidate previous measurements.
+
+:rev-list
+
+  A list of strings to use as arguments to git-rev-list(1) to get
+  the list of commits for which this task should be run.
+
+:discard-first-sample
+
+  If non-nil, discard the result of the first run of the task.
+  Use this if you notice the first sample is consistently much
+  larger than the following samples.
+
+:special
+
+  If this exists and the value is `startup' a body for the task
+  is not required, and the benchmark runner will instead time the
+  startup and shutdown of Emacs.  If the value is `own-process',
+  run this task in its own process instead of a process shared
+  with other tasks."
+
+  (declare (indent 2)
+           (doc-string 3)
+           (debug (&define :name task
+                           name sexp [&optional stringp]
+                           [&optional (&rest keywordp sexp)]
+                           def-body)))
+  (let ((documentation nil)
+        (keys nil))
+    (when (stringp (car-safe docstring-keys-and-body))
+      (setq documentation (car docstring-keys-and-body))
+      (pop docstring-keys-and-body))
+    (when (keywordp (car-safe (car-safe docstring-keys-and-body)))
+      (setq keys (car docstring-keys-and-body))
+      (pop docstring-keys-and-body))
+    `(progn
+       (erb-task--set ',name
+                      (erb-task--create-task ',name ,documentation ',keys
+                                             (lambda ()
+                                               ,@docstring-keys-and-body)))
+       ',name)))
+
+(defun erb-task--key-plist-p (list)
+  "Return non-nil if LIST is a plist using keywords valid in ERB.
+Those are :version, :rev-list, :discard-first-sample, and
+:special."
+  (while (consp list)
+    (setq list (if (and (consp (cdr list))
+                        (or (and (eq (car list) :version)
+                                 (stringp (cadr list)))
+                            (and (eq (car list) :rev-list)
+                                 (listp (cadr list)))
+                            (and (eq (car list) :special) (symbolp (cadr list)))
+                            (eq (car list) :discard-first-sample)))
+                   (cddr list)
+                 'not-plist)))
+  (null list))
+
+(defvar erb-task--result nil)
+
+(defmacro erb-task-time (&rest body)
+  "Save timing results for BODY.
+Use this macro inside of a benchmark task defined by
+`benchmark-deftask' to define the code to be benchmarked.  Only
+use it once per task."
+  ;; TODO should this collect gc statistics?
+  ;; as in (memory-use-counts) before and after,
+  ;; do subtraction and sum
+  `(progn
+     (garbage-collect)
+     (setq erb-task--result (benchmark-run ,@body))))
+
+;;;  Internal representation of tasks
+
+;; Use an alist so as not to have to worry about what
+;; cl-defstruct was called in old versions of Emacs.
+(defun erb-task--create-task (name doc keys body)
+  (unless (erb-task--key-plist-p keys)
+    (error "Keyword plist for %s contains unexpected keys"
+           name))
+  `((:name . ,name)
+    (:documentation . ,doc)
+    (:key-plist . ,keys)
+    (:body . ,body)
+    ,(cons :results nil)
+    ,(cons :messages nil)))
+
+(defsubst erb-task--name (task)
+  (alist-get :name task))
+(defsubst erb-task--documentation (task)
+  (alist-get :documentation task))
+(defsubst erb-task--body (task)
+  (alist-get :body task))
+(defsubst erb-task--key-plist (task)
+  (alist-get :key-plist task))
+(defsubst erb-task--results (task)
+  (alist-get :results task))
+(defsubst erb-task--add-result (result task)
+  (push result (alist-get :results task)))
+(defsubst erb-task--discard-result (task)
+  (pop (alist-get :results task)))
+(defsubst erb-task--messages (task)
+  (alist-get :messages task))
+(defsubst erb-task--add-message (message task)
+  (push message (alist-get :messages task)))
+
+(defun erb-task--boundp (symbol)
+  "Return non-nil if SYMBOL names a task."
+  (and (get symbol 'erb-task) t))
+
+(defun erb-task--get-task (symbol)
+  "If SYMBOL names a task, return that.  Signal an error otherwise."
+  (unless (erb-task--boundp symbol)
+    (error "No task named `%S'" symbol))
+  (get symbol 'erb-task))
+
+(defun erb-task--all-symbols ()
+  (apropos-internal "" #'erb-task--boundp))
+
+(defun erb-task--version (task)
+  (plist-get (erb-task--key-plist task) :version))
+
+(defun erb-task--rev-list (task)
+  (plist-get (erb-task--key-plist task) :rev-list))
+
+(defun erb-task--set (symbol definition)
+  "Make SYMBOL name the task DEFINITION, and return DEFINITION."
+  (when (eq symbol 'nil)
+    (error "Attempt to define a task named nil"))
+  (put symbol 'erb-task definition)
+  definition)
+
+(defun erb-task--make-unbound (symbol)
+  "Make SYMBOL name no task.
+Return SYMBOL."
+  (put symbol 'erb-task nil)
+  symbol)
+
+(defun erb-delete-all-tasks ()
+  "Make all symbols in `obarray' name no task."
+  (interactive)
+  (when (called-interactively-p 'any)
+    (unless (y-or-n-p "Delete all tasks? ")
+      (user-error "Aborted")))
+  (mapc #'erb-task--make-unbound (erb-task--all-symbols)))
+
+;;; Running tasks
+
+(defvar erb-task-repetitions 10
+  "Number of times to run each task.")
+
+(defun erb-task-run-batch (symbols output-file)
+  "Run defined benchmark tasks in batch mode.
+SYMBOLS is a list of the names of the tasks.  Run each one
+`erb-repetitions' times.  Write to OUTPUT-FILE an list of
+results.  Each entry of the list will be of the form:
+
+   ((name . NAME)
+    (version . VERSION)
+    (samples . SAMPLES-LIST)
+    (messages . MESSAGES))
+
+where NAME is the name of the task, VERSION is its version as
+defined in the optional plist given to `erb-deftask',
+SAMPLES-LIST is a list of the return values of benchmark-run, and
+MESSAGES is a list of strings containing the messages issued
+while the task was running.
+
+If there were errors while running the task,
+elements of SAMPLES-LIST will be of the form (error ERROR-INFO)
+instead.  This function is used as a command-line entry point
+into the target Emacs by `erb-run-start'."
+  (let ((print-level nil)
+        (print-length nil))
+    (dolist (symbol symbols)
+      (let* ((task (erb-task--get-task symbol))
+             (key-plist (erb-task--key-plist task))
+             (discard-first (plist-get key-plist :discard-first-sample)))
+        (unless noninteractive
+          (message "Running %s" symbol))
+        (dotimes (i (+ erb-task-repetitions (if discard-first 1 0)))
+          (erb-task--run symbol)
+          (when (and discard-first (zerop i))
+            (erb-task--discard-result task)))))
+
+    (with-temp-file output-file
+      (let ((results
+             (mapcar (lambda (symbol)
+                       (let ((task (erb-task--get-task symbol)))
+                         `((name . ,symbol)
+                           (version . ,(erb-task--version task))
+                           (samples ,@(reverse (erb-task--results task)))
+                           (messages ,@(reverse (erb-task--messages task))))))
+                     symbols)))
+
+        (insert (with-temp-buffer
+                 (prin1 results (current-buffer))
+                 (pp-buffer)
+                 (buffer-string)))))))
+
+(defun erb-task-run-all (&optional repetitions)
+  "Run all defined benchmark tasks REPETITIONS times and message the results.
+REPETITIONS defaults to 1."
+  (interactive "p")
+  (unless (natnump repetitions) (setq repetitions 1))
+  (dotimes (_i repetitions)
+    (mapc #'erb-task--run (erb-task--all-symbols)))
+  (message "Results:")
+  (mapc #'erb-task--message-results (erb-task--all-symbols)))
+
+(defun erb-task--run (symbol)
+  "Run the benchmark task associated with SYMBOL."
+  (let ((task (erb-task--get-task symbol))
+        (message-marker (with-current-buffer (messages-buffer)
+                                (point-max-marker))))
+    (condition-case err
+        (progn
+          (setq erb-task--result nil)
+          (funcall (erb-task--body task)))
+      (error (setq erb-task--result err)))
+    (erb-task--add-result erb-task--result task)
+    (erb-task--add-message (with-current-buffer (messages-buffer)
+                             (buffer-substring message-marker (point-max)))
+                           task)))
+
+(defun erb-task--message-results (symbol)
+  (message "%s: " symbol)
+  (dolist (item (reverse (erb-task--results (erb-task--get-task symbol))))
+    (message "  %s" item)))
+
+(provide 'erb-task)
+;;; erb-task.el ends here

lisp/thread.el

@@ -196,5 +196,139 @@ Ask for user confirmation before signaling the thread."
       (and (eq thread main-thread) "Main")
       (prin1-to-string thread)))
 
+;;; Thread-safe messages
+
+(cl-defstruct
+    (thread--message
+     (:constructor
+      thread-make-message (&optional name
+                                     &aux
+                                     (mutex (make-mutex name))
+                                     (condition
+                                      (make-condition-variable mutex name)))))
+  name mutex value condition)
+
+(defun thread-message-value (message)
+  "Return the value of MESSAGE."
+  (thread--message-value message))
+
+(defun thread-message-send (message value)
+  "Set the VALUE of MESSAGE, and awaken all threads waiting for it."
+  (with-mutex (thread--message-mutex message)
+    (setf (thread--message-value message) value)
+    (condition-notify (thread--message-condition message) t)))
+
+(defun thread-message-cancel (message)
+  "Cancel MESSAGE by setting its value to nil."
+  (with-mutex (thread--message-mutex message)
+    (setf (thread--message-value message) nil)))
+
+(defun thread-message-wait (message &optional cancel)
+  "If MESSAGE's value is nil, block until it is set to something else.
+Return the value of MESSAGE.  If CANCEL is non-nil, clear MESSAGE
+by setting its value to nil.  If multiple threads are waiting on
+the same message, and all pass a non-nil CANCEL, then only one
+thread will unblock and receive the message's value, and the
+others will continue to block."
+  (with-mutex (thread--message-mutex message)
+    (while (not (thread--message-value message))
+      (condition-wait (thread--message-condition message)))
+    (let ((value (thread--message-value message)))
+      (when cancel
+        (setf (thread--message-value message) nil))
+      value)))
+
+;;; Thread-safe queues
+
+(cl-defstruct (thread--queue
+               (:constructor
+                thread-make-queue (&optional
+                                   size-limit
+                                   type
+                                   &aux
+                                   (fifo (eq type 'fifo))
+                                   (limit (when (natnump size-limit) size-limit))
+                                   (mutex (make-mutex))
+                                   (not-full (make-condition-variable mutex))
+                                   (not-empty (make-condition-variable mutex)))))
+  fifo
+  limit
+  items
+  mutex
+  not-full
+  not-empty)
+
+(defun thread-queue-empty-p (queue)
+  "Return non-nil if QUEUE is empty.
+There is no guarantee that QUEUE will contain the same number of
+items the next time you access it."
+  (with-mutex (thread--queue-mutex queue)
+    (null (thread--queue-items queue))))
+
+(defun thread-queue-full-p (queue)
+  "Return non-nil if QUEUE is full.
+There is no guarantee that QUEUE will contain the same number of
+items the next time you access it."
+  (when (thread--queue-limit queue)
+    (with-mutex (thread--queue-mutex queue)
+      (= (length (thread--queue-items queue)) (thread--queue-limit queue)))))
+
+(defun thread-queue-length (queue)
+  "Return the number of items in QUEUE.
+There is no guarantee that QUEUE will contain the same number of
+items the next time you access it."
+  (with-mutex (thread--queue-mutex queue)
+    (length (thread--queue-items queue))))
+
+(defun thread-queue-remove-all (queue)
+  "Discard any items in QUEUE."
+  (with-mutex (thread--queue-mutex queue)
+    (setf (thread--queue-items queue) nil)
+    (condition-notify (thread--queue-not-full queue))))
+
+(defun thread-queue-put (item queue)
+  "Put ITEM into QUEUE.
+If QUEUE was created with a size limit, and already contains that many items,
+block until one is removed."
+  (with-mutex (thread--queue-mutex queue)
+    (while (and (thread--queue-limit queue)
+                (= (length (thread--queue-items queue)) (thread--queue-limit queue)))
+      (condition-wait (thread--queue-not-full queue)))
+    (if (thread--queue-fifo queue)
+        (setf (thread--queue-items queue)
+              (nconc (thread--queue-items queue) (list item)))
+      (push item (thread--queue-items queue)))
+    (condition-notify (thread--queue-not-empty queue))))
+
+(defun thread-queue-get (queue)
+  "Remove an item from QUEUE and return it.
+If there are no items in QUEUE, block until one is added."
+  (with-mutex (thread--queue-mutex queue)
+    (while (null (thread--queue-items queue))
+      (condition-wait (thread--queue-not-empty queue)))
+    (let ((item (pop (thread--queue-items queue))))
+      (condition-notify (thread--queue-not-full queue))
+      item)))
+
+;;; Mutexes for variables
+
+(defun make-symbol-mutex (symbol)
+  "Create a mutex associated with SYMBOL."
+  (unless (get symbol 'thread--mutex)
+    (put symbol 'thread--mutex (make-mutex (symbol-name symbol)))))
+
+(defmacro with-symbol-mutex (symbol &rest body)
+  "Run BODY while holding the mutex for SYMBOL.
+If another thread holds the mutex, block until it is released."
+  (declare (indent 1)
+           (debug (symbolp body)))
+  (let ((g-mutex (gensym)))
+    `(let ((,g-mutex (get ',symbol 'thread--mutex)))
+       (if ,g-mutex
+           (with-mutex ,g-mutex
+             ,@body)
+         (error "`%s' doesn't have a mutex" ',symbol)))))
+
+
 (provide 'thread)
 ;;; thread.el ends here

src/process.c

@@ -280,7 +280,7 @@ static void exec_sentinel (Lisp_Object, Lisp_Object);
 static int num_pending_connects;
 
 /* The largest descriptor currently in use; -1 if none.  */
-static int max_desc;
+int max_desc;
 
 /* Set the external socket descriptor for Emacs to use when
    `make-network-process' is called with a non-nil
@@ -459,6 +459,8 @@ static struct fd_callback_data
 void
 add_read_fd (int fd, fd_callback func, void *data)
 {
+  fprintf(stderr, "add_read_fd %d (%p)\n", fd, current_thread);
+
   add_keyboard_wait_descriptor (fd);
 
   fd_callback_info[fd].func = func;
@@ -471,6 +473,8 @@ add_non_keyboard_read_fd (int fd)
   eassert (fd >= 0 && fd < FD_SETSIZE);
   eassert (fd_callback_info[fd].func == NULL);
 
+  fprintf(stderr, "add_non_keyboard_read_fd %d (%p)\n", fd, current_thread);
+
   fd_callback_info[fd].flags &= ~KEYBOARD_FD;
   fd_callback_info[fd].flags |= FOR_READ;
   if (fd > max_desc)
@@ -480,6 +484,8 @@ add_non_keyboard_read_fd (int fd)
 static void
 add_process_read_fd (int fd)
 {
+  fprintf(stderr, "add_process_read_fd %d (%p)\n", fd, current_thread);
+
   add_non_keyboard_read_fd (fd);
   fd_callback_info[fd].flags |= PROCESS_FD;
 }
@@ -506,6 +512,8 @@ add_write_fd (int fd, fd_callback func, void *data)
 {
   eassert (fd >= 0 && fd < FD_SETSIZE);
 
+  fprintf(stderr, "add_write_fd %d (%p)\n", fd, current_thread);
+
   fd_callback_info[fd].func = func;
   fd_callback_info[fd].data = data;
   fd_callback_info[fd].flags |= FOR_WRITE;
@@ -519,6 +527,8 @@ add_non_blocking_write_fd (int fd)
   eassert (fd >= 0 && fd < FD_SETSIZE);
   eassert (fd_callback_info[fd].func == NULL);
 
+  fprintf(stderr, "add_non_blocking_write_fd %d (%p)\n", fd, current_thread);
+
   fd_callback_info[fd].flags |= FOR_WRITE | NON_BLOCKING_CONNECT_FD;
   if (fd > max_desc)
     max_desc = fd;
@@ -545,6 +555,8 @@ recompute_max_desc (void)
 void
 delete_write_fd (int fd)
 {
+  fprintf(stderr, "delete_write_fd %d (%p)\n", fd, current_thread);
+
   if ((fd_callback_info[fd].flags & NON_BLOCKING_CONNECT_FD) != 0)
     {
       if (--num_pending_connects < 0)
@@ -1242,7 +1254,10 @@ static void
 set_process_filter_masks (struct Lisp_Process *p)
 {
   if (EQ (p->filter, Qt) && !EQ (p->status, Qlisten))
-    delete_read_fd (p->infd);
+    {
+      fprintf(stderr, "set_process_filter_masks %p %d (%p)\n", p, p->infd, current_thread);
+      delete_read_fd (p->infd);
+    }
   else if (EQ (p->filter, Qt)
 	   /* Network or serial process not stopped:  */
 	   && !EQ (p->command, Qt))
@@ -4583,6 +4598,7 @@ deactivate_process (Lisp_Object proc)
 	}
 #endif
       chan_process[inchannel] = Qnil;
+      fprintf(stderr, "deactivate_process %d (%p)\n", inchannel, current_thread);
       delete_read_fd (inchannel);
       if ((fd_callback_info[inchannel].flags & NON_BLOCKING_CONNECT_FD) != 0)
 	delete_write_fd (inchannel);
@@ -5661,6 +5677,8 @@ wait_reading_process_output (intmax_t time_limit, int nsecs, int read_kbd,
 
 		  /* Clear the descriptor now, so we only raise the
 		     signal once.  */
+		  fprintf(stderr, "wait_reading_process_output %p %d (%p)\n",
+			  p, channel, current_thread);
 		  delete_read_fd (channel);
 
 		  if (p->pid == -2)
@@ -6771,7 +6789,11 @@ of incoming traffic.  */)
       p = XPROCESS (process);
       if (NILP (p->command)
 	  && p->infd >= 0)
-	delete_read_fd (p->infd);
+	{
+	  fprintf(stderr, "stop_process %p %d (%p)\n",
+		  p, p->infd, current_thread);
+	  delete_read_fd (p->infd);
+	}
       pset_command (p, Qt);
       return process;
     }
@@ -7105,7 +7127,11 @@ handle_child_signal (int sig)
 
 	      /* clear_desc_flag avoids a compiler bug in Microsoft C.  */
 	      if (clear_desc_flag)
-		delete_read_fd (p->infd);
+		{
+		  fprintf(stderr, "handle_child_signal %p %d (%p)\n",
+			  p, p->infd, current_thread);
+		  delete_read_fd (p->infd);
+		}
 	    }
 	}
     }

src/xgselect.c

@@ -18,6 +18,9 @@ You should have received a copy of the GNU General Public License
 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 
 #include <config.h>
+#include <stdio.h>
+#include <unistd.h>
+#include <fcntl.h>
 
 #include "xgselect.h"
 
@@ -29,6 +32,9 @@ along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 #include "blockinput.h"
 #include "systime.h"
 
+extern void safe_debug_print (Lisp_Object);
+extern int max_desc;
+
 /* `xg_select' is a `pselect' replacement.  Why do we need a separate function?
    1. Timeouts.  Glib and Gtk rely on timer events.  If we did pselect
       with a greater timeout then the one scheduled by Glib, we would
@@ -45,6 +51,7 @@ xg_select (int fds_lim, fd_set *rfds, fd_set *wfds, fd_set *efds,
 	   struct timespec *timeout, sigset_t *sigmask)
 {
   fd_set all_rfds, all_wfds;
+  fd_set save_all_rfds, save_all_wfds;
   struct timespec tmo;
   struct timespec *tmop = timeout;
 
@@ -113,12 +120,36 @@ xg_select (int fds_lim, fd_set *rfds, fd_set *wfds, fd_set *efds,
 	tmop = &tmo;
     }
 
+  save_all_rfds = all_rfds;
+  save_all_wfds = all_wfds;
+
   fds_lim = max_fds + 1;
   nfds = thread_select (pselect, fds_lim,
 			&all_rfds, have_wfds ? &all_wfds : NULL, efds,
 			tmop, sigmask);
   if (nfds < 0)
-    retval = nfds;
+    {
+      retval = nfds;
+      if (errno == EBADF)
+	{
+	  int fd;
+	  fprintf (stderr, "EBADF in xg_select, thread = %p\n",
+		   current_thread);
+
+	  for (fd = 0; fd <= max_desc; ++fd)
+	    {
+	      if (FD_ISSET (fd, &save_all_rfds) &&
+		  fcntl(fd, F_GETFL) < 0 &&
+		  errno == EBADF)
+		fprintf (stderr, "fd %d in save_all_rfds\n", fd);
+	      if (FD_ISSET (fd, &save_all_wfds) &&
+		  fcntl(fd, F_GETFL) < 0 &&
+		  errno == EBADF)
+		fprintf (stderr, "fd %d in save_all_wfds\n", fd);
+	    }
+	  errno = EBADF;
+	}
+    }
   else if (nfds > 0)
     {
       for (i = 0; i < fds_lim; ++i)