Subject: bug#78972: Experimental features for running lisp without requiring loadup.el

From: Lynn Winebarger <[email-masked]>
Date: Mon, 7 Jul 2025 21:46:15 -0400

I added some option values for --temacs to facilitate interrogating a
bootstrap build of emacs before dumping, e.g. for convenient use in a
Makefile.  Then I started wondering what would happen if I called
dump-emacs-portable from that state, say, for creating a minimal
stand-alone (byte and/or native) compiler dump and executable.  To
further facilitate such stand-alone programs (e.g. an elisp
lsp-server), I hacked the "fingerprint" feature to create a fixed area
for writing hard-coded configuration options into the (or a copy of
the) executable file, such as a default basename for the dump file or
a "shim" lisp program that will be run before the startup procedure
from the dump file.

The new options for temacs are
* --temacs=eval-args  - evaluates all remaining command line arguments
as programs (like load or eval-buffer).
* --temacs=eval-stdin - evaluates the stdin stream as a program.
* --temacs=eval  - first eval-args, then eval-stdin

These modes put emacs in "noneditor mode" (really noninteractive)
which sets up a simple catchall handler and runs the program(s) from
the specified sources.  All other options are ignored.

When eval-args or eval is specified, the lisp program will not have
access to the command line arguments.  If eval-stdin is specified, the
usual lisp variable for command-line arguments holds a list of all
arguments.

If a dump file is created from one of these modes, a post-load hook is
added to ensure that emacs is in noneditor mode.  If "noneditor" is
defined in the dumpfile, that will be called as the "main" program to
execute, and emacs will exit when it returns.  If noneditor is not
defined, then emacs behaves as if "eval-stdin" was specified.  In
either case, the command-line arguments are stored as a list for use
of the program.

Since the emacs executable in noneditor mode ignores all command-line
options, I've added a field of flags that can be configured by
make-fingerprint or from lisp functions for creating a "customized
emacs executable".  Currently the flags only specify whether the
executable is to start in noneditor mode, and if so, what sources of
commands it should us (args, stdin, both or neither), whether to run a
shim lisp program, and to run "bare" (i.e. no dump file or loadup).
This feature is mostly to make up for the usual option processing
being suppressed, so it would make sense to add support for other
useful options that are handled in C code.  I believe that would only
be the two "daemon" mode options.  noneditor mode is for creating
dedicated emacs-lisp programs, so site-lisp directories are not
configured, and user/site init files are ignored.

The following new lisp functions are defined:

* (get-emacs-executable-custom-settings)
* (get-emacs-executable-fingerprint-data EMACS_EXE_FILENAME &optional
MAX_SHIM_SIZE)
* (make-custom-emacs-exectuable OUTFILE &optional FLAG_LIST BASENAME
SHIM HASH EMACS_EXE_FILENAME)

The flag bits are reported and set using symbolic representations and
their complements:
* 'noneditor / 'editor
* 'stdin / 'nostdin
* 'args or 'command-line-args / 'noargs
* 'bare / 'not-bare
* 'shim / 'noshim
When setting the options, the options will be processed sequentially
starting with the existing flags in the specified executable.  The
symbol 'clear turns all flags at whatever point in the sequence it is
processed.
The "HASH" argument may be
* nil or 'original - leave fingerprint as is
* 'reset or 'pristine - set the fingerprint to the default from libgnu
* 'custom - set the fingerprint to its pristine value, then set the
specified options, then calculate the fingerprint to write in the
executable.
* 'standard - set the fingerprint to its pristine value and zero the
storage area, calculate the fingerprint from that state before setting
the configuration data.

SHIM is either
* 'original - keep existing shim string
* 'reset or 'clear - zero the shim string
* An s-expression that is converted to a string via prin1-to-string

make-fingerprint has been augmented with options for displaying and
setting the storage area associated with the fingerprint.  I
implemented yet-another-string-literal syntax for specifying binary
values is a shell/Makefile friendly format.  The library code for
parsing that format can be tested with the program
parse-string-literal in lib/test.

I still haven't actually *dumped* a program in noneditor mode, or
determined what the shortest build of a standalone compiler for use in
the build process (or for async compiling) is.

It does not break any existing tests (that weren't expected) - which
considering it is mostly orthogonal to existing code, it really
shouldn't.  Note I have applied my patch for a reentrant reader, but
it probably isn't completely necessary.  This is nominally my original
impetus for that chunk of work.

I'm curious if anyone else is interested in these features.  I'd like
to be able to at least load files encoded in emacs-internal (or
compatible) into a buffer without loading all of mule/international
support for a shorter bootstrap compiler build, depending on how much
of a dent in dump-file size/build time it would make.  I'm sure
loading all 125-150 files from loadup is not really necessary just to
be able read lisp files and produce compiled files.

Lynn
From 741ebf0e43e1e0a88ecf09976f2859d3f8687aa9 Mon Sep 17 00:00:00 2001
From: Onnie Lynn Winebarger <[email-masked]>
Date: Sun, 6 Jul 2025 16:30:43 -0400
Subject: [PATCH 02/12] Add support for hard-coded executable options.

---
 src/lisp.h | 84 +++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 83 insertions(+), 1 deletion(-)

diff --git a/src/lisp.h b/src/lisp.h
index 605255dfaaa..f1b18c0be61 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -41,6 +41,8 @@ #define EMACS_LISP_H
 #include <intprops.h>
 #include <verify.h>
 
+#include <fingerprint.h>
+
 INLINE_HEADER_BEGIN
 
 /* Define a TYPE constant ID as an externally visible name.  Use like this:
@@ -657,6 +659,72 @@ #define ENUM_BF(TYPE) enum TYPE
 #endif
 } gflags;
 
+enum {
+  ECFG_ARGV0_BASE_SIZE = 32
+};
+typedef struct 
+{
+  uint64_t flags;
+  char argv0_base[ECFG_ARGV0_BASE_SIZE];
+  char shim[];
+} exe_config_header;
+
+enum {
+  ECFG_SHIM_SIZE = (FINGERPRINT_DATA_SIZE - offsetof(exe_config_header,shim))
+};
+
+typedef struct 
+{
+  uint64_t flags;
+  char argv0_base[ECFG_ARGV0_BASE_SIZE];
+  /* Allow for a hard-coded program to be embedded in remaining space */
+  char shim[ECFG_SHIM_SIZE];
+} exe_config_data;
+
+
+extern union exe_config_store
+{
+  exe_config_data s;
+  unsigned char data[FINGERPRINT_DATA_SIZE];
+} *exe_config;
+
+enum ECFG_FLAG
+{
+  ECFG_NONE = 0,
+  ECFG_CONFIGURED = 1,
+  ECFG_NONEDITOR = 2, /* Unconditionally enter noneditor mode */
+  ECFG_BARE = 4,  /* Do not load a dump file */
+  ECFG_EVAL_ARGS = 8,  /* Eval command line arguments */
+  ECFG_EVAL_STDIN = 16, /* Eval expression from stdin */
+  ECFG_EVAL_SHIM = 32 /* eval shim program first */
+};
+
+#define EXE_CONFIGURED(v) \
+  ( (v != NULL) && (((*v).s.flags & ECFG_CONFIGURED)	\
+		    == ECFG_CONFIGURED ) )
+
+#define EXE_CONFIGURED_OPT(v, flag) \
+  ( (v != NULL) && (((*v).s.flags & (ECFG_CONFIGURED | (flag)))	\
+		    == (ECFG_CONFIGURED | (flag) ) ) )
+
+#define EXE_CONFIGURED_NONEDITOR(v) EXE_CONFIGURED_OPT(v,ECFG_NONEDITOR)
+#define EXE_CONFIGURED_BARE(v) EXE_CONFIGURED_OPT(v,ECFG_BARE)
+#define EXE_CONFIGURED_EVAL_ARGS(v) EXE_CONFIGURED_OPT(v,ECFG_EVAL_ARGS)
+#define EXE_CONFIGURED_EVAL_STDIN(v) EXE_CONFIGURED_OPT(v,ECFG_EVAL_STDIN)
+#define EXE_CONFIGURED_EVAL_INPUTS(v) \
+  EXE_CONFIGURED_OPT(v, ECFG_EVAL_ARGS | ECFG_EVAL_STDIN)
+#define EXE_CONFIGURED_EVAL_SHIM(v) EXE_CONFIGURED_OPT(v,ECFG_EVAL_SHIM)
+
+/* Options for source of expressions to evaluate in noneditor
+   environment.  */
+extern enum noneditor_eval_source {
+  NONEDITOR_EVAL_NONE = 0,
+  NONEDITOR_EVAL_ARGS = ECFG_EVAL_ARGS,
+  NONEDITOR_EVAL_STDIN = ECFG_EVAL_STDIN,
+  NONEDITOR_EVAL_BOTH  = NONEDITOR_EVAL_ARGS | NONEDITOR_EVAL_STDIN,
+  NONEDITOR_EVAL_MASK = NONEDITOR_EVAL_BOTH  /* for use with exe_config.s.flags */
+} noneditor_eval_source;
+
 INLINE bool
 will_dump_p (void)
 {
@@ -3847,7 +3915,9 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs)
 
 enum nonlocal_exit
 {
-  NONLOCAL_EXIT_SIGNAL,
+  /* Ensure neither of these can be mistaken for
+     a zero-initialized variable or structure field */
+  NONLOCAL_EXIT_SIGNAL = 1,
   NONLOCAL_EXIT_THROW,
 };
 
@@ -4882,6 +4952,18 @@ CHECK_KEYWORD_ARGS (ptrdiff_t nargs)
 Lisp_Object funcall_general (Lisp_Object fun,
 			     ptrdiff_t numargs, Lisp_Object *args);
 
+extern void noneditor_main (int nargs, char **args);
+extern Lisp_Object noneditor_catchall (enum nonlocal_exit,Lisp_Object);
+extern struct
+{
+  int nargs;
+  char **args;
+  int nexprs;
+  int arg_i;
+  Lisp_Object  arg;
+  Lisp_Object err;
+} noneditor;
+
 /* The definition of Lisp_Module_Function depends on emacs-module.h,
    so we don't define it here.  It's defined in emacs-module.c.  */
 
-- 
2.49.0

From 95b1e8bb71e198f5e90e0a2237ed1d7872764de3 Mon Sep 17 00:00:00 2001
From: Onnie Lynn Winebarger <[email-masked]>
Date: Sun, 6 Jul 2025 16:55:06 -0400
Subject: [PATCH 03/12] Add streams for use in noneditor mode.

---
 src/print.c | 23 +++++++++++++++++++++++
 src/xdisp.c |  2 ++
 2 files changed, 25 insertions(+)

diff --git a/src/print.c b/src/print.c
index b6ee89478c7..c6a440cfc6b 100644
--- a/src/print.c
+++ b/src/print.c
@@ -932,6 +932,17 @@ DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugg
   return character;
 }
 
+DEFUN ("external-standard-output", Fexternal_standard_output, Sexternal_standard_output, 1, 1, 0,
+       doc: /* Write CHARACTER to stdout.
+You can call `print' while in bare evaluation mode, and pass it this function
+to make it write to the standard output.  */)
+  (Lisp_Object character)
+{
+  CHECK_FIXNUM (character);
+  printchar_to_stream (XFIXNUM (character), stdout);
+  return character;
+}
+
 /* This function is never called.  Its purpose is to prevent
    print_output_debug_flag from being optimized away.  */
 
@@ -2836,8 +2847,14 @@ init_print_once (void)
   /* The subroutine object for external-debugging-output is kept here
      for the convenience of the debugger.  */
   DEFSYM (Qexternal_debugging_output, "external-debugging-output");
+  DEFSYM (Qstandard_error, "standard-error");
+
 
   defsubr (&Sexternal_debugging_output);
+  Fset (Qstandard_error, Fsymbol_function (Qexternal_debugging_output));
+  /* This is for output in noneditor mode */
+  DEFSYM (Qexternal_standard_output, "external-standard-output");
+  defsubr (&Sexternal_standard_output);
 }
 
 void
@@ -3001,6 +3018,12 @@ syms_of_print (void)
   DEFSYM (Qprint_escape_multibyte, "print-escape-multibyte");
   DEFSYM (Qprint_escape_nonascii, "print-escape-nonascii");
 
+  /* these are for use with Fprin1_to_string */
+  DEFSYM (Qlength, "length");
+  DEFSYM (Qlevel, "level");
+  DEFSYM (Qcircle, "circle");
+  DEFSYM (Qcharset_text_property, "charset-text-property");
+
   print_prune_charset_plist = Qnil;
   staticpro (&print_prune_charset_plist);
 
diff --git a/src/xdisp.c b/src/xdisp.c
index 15a88f0868a..380d4d6fa12 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -37804,7 +37804,9 @@ syms_of_xdisp (void)
   DEFSYM (QCmap, ":map");
   DEFSYM (QCpointer, ":pointer");
   DEFSYM (Qrect, "rect");
+  /* move to print.c to ensure always defined.
   DEFSYM (Qcircle, "circle");
+  */
   DEFSYM (Qpoly, "poly");
 
   DEFSYM (Qinhibit_menubar_update, "inhibit-menubar-update");
-- 
2.49.0

From 8ae81ec4ad1cf1216f2c58c12209ab5a38a11129 Mon Sep 17 00:00:00 2001
From: Onnie Lynn Winebarger <[email-masked]>
Date: Sun, 6 Jul 2025 16:58:55 -0400
Subject: [PATCH 04/12] Initial support for noneditor mode trampoline.

---
 src/eval.c | 184 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 184 insertions(+)

diff --git a/src/eval.c b/src/eval.c
index 4c514001d9d..104953e8482 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -336,6 +336,188 @@ do_debug_on_call (Lisp_Object code, specpdl_ref count)
 }
 
 
+/* Minimal infrastructure for a read-eval loop or stand-alone lisp program.
+   Provides the basic trampolines required for the signal and throw
+   operators to not panic on an otherwise unhandled non-local exit.
+   "noneditor" because "noninteractive" is already in use.  Although
+   this feature could be used to implement a shell.
+   This trampoline is also for use in a bare, pure emacs which
+   may or may not dump in some non-standard way (to get a standalone
+   lisp program dump).  It can be used to interrogate a freshly built
+   temacs executable without executing "loadup" and exit normally.
+*/
+
+struct
+{
+  int nargs;
+  char **args;
+  int nexprs;
+  int arg_i;
+  Lisp_Object arg;
+  int err_kind;
+  Lisp_Object err;
+} noneditor;
+
+typedef Lisp_Object (*noneditor_proc)(void);
+static Lisp_Object noneditor_eval_shim (void);
+static Lisp_Object noneditor_eval_args (void);
+static Lisp_Object noneditor_eval_stdin_thunk (void);
+static Lisp_Object noneditor_dispatch (void);
+
+
+Lisp_Object
+noneditor_eval_shim (void)
+{
+  Lisp_Object shim = build_string (exe_config->s.shim);
+  return noneditor_eval_stream (shim, &(noneditor.nexprs), &(noneditor.err));
+}
+
+Lisp_Object
+noneditor_eval_args (void)
+{
+  Lisp_Object val = Qnil;
+  for ( noneditor.arg_i = 0;
+	noneditor.arg_i < noneditor.nargs;
+	noneditor.arg_i++)
+    {
+      noneditor.arg = build_string (noneditor.args[noneditor.arg_i]);
+      val = noneditor_eval_stream (noneditor.arg, &(noneditor.nexprs),
+				   &(noneditor.err));
+    }
+  return val;
+}
+
+Lisp_Object
+noneditor_eval_stdin_thunk (void)
+{
+  return noneditor_eval_stream (Qstdin, &(noneditor.nexprs), &(noneditor.err));
+}
+
+Lisp_Object
+noneditor_dispatch (void)
+{
+  if (EXE_CONFIGURED_EVAL_SHIM(exe_config))
+    noneditor_eval_shim();
+  else if (NILP (Vnoneditor))
+    fatal ("noneditor must be non-nil when used as main process "
+	   "without a hard-coded lisp program.");
+
+  if (EQ (Vnoneditor,Qt))
+    {
+      Vcommand_line_args = Qnil;
+      Lisp_Object val = noneditor_eval_args();
+      if (noneditor.nexprs == 0)
+	val = noneditor_eval_stdin_thunk();
+      return val;
+    }
+
+  if (EQ (Vnoneditor,Qcommand_line_args))
+    {
+      Vcommand_line_args = Qnil;
+      return noneditor_eval_args();
+    }
+
+
+  if (EQ (Vnoneditor,Qstdin))
+      return noneditor_eval_stdin_thunk();
+
+  noneditor.nexprs = 1;
+  if (FUNCTIONP (Vnoneditor))
+      return funcall_general (Vnoneditor, 0, NULL);
+
+  /* else Vnoneditor holds an expression to evaluate*/
+  return Feval (Vnoneditor,Qt);
+}
+
+Lisp_Object
+noneditor_catchall (enum nonlocal_exit exit_kind, Lisp_Object data)
+{
+  noneditor.err_kind = exit_kind;
+  noneditor.err = data;
+  switch (exit_kind)
+    {
+    case NONLOCAL_EXIT_SIGNAL:
+      {
+	/* Cut down version of cmd_error */
+	Lisp_Object old_level, old_length;
+	fprintf(stderr,"Unhandled error encountered in noneditor mode.\n");
+	/* Avoid unquittable loop if data contains a circular list.  */
+	old_level = Vprint_level;
+	old_length = Vprint_length;
+	XSETFASTINT (Vprint_level, 10);
+	XSETFASTINT (Vprint_length, 10);
+	print_error_message (data, Qexternal_debugging_output,"",
+			     Vsignaling_function);
+	Fterpri (Qexternal_debugging_output, Qnil);
+	Vprint_level = old_level;
+	Vprint_length = old_length;
+	return Qnil;
+      }
+    case NONLOCAL_EXIT_THROW:
+    }
+}
+
+/* Cut down version of cmd_error */
+static Lisp_Object
+noneditor_base_condition_handler (Lisp_Object data)
+{
+  Lisp_Object old_level, old_length;
+  fprintf(stderr,"Error encountered in bare eval.\n");
+  /* Avoid unquittable loop if data contains a circular list.  */
+  old_level = Vprint_level;
+  old_length = Vprint_length;
+  XSETFASTINT (Vprint_level, 10);
+  XSETFASTINT (Vprint_length, 10);
+  print_error_message (data, Qexternal_debugging_output,"", Vsignaling_function);
+  Fterpri (Qexternal_debugging_output, Qnil);
+  Vprint_level = old_level;
+  Vprint_length = old_length;
+  noneditor_eval_err = Qt;
+
+  return Qt;
+}
+
+static Lisp_Object
+noneditor_condition_trampoline (Lisp_Object ignored)
+{
+  return internal_condition_case (noneditor_dispatch, Qerror,
+				  noneditor_base_condition_handler);
+}
+
+/* Evaluate expressions in either a bare or non-standard
+   dump implementing a stand-alone noneditor program.
+   The source of expressions is determined by the value
+   of Vnoneditor (see noneditor_dispatch).
+   Signal an error if no expressions are evaluated.
+   Exit after all expressions are evaluated.  */
+AVOID
+noneditor_main (int nargs, char **args)
+{
+  noneditor.nargs = nargs;
+  noneditor.args = args;
+  noneditor.nexprs = 0;
+  noneditor.arg_i = 0;
+  noneditor.arg = Qnil;
+
+  Fset (Qlexical_binding, Qt);
+  Fset (Qstandard_error, Qexternal_debugging_output);
+  Fset (Qstandard_output, Qexternal_standard_output);
+  Fset (Qstandard_input, Qexternal_standard_input);
+  /* Fset (Qstandard_input,Qget_file_char); */
+  Lisp_Object val = internal_catch (Qtop_level,
+				    noneditor_condition_trampoline,
+				    Qnil);
+  /* if (noneditor.nexprs == 0) */
+  /*   fatal ("Bare evaluation mode found no expressions to evaluate"); */
+
+  shut_down_emacs (0,Qnil);
+  int exit_code = EQ (noneditor_eval_err, Qnil) ? 0 : 1;
+  exit(exit_code);
+}
+
+
+
+
 DEFUN ("or", For, Sor, 0, UNEVALLED, 0,
        doc: /* Eval args until one of them yields non-nil, then return that value.
 The remaining args are not evalled at all.
@@ -4554,6 +4736,8 @@ syms_of_eval (void)
   staticpro (&list_of_t);
   list_of_t = list1 (Qt);
 
+  staticpro (&(noneditor.arg));
+
   defsubr (&Sor);
   defsubr (&Sand);
   defsubr (&Sif);
-- 
2.49.0

From 1130e8e5e2626a8062fa7f044ff637c502ee7b67 Mon Sep 17 00:00:00 2001
From: Onnie Lynn Winebarger <[email-masked]>
Date: Fri, 4 Jul 2025 20:44:54 -0400
Subject: [PATCH 01/12] Enhance fingerprint storage with writeable storage

* Support backing out fingerprint to unmodified state
* Provide user-writeable data storage area in the emacs
  executable to store configuration data.
* Enhance make-fingerprint tool with options to view
  or modify the configuration data using a shell-friendly
  sting literal syntax.
* parse-string-literal program to test correctness of
  string literal syntax parsing in lib/test.
* Modify configure.ac and Makefiles to build lib/test
* Add lib-src/md5hash utility
---
 configure.ac                    |   7 +
 lib-src/make-fingerprint.c      | 389 ++++++++++++++---
 lib/fingerprint.c               | 751 ++++++++++++++++++++++++++++++--
 lib/fingerprint.h               | 157 ++++++-
 lib/test/Makefile.in            | 194 +++++++++
 lib/test/init.sh                | 746 +++++++++++++++++++++++++++++++
 lib/test/parse-string-literal.c | 114 +++++
 7 files changed, 2258 insertions(+), 100 deletions(-)
 create mode 100644 lib/test/Makefile.in
 create mode 100644 lib/test/init.sh
 create mode 100644 lib/test/parse-string-literal.c

diff --git a/configure.ac b/configure.ac
index 083708b7756..50e72bf8811 100644
--- a/configure.ac
+++ b/configure.ac
@@ -7747,6 +7747,13 @@ AC_DEFUN
   dnl ", [], [opt_makefile='$opt_makefile']" and it should work.
   ARCH_INDEPENDENT_CONFIG_FILES([test/infra/Makefile])
 fi
+opt_makefile=lib/test/Makefile
+if test -f "$srcdir/$opt_makefile.in"; then
+  SUBDIR_MAKEFILES="$SUBDIR_MAKEFILES $opt_makefile"
+  dnl Again, it's best not to use a variable.  Though you can add
+  dnl ", [], [opt_makefile='$opt_makefile']" and it should work.
+  ARCH_INDEPENDENT_CONFIG_FILES([lib/test/Makefile])
+fi
 
 if test "$ANDROID" = "yes"; then
   SUBDIR_MAKEFILES="$SUBDIR_MAKEFILES java/Makefile cross/Makefile"
diff --git a/lib-src/make-fingerprint.c b/lib-src/make-fingerprint.c
index c3e4c1dac61..7624fa6a143 100644
--- a/lib-src/make-fingerprint.c
+++ b/lib-src/make-fingerprint.c
@@ -29,6 +29,7 @@ Copyright (C) 2018-2025 Free Software Foundation, Inc.
 
 #include <limits.h>
 #include <stdarg.h>
+#include <ctype.h>
 #include <stdint.h>
 #include <stdio.h>
 #include <stdlib.h>
@@ -59,120 +60,378 @@ Copyright (C) 2018-2025 Free Software Foundation, Inc.
 #endif
 #endif /* WINDOWSNT */
 
-/* Static (instead of being local to 'main') to pacify LeakSanitizer.  */
-static char *buf;
+
+static unsigned char fp_data[FINGERPRINT_DATA_SIZE];
+static char *prog;
+static char *file;
+static char *outfile;
+enum
+{
+  errbuf_sz = 256
+};
+static int
+report_errors(FINGERPRINT_ERROR r, int errnos[3])
+{
+  char errbuf[errbuf_sz] = { 0 };
+  int err_cnt = 0;
+  char *errmsg = NULL;
+  switch (r & FINGERPRINT_ERROR_UNIQUE_MASK)
+    {
+    case FINGERPRINT_ERROR_NONE:
+      break;
+    case FINGERPRINT_ERROR_NO_INFILE:
+      fprintf(stderr,"%s: missing or extra file operand\n", prog);
+      err_cnt++;
+      break;
+    case FINGERPRINT_ERROR_INFILE_NOT_OPENED:
+      errmsg = strerror_r (errnos[0], errbuf, errbuf_sz);
+      fprintf(stderr,"Error opening %s: %s\n", file,errmsg);
+      err_cnt++;
+      break;
+    case FINGERPRINT_ERROR_INFILE_NOT_REGULAR:
+      fprintf (stderr, "%s: Error: %s is not a regular file\n",
+	       prog, file);
+      err_cnt++;
+      break;
+    case FINGERPRINT_ERROR_BUFFER_SIZE:
+      fprintf (stderr, "%s: %s: file too big\n", prog, file);
+      err_cnt++;
+      break;
+    case FINGERPRINT_ERROR_BUFFER_ALLOCATION:
+      errmsg = strerror_r (errnos[0], errbuf, errbuf_sz);
+      fprintf(stderr,"malloc: %s\n", errmsg);
+      err_cnt++;
+      break;
+    case FINGERPRINT_ERROR_FPSTORE_ALLOCATION:
+      errmsg = strerror_r (errnos[0], errbuf, errbuf_sz);
+      fprintf(stderr,"malloc: %s\n", errmsg);
+      err_cnt++;
+      break;
+    case FINGERPRINT_ERROR_INFILE_READ:
+      fprintf (stderr, "%s: Error: could not read %s\n", prog, file);
+      err_cnt++;
+      break;
+    case FINGERPRINT_ERROR_HASH_NOT_FOUND:
+      fprintf (stderr, "%s: %s: missing fingerprint\n", prog, file);
+      err_cnt++;
+      break;
+    case FINGERPRINT_ERROR_HASH_TOO_MANY:
+      fprintf (stderr, "Fingerprint is not unique in file.\n");
+      err_cnt++;
+      break;
+    case FINGERPRINT_ERROR_OUTFILE_CREATION:
+      errmsg = strerror_r (errnos[0], errbuf, errbuf_sz);
+      fprintf(stderr,"Error creating %s: %s\n", outfile,errmsg);
+      err_cnt++;
+      break;
+    case FINGERPRINT_ERROR_OUTFILE_WRITE:
+      errmsg = strerror_r (errnos[0], errbuf, errbuf_sz);
+      fprintf(stderr,"Error writing %s: %s\n", outfile,errmsg);
+      err_cnt++;
+      break;
+    case FINGERPRINT_ERROR_NO_INPLACE:
+      fprintf (stderr, "Inplace modification disallowed.\n");
+      err_cnt++;
+      break;
+    case FINGERPRINT_ERROR_RAW_NO_DIGEST:
+      fprintf (stderr, "Internal error.\n");
+      err_cnt++;
+      break;
+    case FINGERPRINT_ERROR_DATA_OVERFLOW:
+      fprintf (stderr, "Data exceeds available space.\n");
+      err_cnt++;
+      break;
+    default:
+      fprintf(stderr,"Unrecognized fingerprint error.\n");
+      err_cnt++;
+    }
+  if (r & FINGERPRINT_ERROR_OUTFILE_CLOSE)
+    {
+      errmsg = strerror_r (errnos[1], errbuf, errbuf_sz);
+      fprintf(stderr,"Error closing %s: %s\n", outfile,errmsg);
+      err_cnt++;
+    }
+  if (r & FINGERPRINT_ERROR_INFILE_CLOSE)
+    {
+      errmsg = strerror_r (errnos[2], errbuf, errbuf_sz);
+      fprintf(stderr,"Error closing %s: %s\n", file,errmsg);
+      err_cnt++;
+    }
+  return err_cnt;
+}
+
+/* print errors from a fingerprint_buffer, clears the error data in
+   the buffer, and returns the number of errors found. */
+static int
+report_buffer_errors(struct fingerprint_buffer *fb)
+{
+  file = fb->file;
+  outfile = fb->outfile;
+  int err_cnt = report_errors (fb->code, fb->errnos);
+  fb->code = FINGERPRINT_ERROR_NONE;
+  fb->errnos[0] = 0;
+  fb->errnos[1] = 0;
+  fb->errnos[2] = 0;
+  return err_cnt;
+}
+
+static void
+print_fingerprint_storage(struct fingerprint_storage_header *fph,
+			  uint64_t offset,
+			  uint64_t max_data_size)
+{
+  const int line_bytes = 20;
+  printf ("Offset: %lu (%0lx)\n",offset,offset);
+  printf ("Pristine hash complement:\n");
+  for (int i = 0; i < FINGERPRINT_HASH_SIZE - 1; i++)
+    printf("%02X ", fph->pristine_hash_c[i]);
+  printf("%02X\n", fph->pristine_hash_c[FINGERPRINT_HASH_SIZE - 1]);
+  printf ("Current hash:\n");
+  for (int i = 0; i < FINGERPRINT_HASH_SIZE - 1; i++)
+    printf("%02X ", fph->hash[i]);
+  printf("%02X\n", fph->hash[FINGERPRINT_HASH_SIZE - 1]);
+  printf("Data size: %lu\n",fph->size);
+  uint64_t sz = min(max_data_size,fph->size);
+  printf ("Data (first %lu bytes):\n",sz);
+  uint64_t lines = sz/line_bytes;
+  const int blocks = line_bytes/4;
+  uint64_t j = 0, k = 0;
+  for (uint64_t l = 0; l < lines; l++)
+    {
+      for (int b = 0; b < blocks; b++)
+	{
+	  for (int i = 0; i < 4; i++)
+	    printf("%02X ", fph->data[j++]);
+	  printf(" ");
+	}
+      for (int b = 0; b < line_bytes; b++)
+	{
+	  unsigned char c = fph->data[k++];
+	  printf("%c",isprint(c) ? c : '.');
+	}
+      printf("\n");
+    }
+  int j0 = j;
+  int r = sz % line_bytes;
+  if (r > 0)
+    {
+      for (int b = 0; b < blocks; b++)
+	{
+	  for (int i = 0; i < 4; i++)
+	    {
+	      if (j - j0 < r)
+		printf("%02X ", fph->data[j++]);
+	      else
+		j++,printf("   ");
+	    }
+	  printf(" ");
+	}
+      for (int b = 0; b < r; b++)
+	{
+	  unsigned char c = fph->data[k++];
+	  printf("%c",isprint(c) ? c : '.');
+	}
+      printf("\n");
+    }
+
+}
+
+static void
+usage(void)
+{
+          printf ("make-fingerprint [option ...]  FILE\n");
+	  printf ("embed data and/or set the fingerprint in FILE\n");
+	  printf (" -b modify data store before calculating hash\n");
+	  printf (" -r report hash\n");
+	  printf (" -n Add null terminator at end of specified data\n");
+	  printf (" -g print fingerprint storage area\n");
+	  printf (" -w force write output when -r or -g are given\n");
+	  printf (" -l maximum size of data area to display with -g, "
+		  "or to write otherwise\n");
+	  printf (" -o the file to write output to\n"
+		  "    and has the effect of -w\n");
+	  printf (" -d overwrite the data area with the "
+		  "data supplied\n");
+	  printf ("   [data] is in a format similar to "
+		  "string literals in C or echo:\n");
+	  printf ("   \\{f,n,r,t,v,\\,',\",?} - ANSI C\n");
+	  printf ("   \\{o,oo,ooo} - octal value 0 - 255\n");
+	  printf ("   \\xhh - hexadecimal byte\n");
+	  printf ("   \\#Dxh...h - 2^D hexadecimal digits to be "
+		  "stored as a 2^(D-1) byte value \n"
+		  "   according to the endian-ness of the host, "
+		  "D = 1,2,3,4\n");
+	  printf ("   \\C - other than above, the character C\n"
+		  "        to allow writing '\\#4x1\\ ' for a 64-bit value of 1\n"
+		  "        followed by a space character\n");
+	  printf ("  -d has the effect of -w\n");
+}
 
 int
 main (int argc, char **argv)
 {
   int c;
   bool raw = false;
-  while (0 <= (c = getopt (argc, argv, "rh")))
+  bool before = false;
+  bool get_data = false;
+  bool explicit_write = false;
+  unsigned char *data = NULL;
+  bool nullterm = false;
+  /* for printing data */
+  uint64_t max_data_show = 40;
+  /* for retrieving/setting */
+  ptrdiff_t max_data_size  = -1;
+  unsigned char digest[FINGERPRINT_HASH_SIZE];
+  file = NULL;
+  outfile = NULL;
+  prog = argv[0];
+
+  while (0 <= (c = getopt (argc, argv, "ubnrhgd:o:l:")))
     {
       switch (c)
         {
+        case 'b':
+          before = true;
+          break;
         case 'r':
           raw = true;
           break;
+        case 'n':
+          nullterm = true;
+          break;
+        case 'g':
+          get_data = true;
+          break;
+        case 'w':
+          explicit_write = true;
+          break;
+	case 'l':
+	  char *end;
+	  max_data_show = strtol (optarg, &end,10);
+	  max_data_size = (signed int) max_data_show;
+          if ( end == optarg || *end )
+            {
+              fprintf (stderr,
+                       "size argument must be an "
+                       "unsigned integer,given '%s'\n",
+                       optarg);
+              return EXIT_FAILURE;
+            }
+	  break;
+	case 'd':
+	  data = (unsigned char *) optarg;
+	  explicit_write = true;
+	  break;
+	case 'o':
+	  outfile =  optarg;
+	  explicit_write = true;
+	  break;
         case 'h':
-          printf ("make-fingerprint [-r] FILE: replace or compute a hash\n");
+	  usage();
           return EXIT_SUCCESS;
         default:
           return EXIT_FAILURE;
         }
     }
-
-  struct sha256_ctx ctx;
-  sha256_init_ctx (&ctx);
-
-  char *prog = argv[0];
-  char *file = argv[optind];
+  file = argv[optind];
   if (argc - optind != 1)
     {
       fprintf (stderr, "%s: missing or extra file operand\n", prog);
+      usage();
       return EXIT_FAILURE;
     }
-
-  FILE *f = fopen (file, raw ? "r" FOPEN_BINARY : "r+" FOPEN_BINARY);
-  struct stat st;
-  if (!f || fstat (fileno (f), &st) != 0)
+  ptrdiff_t pos = 0;
+  if (data != NULL)
     {
-      perror (file);
-      return EXIT_FAILURE;
+      PSLERR code = parse_string_literal (data, fp_data, sizeof fp_data,
+					  nullterm, &pos);
+      if (code != PSLERR_NONE)
+	{
+	  report_PSLERR (stderr, data, code, sizeof fp_data, pos);
+	  exit (EXIT_FAILURE);
+	}
     }
-
-  if (!S_ISREG (st.st_mode))
+  struct fingerprint_replacement_options opts =
     {
-      fprintf (stderr, "%s: Error: %s is not a regular file\n",
-	       prog, file);
-      return EXIT_FAILURE;
-    }
-
-  ptrdiff_t maxlen = min (min (TYPE_MAXIMUM (off_t), PTRDIFF_MAX),
-			  min (SIZE_MAX, SSIZE_MAX));
-  if (maxlen <= st.st_size)
+      .keep_hash = raw,
+      .inplace = true,
+      .max_data_size = max_data_size
+    };
+  int errnos[3] = { 0 };
+  struct fingerprint_buffer *fb;
+  FINGERPRINT_ERROR r =
+    fingerprint_get_buffer(file, outfile, &opts, &fb, errnos);
+  if (r != FINGERPRINT_ERROR_NONE)
     {
-      fprintf (stderr, "%s: %s: file too big\n", prog, file);
+      report_errors(r, errnos);
       return EXIT_FAILURE;
     }
 
-  buf = malloc (st.st_size + 1);
-  if (!buf)
+  if (get_data)
     {
-      perror ("malloc");
-      return EXIT_FAILURE;
+      print_fingerprint_storage (fb->hdr,
+				 (uint64_t) fb->offset,
+				 max_data_show);
+      if (!explicit_write)
+	goto done;
     }
 
-  size_t chunksz = fread (buf, 1, st.st_size + 1, f);
-  if (ferror (f) || chunksz != st.st_size)
+  if ( fb->outfile == NULL )
+    goto done;
+
+  if (before && data != NULL)
     {
-      fprintf (stderr, "%s: Error: could not read %s\n", prog, file);
-      return EXIT_FAILURE;
+      fingerprint_set_data (fb, pos, fp_data);
+      if (fb->code != FINGERPRINT_ERROR_NONE)
+	goto done;
     }
 
-  sha256_process_bytes (buf, chunksz, &ctx);
-
-  unsigned char digest[32];
-  sha256_finish_ctx (&ctx, digest);
-
   if (raw)
     {
-      for (int i = 0; i < 32; ++i)
-        printf ("%02X", digest[i]);
+      if (!get_data)
+	{
+	  for (int i = 0; i < 32; ++i)
+	    printf ("%02X", digest[i]);
+	}
+      if (!explicit_write)
+	goto done;
     }
   else
     {
-      bool fingered = false;
+      fingerprint_set_hash(fb);
+      if (fb->code != FINGERPRINT_ERROR_NONE)
+	goto done;
+    }
 
-      for (char *finger = buf;
-	   (finger = memmem (finger, buf + chunksz - finger,
-			     (unsigned char *) fingerprint,
-			     sizeof fingerprint));
-	   finger++)
-	{
-	  if (! (fseeko (f, finger - buf, SEEK_SET) == 0
-		 && fwrite (digest, 1, sizeof digest, f) == sizeof digest))
-	    {
-	      perror (file);
-	      return EXIT_FAILURE;
-	    }
-	  fingered = true;
-	}
+  if (!before && data != NULL)
+    {
+      fingerprint_set_data (fb, pos, fp_data);
+      if (fb->code != FINGERPRINT_ERROR_NONE)
+	goto done;
+    }
 
-      if (!fingered)
-	{
-	  fprintf (stderr, "%s: %s: missing fingerprint\n", prog, file);
-	  return EXIT_FAILURE;
-	}
+  if (fb->outfile != NULL)
+    {
+      fingerprint_write_outfile (fb);
+      if (fb->code != FINGERPRINT_ERROR_NONE)
+	goto done;
     }
 
-  if (fclose (f) != 0)
+ done:
+  int err_cnt = 0;
+  if (fb != NULL)
     {
-      perror (file);
-      return EXIT_FAILURE;
+      err_cnt = report_buffer_errors (fb);
+      r = fingerprint_release_buffer(fb,errnos);
+      fb = NULL;
     }
+  err_cnt += report_errors(r, errnos);
+  if (err_cnt > 0)
+    return EXIT_FAILURE;
 
   return EXIT_SUCCESS;
 }
 
+
+
 /* make-fingerprint.c ends here */
diff --git a/lib/fingerprint.c b/lib/fingerprint.c
index a88746c9b46..32711d363d7 100644
--- a/lib/fingerprint.c
+++ b/lib/fingerprint.c
@@ -18,9 +18,42 @@
 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
 
 #include <config.h>
-
+#include <stdlib.h>
 #include "fingerprint.h"
 
+#include <limits.h>
+#include <stdarg.h>
+#include <stdint.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+#include <sys/stat.h>
+
+#include <sysstdio.h>
+
+#include <fingerprint.h>
+#include <getopt.h>
+#include <intprops.h>
+#include <min-max.h>
+#include <sha256.h>
+
+#ifndef SSIZE_MAX
+# define SSIZE_MAX TYPE_MAXIMUM (ssize_t)
+#endif
+
+#ifdef WINDOWSNT
+/* Defined to be sys_fopen in ms-w32.h, but only #ifdef emacs, so this
+   is really just insurance.  */
+#undef fopen
+#include <direct.h>
+
+#ifndef MINGW_W64
+# undef fseeko
+# define fseeko fseeko64
+#endif
+#endif /* WINDOWSNT */
+
 /* This random fingerprint was generated by the shell command:
 
    shuf -i 0-255 -n 32 -r | awk '{printf "   0x%.02X,\n", $0}'
@@ -29,38 +62,688 @@
    by a fingerprint of the temporary Emacs executable that was built
    along the way.  */
 
-volatile unsigned char fingerprint[] =
+/* The complement of the pristine (reference) fingerprint so
+   the original executable can be recovered after
+   setting the fingerprint.
+ */
+#define charcomp(x) ((unsigned char) ~(x))
+
+
+volatile struct fingerprint_storage fingerprint_storage =
   {
-   0xDE,
-   0x86,
-   0xBB,
-   0x99,
-   0xFF,
-   0xF5,
-   0x46,
-   0x9A,
-   0x9E,
-   0x3F,
-   0x9F,
-   0x5D,
-   0x9A,
-   0xDF,
-   0xF0,
-   0x91,
-   0xBD,
-   0xCD,
-   0xC1,
-   0xE8,
-   0x0C,
-   0x16,
-   0x1E,
-   0xAF,
-   0xB8,
-   0x6C,
-   0xE2,
-   0x2B,
-   0xB1,
-   0x24,
-   0xCE,
-   0xB0,
+    {
+      charcomp(0xDE),
+      charcomp(0x86),
+      charcomp(0xBB),
+      charcomp(0x99),
+      charcomp(0xFF),
+      charcomp(0xF5),
+      charcomp(0x46),
+      charcomp(0x9A),
+      charcomp(0x9E),
+      charcomp(0x3F),
+      charcomp(0x9F),
+      charcomp(0x5D),
+      charcomp(0x9A),
+      charcomp(0xDF),
+      charcomp(0xF0),
+      charcomp(0x91),
+      charcomp(0xBD),
+      charcomp(0xCD),
+      charcomp(0xC1),
+      charcomp(0xE8),
+      charcomp(0x0C),
+      charcomp(0x16),
+      charcomp(0x1E),
+      charcomp(0xAF),
+      charcomp(0xB8),
+      charcomp(0x6C),
+      charcomp(0xE2),
+      charcomp(0x2B),
+      charcomp(0xB1),
+      charcomp(0x24),
+      charcomp(0xCE),
+      charcomp(0xB0)
+    },
+    {
+      0xDE,
+      0x86,
+      0xBB,
+      0x99,
+      0xFF,
+      0xF5,
+      0x46,
+      0x9A,
+      0x9E,
+      0x3F,
+      0x9F,
+      0x5D,
+      0x9A,
+      0xDF,
+      0xF0,
+      0x91,
+      0xBD,
+      0xCD,
+      0xC1,
+      0xE8,
+      0x0C,
+      0x16,
+      0x1E,
+      0xAF,
+      0xB8,
+      0x6C,
+      0xE2,
+      0x2B,
+      0xB1,
+      0x24,
+      0xCE,
+      0xB0
+    },
+    FINGERPRINT_DATA_LAYOUT_VERSION,
+    FINGERPRINT_DATA_SIZE,
+    {0}
+  };
+#undef charcomp
+
+static unsigned char hex_value[256] =
+  { 0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,/* 32 */
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,/* 64 */
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,/* 96 */
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,/* 128 */
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,/* 160 */
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,/* 192 */
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,/* 224 */
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,
+    0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,0xFF,/* 256 */
+    ['0'] = 0, ['1'] = 1, ['2'] = 2, ['3'] = 3,
+    ['4'] = 4, ['5'] = 5, ['6'] = 6, ['7'] = 7,
+    ['8'] = 8, ['9'] = 9, ['a'] = 10, ['b'] = 11,
+    ['c'] = 12, ['d'] = 13, ['e'] = 14, ['f'] = 15,
+    ['A'] = 10, ['B'] = 11,['C'] = 12, ['D'] = 13,
+    ['E'] = 14, ['F'] = 15
   };
+
+
+/* Parse a modified subset of C99 string literals */
+/* No unicode */
+/* Explicit hexadecimal escapes only allowed to encode a byte */
+/* Additional escape form to allow explicit specification of
+   the encoded integer:
+   \#(2|4|8)x - records the translation into 2,4, or 8 bytes
+                   in the native endianness.
+*/
+/* The error reporting protocol(?) is terrible,
+   Only decoupled from the make-fingerprint driver to
+   allow for testing of the routine.
+ */
+PSLERR
+parse_string_literal (const unsigned char *in,unsigned char *out,
+		      int sz, bool nullterm, ptrdiff_t *n)
+{
+  const unsigned char *pin = in;
+  unsigned char *pout = out;
+  uint8_t val_size = 1;
+  unsigned char c;
+  const unsigned char *o, *o0;
+
+  while (*pin && (pout - out) < sz)
+    {
+      if (*pin != '\\')
+	{
+	  *(pout++) = *(pin++);
+	  continue;
+	}
+      o = pin++;
+      if (!*pin)
+	{
+	  *(pout++) = '\\';
+	  continue;
+	}
+      switch (*pin)
+	{
+	case 'a':
+	  *(pout++) = '\a';
+	  continue;
+	case 'b':
+	  *(pout++) = '\b';
+	  continue;
+	case 'f':
+	  *(pout++) = '\f';
+	  continue;
+	case 'n':
+	  *(pout++) = '\n';
+	  continue;
+	case 'r':
+	  *(pout++) = '\r';
+	  continue;
+	case 't':
+	  *(pout++) = '\t';
+	  continue;
+	case 'v':
+	  *(pout++) = '\v';
+	  continue;
+	case '\'':
+	  *(pout++) = '\'';
+	  continue;
+	case '"':
+	  *(pout++) = '"';
+	  continue;
+	case '?':
+	  *(pout++) = '?';
+	  continue;
+	case '\\':
+	  *(pout++) = '\\';
+	  continue;
+	case '0': case '1': case '2': case '3': case '4': case '5':
+	case '6': case '7':
+	  goto parse_octal;
+	case '#':
+	  o0 = o;
+	  o = pin;
+	  if ( (c = *(++pin)) )
+	    {
+	      switch (c)
+		{
+		case '1': case '2': case '3': case '4':
+		  val_size = 1 << (c - '1');
+		  c = *++pin;
+		  pin++;
+		  if ( c != 'x' && c != 'X')
+		    {
+		      pin = o;
+		      goto bad_escape;
+		    }
+		  if (pout + val_size -1 - out < sz)
+		    goto parse_hex;
+		  pin = o;
+		  goto input_too_large;
+		default:
+		  pin = o;
+		  goto bad_escape;
+		}
+	    }
+	  pin = o;
+	  goto bad_escape;
+	case 'X': case 'x':
+	  val_size = 1;
+	  o0 = o;
+	  o = pin;
+	  if (*++pin)
+	    goto parse_hex;
+	  pin--;
+	   __attribute__ ((fallthrough));
+	default:
+	  c = *pin;
+	  if (isprint(c))
+	    {
+	      *(pout++) = c;
+	      pin++;
+	      continue;
+	    }
+	  /* else */
+	bad_escape:
+	  if (n != NULL) *n = o0 - in;
+	  return PSLERR_BAD_ESCAPE;
+	}
+    parse_octal:
+      {
+	o = pin;
+	unsigned int acc = (*(pin++) - '0');
+	char tmp;
+	if (!(*pin) || !( (tmp = *pin - '0'), tmp >= 0 && tmp < 8))
+	  {
+	    *(pout++) = (unsigned char) acc;
+	    continue;
+	  }
+	acc <<= 3;
+	acc += tmp;
+	pin++;
+	if (!(*pin) || !( (tmp = *pin - '0'), tmp >= 0 && tmp < 8))
+	  {
+	    *(pout++) = (unsigned char) acc;
+	    continue;
+	  }
+	acc <<= 3;
+	acc += tmp;
+	if (acc > 255)
+	  {
+	    if (n != NULL) *n = o0 - in;
+	    return PSLERR_BAD_OCTAL;
+	  }
+	*(pout++) = (unsigned char) acc;
+	continue;
+      }
+    parse_hex:
+      o0 = o;
+      o = pin;
+      uint64_t acc;
+      /* maximum number of digits to read */
+      unsigned char lim = 2*val_size;
+      unsigned char c = hex_value[*(pin++)];
+      if (c == 0xFF)
+	{
+	  if (n != NULL) *n = o0 - in;
+	  return PSLERR_BAD_HEX;
+	}
+      acc = c;
+      while ( pin - o < lim && ((c = hex_value[*pin]) != 0xFF) && pin++)
+	{
+	  acc <<= 4;
+	  acc += c;
+	}
+      switch (val_size)
+	{
+	case 1:
+	  *((uint8_t *) pout) = (uint8_t) acc;
+	  break;
+	case 2:
+	  *((uint16_t *) pout) = (uint16_t) acc;
+	  break;
+	case 4:
+	  *((uint32_t *) pout) = (uint32_t) acc;
+	  break;
+	case 8:
+	  *((uint64_t *) pout) = acc;
+	  break;
+	default:
+	  if (n != NULL) *n = o0 - in;
+	  return PSLERR_BAD_HEX;
+	}
+      pout += val_size;
+    }
+
+  if (nullterm && pout - out < sz - 1)
+    {
+      *(pout++) = 0;
+    }
+  else if (nullterm)
+    {
+      if (n != NULL) *n = pin - in;
+      return PSLERR_OVERFLOW;
+    }
+
+  if (*pin)
+    {
+    input_too_large:
+      if (n != NULL) *n = pin - in;
+      return PSLERR_OVERFLOW;
+    }
+
+  if (n != NULL) *n = pout - out;
+  return   PSLERR_NONE;
+}
+
+void report_PSLERR (FILE *stream,
+		    const unsigned char *in,
+		    PSLERR code,
+		    int sz,
+		    ptrdiff_t position)
+{
+  switch (code)
+    {
+    case PSLERR_OVERFLOW:
+      fprintf (stream, "Error: parsed input string exceeded allocated "
+	       "space (%d bytes) at character %ld.\n", sz, position);
+      fprintf (stream, "Input: '%s'\n",in);
+      break;
+    case PSLERR_BAD_OCTAL:
+      fprintf (stream, "Error: could not parse octal escape "
+	       "sequence at character %ld in '%s'\n",
+	       position, in);
+      break;
+    case PSLERR_BAD_HEX:
+      fprintf (stream, "Error: could not parse hex escape "
+	       "sequence at character %ld in '%s'\n",
+	       position, in);
+      break;
+    case PSLERR_BAD_ESCAPE:
+      fprintf (stream, "Error: Unrecognized escape "
+	       "sequence at character %ld in '%s'\n",
+	       position, in);
+      break;
+    case PSLERR_NONE:
+      break;
+    default:
+      fprintf (stderr, "Error code not recognized.\n");
+      exit (EXIT_FAILURE);
+    }
+}
+
+
+
+
+
+
+/* initialize a fingerprint operation */
+extern FINGERPRINT_ERROR
+fingerprint_get_buffer(char *file,
+		       char *outfile,
+		       struct fingerprint_replacement_options *opts,
+		       struct fingerprint_buffer **fbp,
+		       int errnos[3])
+{
+  FINGERPRINT_ERROR result = FINGERPRINT_ERROR_NONE;
+  struct fingerprint_buffer *fb =
+    calloc(1,sizeof(struct fingerprint_buffer));
+  if (fb == NULL)
+    return FINGERPRINT_ERROR_BUFFER_ALLOCATION;
+  memcpy(&(fb->opts),opts,sizeof(struct  fingerprint_replacement_options));
+  fb->code = FINGERPRINT_ERROR_NONE;
+  bool raw = opts ? opts->keep_hash : false;
+  bool inplace = opts ? opts->inplace : false;
+  int noffsets = 0;
+  if (file == NULL || !(*file))
+    {
+      result |= FINGERPRINT_ERROR_NO_INFILE;
+      goto done;
+    }
+  ptrdiff_t file_name_sz = strlen(file)+1;
+  fb->file = (char *) malloc(file_name_sz);
+  if (fb->file == NULL)
+    {
+      errnos[0] = errno;
+      result = FINGERPRINT_ERROR_BUFFER_ALLOCATION;
+      goto done;
+    }
+  memcpy (fb->file,file,file_name_sz);
+  if (!inplace && (!outfile || !(*outfile)))
+    {
+      result |= FINGERPRINT_ERROR_NO_INPLACE;
+      goto done;
+    }
+  if (outfile != NULL)
+    {
+      char filepath[PATH_MAX],outfilepath[PATH_MAX];
+      if (!(realpath(file,filepath)))
+	{
+	  result |= FINGERPRINT_ERROR_NO_INFILE;
+	  goto done;
+	}
+      if (realpath(outfile, outfilepath)
+	  && !strcmp(filepath,outfilepath))
+	{
+	  if (!inplace)
+	    {
+	      result |= FINGERPRINT_ERROR_NO_INPLACE;
+	      goto done;
+	    }
+	  else
+	    {
+	      fb->outfile = raw ? NULL : fb->file;
+	    }
+	}
+      else
+	{
+	  ptrdiff_t outfile_name_sz = strlen(outfile)+1;
+	  fb->outfile = (char *) malloc(outfile_name_sz);
+	  if (fb->outfile == NULL)
+	    {
+	      errnos[0] = errno;
+	      result = FINGERPRINT_ERROR_BUFFER_ALLOCATION;
+	      goto done;
+	    }
+	  memcpy (fb->outfile,outfile,outfile_name_sz);
+	}
+    }
+  else
+    {
+      fb->outfile = fb->file;
+    }
+  if (fb->outfile !=  fb->file)
+    fb->in = fopen (file, "r" FOPEN_BINARY);
+  else
+    {
+      fb->in = fopen (file,"r+" FOPEN_BINARY);
+      fb->out = fb->in;
+    }
+
+  struct stat st;
+  if (!fb->in || fstat (fileno (fb->in), &st) != 0)
+    {
+      result |= FINGERPRINT_ERROR_INFILE_NOT_OPENED;
+      errnos[0] = errno;
+      goto done;
+    }
+
+  if (!S_ISREG (st.st_mode))
+    {
+      result |= FINGERPRINT_ERROR_INFILE_NOT_REGULAR;
+      goto done;
+    }
+
+  ptrdiff_t maxlen = min (min (TYPE_MAXIMUM (off_t), PTRDIFF_MAX),
+			  min (SIZE_MAX, SSIZE_MAX));
+  if (maxlen <= st.st_size)
+    {
+      result |= FINGERPRINT_ERROR_BUFFER_SIZE;
+      goto done;
+    }
+
+  {
+    ptrdiff_t buffer_size = st.st_size;
+    unsigned char *buffer = (unsigned char *) malloc (buffer_size + 1);
+    if (!buffer)
+      {
+	result |= FINGERPRINT_ERROR_BUFFER_ALLOCATION;
+	errnos[0] = errno;
+	goto done;
+      }
+    fb->buffer = buffer;
+    fb->buffer_size = buffer_size + 1;
+  }
+  size_t chunksz = fread (fb->buffer, 1, fb->buffer_size, fb->in);
+  if (ferror (fb->in) || chunksz != st.st_size)
+    {
+      fb->errnos[0] = errno;
+      result |= FINGERPRINT_ERROR_INFILE_READ;
+      goto done;
+    }
+
+  for (unsigned char *finger = fb->buffer;
+       (finger = memmem (finger, fb->buffer + chunksz - finger,
+			 (unsigned char *) fingerprint_storage.pristine_hash_c,
+			 sizeof fingerprint_storage.pristine_hash_c));
+       finger++)
+    {
+      noffsets++;
+      if (noffsets > 1)
+	{
+	  result |= FINGERPRINT_ERROR_HASH_TOO_MANY;
+	  goto done;
+	}
+      fb->offset = finger - fb->buffer;
+    }
+  if (noffsets == 0)
+    {
+      result |= FINGERPRINT_ERROR_HASH_NOT_FOUND;
+      goto done;
+    }
+  struct fingerprint_storage_header *hdr =
+    (struct fingerprint_storage_header *) (fb->buffer + fb->offset);
+  ptrdiff_t store_sz = sizeof(struct fingerprint_storage_header) + hdr->size;
+  unsigned char *tmp = (unsigned char *) calloc(store_sz,1);
+  if (tmp == NULL)
+    {
+      errnos[0] = errno;
+      result = FINGERPRINT_ERROR_BUFFER_ALLOCATION;
+      goto done;
+    }
+  /* make sure there is a pristine copy of the existing data */
+  memcpy (tmp, fb->buffer + fb->offset, store_sz);
+  fb->hdr = (struct fingerprint_storage_header *) tmp;
+
+ done:
+  if (result != FINGERPRINT_ERROR_NONE)
+    result |= fingerprint_release_buffer (fb,errnos);
+  else
+    *fbp = fb;
+  return result;
+}
+
+FINGERPRINT_ERROR
+fingerprint_release_buffer (struct fingerprint_buffer *fb, int errnos[3])
+{
+  if (fb == NULL)
+    return FINGERPRINT_ERROR_NONE;
+  FINGERPRINT_ERROR result = fb->code;
+  if (!errnos[0])
+    {
+      errnos[0] = fb->errnos[0];
+    }
+  if (fb->out && fb->out != fb->in && (fclose (fb->out) != 0))
+    {
+      result |= FINGERPRINT_ERROR_OUTFILE_CLOSE;
+      errnos[1] = errno;
+    }
+  fb->out = NULL;
+  if (fb->in && fclose (fb->in) != 0)
+    {
+      result |= FINGERPRINT_ERROR_INFILE_CLOSE;
+      errnos[2] = errno;
+    }
+  fb->in = NULL;
+  if (fb->outfile && fb->outfile != fb->file)
+    free(fb->outfile);
+  if (fb->file)
+    free(fb->file);
+  if (fb->buffer)
+    free(fb->buffer);
+  if (fb->hdr != NULL)
+    free(fb->hdr);
+  free (fb);
+  return result;
+}
+
+/* clears existing data and copies the provided data
+   in */
+void
+fingerprint_set_data(struct fingerprint_buffer *fb,
+		     ptrdiff_t data_size,
+		     unsigned char *data)
+{
+  ptrdiff_t sz = fb->hdr->size;
+  if (data_size > sz)
+    {
+      fb->code |= FINGERPRINT_ERROR_DATA_OVERFLOW;
+      return;
+    }
+
+  struct fingerprint_storage_header *fph;
+  fph = (struct fingerprint_storage_header *) (fb->buffer + fb->offset);
+  memcpy (fph->data, data, data_size);
+  if (data_size < sz)
+    {
+      memset (fph->data + data_size,
+	      0,
+	      (sz - data_size));
+    }
+}
+
+/* calculates hash after resetting the hash value to its
+   pristine state, but leaving any other stored data
+   as is */
+void
+fingerprint_set_hash(struct fingerprint_buffer *fb)
+{
+  fingerprint_reset_hash (fb);
+  struct sha256_ctx ctx;
+  sha256_init_ctx (&ctx);
+  struct fingerprint_storage_header *fph;
+  fph = (struct fingerprint_storage_header *) (fb->buffer + fb->offset);
+  sha256_process_bytes (fb->buffer, fb->buffer_size - 1, &ctx);
+  /* overwrite the hash in the in-memory copy of the file */
+  sha256_finish_ctx (&ctx, fph->hash);
+  fingerprint_get_hash (fb);
+}
+
+/* reset hash in in-memory copy of file */
+void
+fingerprint_reset_hash(struct fingerprint_buffer *fb)
+{
+  unsigned char pristine_digest[FINGERPRINT_HASH_SIZE];
+  for (int i = 0; i < FINGERPRINT_HASH_SIZE; i++)
+    pristine_digest[i] = ~fingerprint_storage.pristine_hash_c[i];
+  struct fingerprint_storage_header *fph;
+  fph = (struct fingerprint_storage_header *) (fb->buffer + fb->offset);
+  memcpy (fph->hash,pristine_digest,FINGERPRINT_HASH_SIZE);
+}
+
+void
+fingerprint_get_hash(struct fingerprint_buffer *fb)
+{
+  struct fingerprint_storage_header *fph;
+  fph = (struct fingerprint_storage_header *) (fb->buffer + fb->offset);
+  memcpy (fb->digest, fph->hash,FINGERPRINT_HASH_SIZE);
+}
+
+void
+fingerprint_write_outfile(struct fingerprint_buffer *fb)
+{
+  struct fingerprint_storage_header *fph = NULL;
+  unsigned char *store = (fb->buffer + fb->offset);
+  fph = (struct fingerprint_storage_header *) store;
+  ptrdiff_t data_size = fph->size;
+  ptrdiff_t store_size = sizeof(struct fingerprint_storage_header)
+    + data_size;
+  ptrdiff_t n = 0;
+  ptrdiff_t chunksz;
+  if (fb->out == NULL)
+    {
+      if (fb->outfile == NULL)
+	goto done;
+      if (!(fb->out = fopen (fb->outfile, "w" FOPEN_BINARY)))
+	{
+	  fb->code |= FINGERPRINT_ERROR_OUTFILE_CREATION;
+	  fb->errnos[0] = errno;
+	  return;
+	}
+      while ((chunksz = fwrite (fb->buffer + n, 1, fb->buffer_size-1-n,fb->out)))
+	n += chunksz;
+      if (n < fb->buffer_size - 1)
+	{
+	  fb->code |= FINGERPRINT_ERROR_OUTFILE_WRITE;
+	  fb->errnos[0] = errno;
+	}
+      goto done;
+    }
+  /* otherwise only write out the storage area */
+  if (! (fseeko (fb->out, fb->offset, SEEK_SET) == 0))
+    {
+      fb->code |= FINGERPRINT_ERROR_OUTFILE_WRITE;
+      fb->errnos[0] = errno;
+      goto done;
+    }
+  while ((chunksz = fwrite (store + n, 1, store_size - n, fb->out)))
+    n += chunksz;
+  if (n < store_size)
+    {
+      fb->code |= FINGERPRINT_ERROR_OUTFILE_WRITE;
+      fb->errnos[0] = errno;
+      goto done;
+    }
+
+ done:
+}
diff --git a/lib/fingerprint.h b/lib/fingerprint.h
index 2dd4367b15d..e9acb5478f3 100644
--- a/lib/fingerprint.h
+++ b/lib/fingerprint.h
@@ -20,9 +20,164 @@ Copyright (C) 2016, 2018-2025 Free Software Foundation, Inc.
 #ifndef EMACS_FINGERPRINT_H
 #define EMACS_FINGERPRINT_H
 
+#include "config.h"
+#include <stdint.h>
+#include <stdio.h>
+#include <errno.h>
+
+/* default to 16K */
+#ifndef CONFIG_FINGERPRINT_DATA_SIZE
+#define CONFIG_FINGERPRINT_DATA_SIZE 1 << 14
+#endif
+
+#ifndef FINGERPRINT_DATA_LAYOUT_VERSION
+#define FINGERPRINT_DATA_LAYOUT_VERSION 0
+#endif
+
+enum {
+  FINGERPRINT_HASH_SIZE  = 32,
+  FINGERPRINT_DATA_SIZE = CONFIG_FINGERPRINT_DATA_SIZE
+};
+
 /* We generate fingerprint.c and fingerprint.o from all the sources in
    Emacs.  This way, we have a unique value that we can use to pair
    data files (like a dump file) with a specific build of Emacs.  */
-extern volatile unsigned char fingerprint[32];
+
+/* Ensure zeroed data area follows fingerprint data so external tools can
+   embed constants for program use after compiling but before fingerprinting.
+   Embedded size is for benefit of external tooling.
+*/
+
+struct fingerprint_storage_header
+{
+  unsigned char pristine_hash_c[FINGERPRINT_HASH_SIZE];
+  unsigned char hash[FINGERPRINT_HASH_SIZE];
+  uint64_t version; /* ID for the layout of the data */
+  uint64_t size;
+  unsigned char data[];
+};
+
+struct fingerprint_storage
+{
+  unsigned char pristine_hash_c[FINGERPRINT_HASH_SIZE];
+  unsigned char hash[FINGERPRINT_HASH_SIZE];
+  uint64_t version; /* ID for the layout of the data */
+  uint64_t size;
+  unsigned char data[FINGERPRINT_DATA_SIZE];
+};
+
+extern volatile struct fingerprint_storage fingerprint_storage;
+
+struct fingerprint_replacement_options
+{
+  bool keep_hash; /* this used to be the "raw" option */
+  bool inplace;  /* modify file in place */
+  ptrdiff_t max_data_size;
+};
+
+/* Enable error reporting in make_fingerprint as if
+   the modification function was still there. */
+typedef enum FINGERPRINT_ERROR
+{
+  FINGERPRINT_ERROR_NONE = 0,
+  FINGERPRINT_ERROR_NO_INFILE = 1,
+  FINGERPRINT_ERROR_INFILE_NOT_OPENED = 1 << 1,
+  FINGERPRINT_ERROR_INFILE_NOT_REGULAR = 1 << 2,
+  FINGERPRINT_ERROR_BUFFER_SIZE = 1 << 3,
+  FINGERPRINT_ERROR_BUFFER_ALLOCATION = 1 << 4,
+  FINGERPRINT_ERROR_FPSTORE_ALLOCATION = 1 << 5,
+  FINGERPRINT_ERROR_INFILE_READ = 1 << 6,
+  FINGERPRINT_ERROR_HASH_NOT_FOUND = 1 << 7,
+  FINGERPRINT_ERROR_HASH_TOO_MANY = 1 << 8,
+  FINGERPRINT_ERROR_OUTFILE_CREATION = 1 << 9,
+  FINGERPRINT_ERROR_OUTFILE_WRITE = 1 << 10,
+  FINGERPRINT_ERROR_NO_INPLACE = 1 << 11,
+  FINGERPRINT_ERROR_RAW_NO_DIGEST = 1 << 12,
+  FINGERPRINT_ERROR_DATA_OVERFLOW = 1 << 13,
+  FINGERPRINT_ERROR_OUTFILE_CLOSE = 1 << 14,
+  FINGERPRINT_ERROR_INFILE_CLOSE = 1 << 15,
+  FINGERPRINT_ERROR_FILE_CLOSE = ( FINGERPRINT_ERROR_OUTFILE_CLOSE
+				   | FINGERPRINT_ERROR_INFILE_CLOSE),
+  FINGERPRINT_ERROR_UNIQUE_MASK = 0x1FFF
+} FINGERPRINT_ERROR;
+
+/* the data necessary to create a
+   continuation from the middle of
+   fingerprint_modify_file.
+   Some of the pointers are from the function
+   calling fingerprint_modify_file, so their
+   lifetime may not survive that function's
+   activation.
+*/
+struct fingerprint_buffer
+{
+  char *file;
+  char *outfile;
+  FILE *in;
+  FILE *out;
+  struct fingerprint_replacement_options opts;
+  unsigned char digest[FINGERPRINT_HASH_SIZE];
+  ptrdiff_t buffer_size;
+  unsigned char *buffer;
+  ptrdiff_t offset;
+  /* copy of the original fingerprint storage in the file */
+  struct fingerprint_storage_header *hdr;
+  FINGERPRINT_ERROR code;
+  int errnos[3];
+};
+
+
+/* initialize a fingerprint operation */
+extern FINGERPRINT_ERROR
+fingerprint_get_buffer(char *file,
+		       char *outfile,
+		       struct fingerprint_replacement_options *opts,
+		       struct fingerprint_buffer **fbp,
+		       int errnos[3]);
+
+
+extern FINGERPRINT_ERROR
+fingerprint_release_buffer(struct fingerprint_buffer *fb, int errnos[3]);
+
+extern void
+fingerprint_set_hash(struct fingerprint_buffer *fb);
+extern void
+fingerprint_reset_hash(struct fingerprint_buffer *fb);
+/* set */
+extern void
+fingerprint_get_hash(struct fingerprint_buffer *fb);
+
+extern void
+fingerprint_set_data(struct fingerprint_buffer *fb,
+		     ptrdiff_t data_size,
+		     unsigned char *data);
+
+extern void
+fingerprint_write_outfile(struct fingerprint_buffer *fb);
+
+
+
+
+
+typedef enum PSLERR
+{
+  PSLERR_NONE,
+  PSLERR_OVERFLOW,
+  PSLERR_BAD_OCTAL,
+  PSLERR_BAD_HEX,
+  PSLERR_BAD_ESCAPE
+} PSLERR;
+
+extern PSLERR
+parse_string_literal (const unsigned char *in,
+		      unsigned char *out,
+		      int sz,
+		      bool nullterm,
+		      ptrdiff_t *n);
+extern void report_PSLERR (FILE *stream,
+			   const unsigned char *in,
+			   PSLERR code,
+			   int sz,
+			   ptrdiff_t position);
 
 #endif
diff --git a/lib/test/Makefile.in b/lib/test/Makefile.in
new file mode 100644
index 00000000000..e70fdfb6039
--- /dev/null
+++ b/lib/test/Makefile.in
@@ -0,0 +1,194 @@
+### @configure_input@
+
+# Copyright 2017-2025 Free Software Foundation, Inc.
+
+# 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/>.
+
+SHELL = @SHELL@
+
+# Prevent any settings in the user environment causing problems.
+unexport EMACSDATA EMACSDOC EMACSLOADPATH EMACSPATH
+
+# Following ../lisp/Makefile.in.
+EMACS = ../src/emacs${EXEEXT}
+EMACSOPT = -batch --no-site-file --no-site-lisp
+
+# ==================== Things 'configure' will edit ====================
+
+CC=@CC@
+CXX=@CXX@
+CFLAGS=@CFLAGS@
+CXXFLAGS=@CXXFLAGS@
+CPPFLAGS = @CPPFLAGS@
+LDFLAGS = @LDFLAGS@
+
+version=@version@
+## Used in $archlibdir.
+configuration=@configuration@
+EXEEXT=@EXEEXT@
+C_SWITCH_SYSTEM=@C_SWITCH_SYSTEM@
+C_SWITCH_MACHINE=@C_SWITCH_MACHINE@
+PROFILING_CFLAGS = @PROFILING_CFLAGS@
+WARN_CFLAGS = @WARN_CFLAGS@
+WERROR_CFLAGS = @WERROR_CFLAGS@
+
+# Program name transformation.
+TRANSFORM = @program_transform_name@
+
+srcdir = @srcdir@
+VPATH = @srcdir@
+
+# Cross-compilation setup
+
+XCONFIGURE=@XCONFIGURE@
+
+ifneq ($(XCONFIGURE),)
+vpath $(srcdir)
+endif
+
+# The top-level source directory, also set by configure.
+top_srcdir=@top_srcdir@
+# MinGW CPPFLAGS may use this.
+abs_top_srcdir=@abs_top_srcdir@
+
+top_builddir = @top_builddir@
+
+# ========================== Lists of Files ===========================
+
+## Haiku build-time support
+HAVE_BE_APP=@HAVE_BE_APP@
+HAIKU_LIBS=@HAIKU_LIBS@
+HAIKU_CFLAGS=@HAIKU_CFLAGS@
+
+## Android build-time support
+ANDROID=@ANDROID@
+
+
+## -lkrb or -lkrb4 if needed
+KRB4LIB=@KRB4LIB@
+## -ldes or -ldes425 if needed
+DESLIB=@DESLIB@
+## -lkrb5 if needed
+KRB5LIB=@KRB5LIB@
+## -lk5crypto or -lcrypto if needed
+CRYPTOLIB=@CRYPTOLIB@
+## -lcom_err if needed
+COM_ERRLIB=@COM_ERRLIB@
+## -lhesiod if needed
+LIBHESIOD=@LIBHESIOD@
+## -lresolv if HAVE_LIBRESOLV
+LIBRESOLV=@LIBRESOLV@
+## -llockfile if HAVE_LIBLOCKFILE or -lmail if HAVE_LIBMAIL
+LIBS_MAIL=@LIBS_MAIL@
+## empty or -lrt or -lposix4 if HAVE_CLOCK_GETTIME
+CLOCK_TIME_LIB = @CLOCK_TIME_LIB@
+## empty or -lbcrypt or -ladvapi32
+GETRANDOM_LIB = @GETRANDOM_LIB@
+## Whatever libraries are needed for euidaccess
+EUIDACCESS_LIBGEN=@EUIDACCESS_LIBGEN@
+## Libraries needed for file_has_acl
+FILE_HAS_ACL_LIB=@FILE_HAS_ACL_LIB@
+## empty or -lwsock2 for MinGW
+LIB_WSOCK32=@LIB_WSOCK32@
+
+## Extra libraries for etags
+LIBS_ETAGS = $(CLOCK_TIME_LIB) $(GETRANDOM_LIB)
+
+HAVE_SECCOMP=@HAVE_SECCOMP@
+HAVE_LIBSECCOMP=@HAVE_LIBSECCOMP@
+LIBSECCOMP_LIBS=@LIBSECCOMP_LIBS@
+LIBSECCOMP_CFLAGS=@LIBSECCOMP_CFLAGS@
+SIZEOF_LONG=@SIZEOF_LONG@
+
+## Extra object files for linking for MinGW
+NTLIB = @NTLIB@
+CLIENTRES = @CLIENTRES@
+WINDRES = @WINDRES@
+
+## Some systems define this to request special libraries.
+LIBS_SYSTEM = @LIBS_SYSTEM@
+
+# Flags that could be in WARN_CFLAGS, but are invalid for C++.
+NON_CXX_CFLAGS = -Wmissing-prototypes -Wnested-externs -Wold-style-definition \
+  -Wstrict-prototypes -Wno-override-init
+
+BASE_CFLAGS = $(C_SWITCH_SYSTEM) $(C_SWITCH_MACHINE) \
+	      $(WARN_CFLAGS) $(WERROR_CFLAGS) \
+	      -I. -I../../src -I../../lib \
+	      -I${srcdir} -I${srcdir}/../../src \
+              -I${srcdir}/../../lib
+
+ALL_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${LDFLAGS} ${CPPFLAGS} ${CFLAGS}
+CPP_CFLAGS = ${BASE_CFLAGS} ${PROFILING_CFLAGS} ${CPPFLAGS} ${CFLAGS}
+
+ALL_CXXFLAGS = $(filter-out ${NON_CXX_CFLAGS},${BASE_CFLAGS}) \
+  ${PROFILING_CFLAGS} ${LDFLAGS} ${CPPFLAGS} ${CFLAGS} ${CXXFLAGS} ${HAIKU_CFLAGS}
+
+# Configuration files for .o files to depend on.
+config_h = ../../src/config.h $(srcdir)/../../src/conf_post.h
+
+DRIVERS = parse-string-literal.c
+
+EXE_FILES = ${DRIVERS:.c=${EXEEXT}}
+
+all: $(EXE_FILES)
+.PHONY: all
+
+LOADLIBES = ../libgnu.a $(LIBS_SYSTEM)
+$(EXE_FILES): ../libgnu.a
+
+../lib/libgnu.a: $(config_h)
+	$(MAKE) -C .. all
+
+-include ${top_builddir}/src/verbose.mk
+
+
+.PHONY: install uninstall mostlyclean clean distclean maintainer-clean
+.PHONY: bootstrap-clean check tags
+
+install: 
+	$(info Nothing to install for lib/test)
+
+uninstall:
+	$(info Nothing to uninstall for lib/test)
+
+mostlyclean:
+	rm -f core ./*.o ./*.res
+
+clean: mostlyclean
+	rm -f ${EXE_FILES}
+
+distclean: clean
+	rm -f TAGS Makefile 
+
+bootstrap-clean maintainer-clean: distclean
+
+
+## Test the contents of the directory.
+check: ${EXE_FILES}
+	$(info nothing here yet)
+
+tagsfiles = $(wildcard ${srcdir}/*.[ch])
+
+.PHONY: tags
+tags: TAGS
+TAGS: etags${EXEEXT} ${tagsfiles}
+	./etags ${tagsfiles}
+
+parse-string-literal${EXEEXT}: ${srcdir}/parse-string-literal.c \
+                               $(NTLIB) $(config_h)
+	$(AM_V_CCLD)$(CC) ${ALL_CFLAGS} $< $(NTLIB) $(LOADLIBES) -o $@
+
diff --git a/lib/test/init.sh b/lib/test/init.sh
new file mode 100644
index 00000000000..1e6a399e205
--- /dev/null
+++ b/lib/test/init.sh
@@ -0,0 +1,746 @@
+# source this file; set up for tests
+
+# Copyright (C) 2009-2025 Free Software Foundation, Inc.
+
+# 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/>.
+
+# Using this file in a test
+# =========================
+#
+# The typical skeleton of a test looks like this:
+#
+#   #!/bin/sh
+#   . "${srcdir=.}/init.sh"; path_prepend_ .
+#   Execute some commands.
+#   Note that these commands are executed in a subdirectory, therefore you
+#   need to prepend "../" to relative filenames in the build directory.
+#   Note that the "path_prepend_ ." is useful only if the body of your
+#   test invokes programs residing in the initial directory.
+#   For example, if the programs you want to test are in src/, and this test
+#   script is named tests/test-1, then you would use "path_prepend_ ../src",
+#   or perhaps export PATH='$(abs_top_builddir)/src$(PATH_SEPARATOR)'"$$PATH"
+#   to all tests via automake's TESTS_ENVIRONMENT.
+#   Set the exit code 0 for success, 77 for skipped, or 1 or other for failure.
+#   Use the skip_ and fail_ functions to print a diagnostic and then exit
+#   with the corresponding exit code.
+#   Exit $?
+
+# Executing a test that uses this file
+# ====================================
+#
+# Running a single test:
+#   $ make check TESTS=test-foo.sh
+#
+# Running a single test, with verbose output:
+#   $ make check TESTS=test-foo.sh VERBOSE=yes
+#
+# Running a single test, keeping the temporary directory:
+#   $ make check TESTS=test-foo.sh KEEP=yes
+#
+# Running a single test, with single-stepping:
+#   1. Go into a sub-shell:
+#   $ bash
+#   2. Set relevant environment variables from TESTS_ENVIRONMENT in the
+#      Makefile:
+#   $ export srcdir=../../tests # this is an example
+#   3. Execute the commands from the test, copy&pasting them one by one:
+#   $ . "$srcdir/init.sh"; path_prepend_ .
+#   ...
+#   4. Finally
+#   $ exit
+
+# =============================================================================
+# Elementary diagnostics
+
+ME_=`expr "./$0" : '.*/\(.*\)$'`
+
+# Prepare PATH_SEPARATOR.
+# The user is always right.
+if test "${PATH_SEPARATOR+set}" != set; then
+  # Determine PATH_SEPARATOR by trying to find /bin/sh in a PATH which
+  # contains only /bin. Note that ksh looks also at the FPATH variable,
+  # so we have to set that as well for the test.
+  PATH_SEPARATOR=:
+  (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 \
+    && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 \
+           || PATH_SEPARATOR=';'
+       }
+fi
+
+# We use a trap below for cleanup.  This requires us to go through
+# hoops to get the right exit status transported through the handler.
+# So use 'Exit STATUS' instead of 'exit STATUS' inside of the tests.
+# Turn off errexit here so that we don't trip the bug with OSF1/Tru64
+# sh inside this function.
+Exit () { set +e; (exit $1); exit $1; }
+
+# Print warnings (e.g., about skipped and failed tests) to this file number.
+# Override by defining to say, 9, in init.cfg, and putting say,
+#   export ...ENVVAR_SETTINGS...; $(SHELL) 9>&2
+# in the definition of TESTS_ENVIRONMENT in your tests/Makefile.am file.
+# This is useful when using automake's parallel tests mode, to print
+# the reason for skip/failure to console, rather than to the .log files.
+: ${stderr_fileno_=2}
+
+# Note that correct expansion of "$*" depends on IFS starting with ' '.
+# Always write the full diagnostic to stderr.
+# When stderr_fileno_ is not 2, also emit the first line of the
+# diagnostic to that file descriptor.
+warn_ ()
+{
+  # If IFS does not start with ' ', set it and emit the warning in a subshell.
+  case $IFS in
+    ' '*) printf '%s\n' "$*" >&2
+          test $stderr_fileno_ = 2 \
+            || { printf '%s\n' "$*" | sed 1q >&$stderr_fileno_ ; } ;;
+    *) (IFS=' '; warn_ "$@");;
+  esac
+}
+fail_ () { warn_ "$ME_: failed test: $@"; Exit 1; }
+skip_ () { warn_ "$ME_: skipped test: $@"; Exit 77; }
+fatal_ () { warn_ "$ME_: hard error: $@"; Exit 99; }
+framework_failure_ () { warn_ "$ME_: set-up failure: $@"; Exit 99; }
+
+# =============================================================================
+# Ensure the shell supports modern syntax.
+
+# Sanitize this shell to POSIX mode, if possible.
+DUALCASE=1; export DUALCASE
+if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then
+  emulate sh
+  NULLCMD=:
+  alias -g '${1+"$@"}'='"$@"'
+  setopt NO_GLOB_SUBST
+else
+  case `(set -o) 2>/dev/null` in
+    *posix*) set -o posix ;;
+  esac
+fi
+
+# We require $(...) support unconditionally.
+# We require that the printf built-in work correctly regarding octal escapes;
+# this eliminates /bin/sh on AIX 7.2.
+# We require non-surprising "local" semantics (this eliminates dash).
+# This takes the admittedly draconian step of eliminating dash, because the
+# assignment tab=$(printf '\t') works fine, yet preceding it with "local "
+# transforms it into an assignment that sets the variable to the empty string.
+# That is too counter-intuitive, and can lead to subtle run-time malfunction.
+# The example below is less subtle in that with dash, it evokes the run-time
+# exception "dash: 1: local: 1: bad variable name".
+# We require a few additional shell features only when $EXEEXT is nonempty,
+# in order to support automatic $EXEEXT emulation:
+# - hyphen-containing alias names
+# - we prefer to use ${var#...} substitution, rather than having
+#   to work around lack of support for that feature.
+# The following code attempts to find a shell with support for these features.
+# If the current shell passes the test, we're done.  Otherwise, test other
+# shells until we find one that passes.  If one is found, re-exec it.
+# If no acceptable shell is found, skip the current test.
+#
+# The "...set -x; P=1 true 2>err..." test is to disqualify any shell that
+# emits "P=1" into err, as /bin/sh from SunOS 5.11 and OpenBSD 4.7 do.
+#
+# Use "9" to indicate success (rather than 0), in case some shell acts
+# like Solaris 10's /bin/sh but exits successfully instead of with status 2.
+
+# Eval this code in a subshell to determine a shell's suitability.
+# 10 - passes all tests; ok to use
+#  9 - ok, but enabling "set -x" corrupts app stderr; prefer higher score
+#  ? - not ok
+gl_shell_test_script_='
+test $(echo y) = y || exit 1
+LC_ALL=en_US.UTF-8 printf "\\351" 2>/dev/null \
+  | LC_ALL=C tr "\\351" x | LC_ALL=C grep "^x$" > /dev/null \
+  || exit 1
+printf "\\351" 2>/dev/null \
+  | LC_ALL=C tr "\\351" x | LC_ALL=C grep "^x$" > /dev/null \
+  || exit 1
+f_local_() { local v=1; }; f_local_ || exit 1
+f_dash_local_fail_() { local t=$(printf " 1"); }; f_dash_local_fail_
+score_=10
+if test "$VERBOSE" = yes; then
+  test -n "$( (exec 3>&1; set -x; P=1 true 2>&3) 2> /dev/null)" && score_=9
+fi
+test -z "$EXEEXT" && exit $score_
+shopt -s expand_aliases
+alias a-b="echo zoo"
+v=abx
+     test ${v%x} = ab \
+  && test ${v#a} = bx \
+  && test $(a-b) = zoo \
+  && exit $score_
+'
+
+if test "x$1" = "x--no-reexec"; then
+  shift
+else
+  # Assume a working shell.  Export to subshells (setup_ needs this).
+  gl_set_x_corrupts_stderr_=false
+  export gl_set_x_corrupts_stderr_
+
+  # Record the first marginally acceptable shell.
+  marginal_=
+
+  # Search for a shell that meets our requirements.
+  for re_shell_ in __current__ "${CONFIG_SHELL:-no_shell}" \
+      /bin/sh bash dash zsh pdksh fail
+  do
+    test "$re_shell_" = no_shell && continue
+
+    # If we've made it all the way to the sentinel, "fail" without
+    # finding even a marginal shell, skip this test.
+    if test "$re_shell_" = fail; then
+      test -z "$marginal_" && skip_ failed to find an adequate shell
+      re_shell_=$marginal_
+      break
+    fi
+
+    # When testing the current shell, simply "eval" the test code.
+    # Otherwise, run it via $re_shell_ -c ...
+    if test "$re_shell_" = __current__; then
+      # 'eval'ing this code makes Solaris 10's /bin/sh exit with
+      # $? set to 2.  It does not evaluate any of the code after the
+      # "unexpected" first '('.  Thus, we must run it in a subshell.
+      ( eval "$gl_shell_test_script_" ) > /dev/null 2>&1
+    else
+      "$re_shell_" -c "$gl_shell_test_script_" 2>/dev/null
+    fi
+
+    st_=$?
+
+    # $re_shell_ works just fine.  Use it.
+    if test $st_ = 10; then
+      gl_set_x_corrupts_stderr_=false
+      break
+    fi
+
+    # If this is our first marginally acceptable shell, remember it.
+    if test "$st_:$marginal_" = 9: ; then
+      marginal_="$re_shell_"
+      gl_set_x_corrupts_stderr_=true
+    fi
+  done
+
+  if test "$re_shell_" != __current__; then
+    # Found a usable shell.  Preserve -v and -x.
+    case $- in
+      *v*x* | *x*v*) opts_=-vx ;;
+      *v*) opts_=-v ;;
+      *x*) opts_=-x ;;
+      *) opts_= ;;
+    esac
+    re_shell=$re_shell_
+    export re_shell
+    exec "$re_shell_" $opts_ "$0" --no-reexec "$@"
+    echo "$ME_: exec failed" 1>&2
+    exit 127
+  fi
+fi
+
+# =============================================================================
+# Ensure the shell behaves reasonably.
+
+# If this is bash, turn off all aliases.
+test -n "$BASH_VERSION" && unalias -a
+
+# Note that when supporting $EXEEXT (transparently mapping from PROG_NAME to
+# PROG_NAME.exe), we want to support hyphen-containing names like test-acos.
+# That is part of the shell-selection test above.  Why use aliases rather
+# than functions?  Because support for hyphen-containing aliases is more
+# widespread than that for hyphen-containing function names.
+test -n "$EXEEXT" && test -n "$BASH_VERSION" && shopt -s expand_aliases
+
+# =============================================================================
+# Creating a temporary directory (needed by the core test framework)
+
+# Create a temporary directory, much like mktemp -d does.
+# Written by Jim Meyering.
+#
+# Usage: mktempd_ /tmp phoey.XXXXXXXXXX
+#
+# First, try to use the mktemp program.
+# Failing that, we'll roll our own mktemp-like function:
+#  - try to get random bytes from /dev/urandom, mapping them to file-name bytes
+#  - failing that, generate output from a combination of quickly-varying
+#      sources and awk.
+#  - try to create the desired directory.
+#  - make only $MAX_TRIES_ attempts
+
+# mkdir on msys2 does not support the '-m' option.
+case `(uname -o) 2>/dev/null` in
+  Msys)
+    mkdir ()
+    {
+      if test " $1" = " -m"; then
+        shift; shift
+      fi
+      /bin/mkdir "$@"
+    }
+    ;;
+esac
+
+# Helper function.  Print $N pseudo-random bytes from a-zA-Z0-9.
+rand_bytes_ ()
+{
+  n_=$1
+
+  # Maybe try openssl rand -base64 $n_prime_|tr '+/=\012' abcd first?
+  # But if they have openssl, they probably have mktemp, too.
+
+  chars_=abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789
+  dev_rand_=/dev/urandom
+  if test -r "$dev_rand_"; then
+    # Note: 256-length($chars_) == 194; 3 copies of $chars_ is 186 + 8 = 194.
+    dd ibs=$n_ count=1 if=$dev_rand_ 2>/dev/null \
+      | LC_ALL=C tr -c $chars_ 01234567$chars_$chars_$chars_
+    return
+  fi
+
+  # Fall back on quickly-varying sources + awk.
+  # Limit awk program to 7th Edition Unix so that it works even on Solaris 10.
+
+  (date; date +%N; free; who -a; w; ps auxww; ps -ef) 2>&1 | awk '
+     BEGIN {
+       n = '"$n_"'
+       for (i = 0; i < 256; i++)
+         ordinal[sprintf ("%c", i)] = i
+     }
+     {
+       for (i = 1; i <= length; i++)
+         a[ai++ % n] += ordinal[substr ($0, i, 1)]
+     }
+     END {
+       chars = "'"$chars_"'"
+       charslen = length (chars)
+       for (i = 0; i < n; i++)
+         printf "%s", substr (chars, a[i] % charslen + 1, 1)
+       printf "\n"
+     }
+  '
+}
+
+mktempd_ ()
+{
+  case $# in
+  2);;
+  *) fail_ "Usage: mktempd_ DIR TEMPLATE";;
+  esac
+
+  destdir_=$1
+  template_=$2
+
+  MAX_TRIES_=4
+
+  # Disallow any trailing slash on specified destdir:
+  # it would subvert the post-mktemp "case"-based destdir test.
+  case $destdir_ in
+  / | //) destdir_slash_=$destdir;;
+  */) fail_ "invalid destination dir: remove trailing slash(es)";;
+  *) destdir_slash_=$destdir_/;;
+  esac
+
+  case $template_ in
+  -*) fail_ \
+       "invalid template: $template_ (must not begin with '-')";;
+  *XXXX) ;;
+  *) fail_ \
+       "invalid template: $template_ (must have a suffix of at least 4 X's)";;
+  esac
+
+  # First, try GNU mktemp, where -t has no option-argument.
+  # Put -t last, as GNU mktemp allows, so that the incompatible NetBSD mktemp
+  # (where -t has an option-argument) fails instead of creating a junk dir.
+  d=`unset TMPDIR; { mktemp -d -p "$destdir_" "$template_" -t; } 2>/dev/null` &&
+
+  # The resulting name must be in the specified directory.
+  case $d in "$destdir_slash_"*) :;; *) false;; esac &&
+
+  # It must have created the directory.
+  test -d "$d" &&
+
+  # It must have 0700 permissions.  Handle sticky "S" bits.
+  perms=`ls -dgo "$d" 2>/dev/null` &&
+  case $perms in drwx--[-S]---*) :;; *) false;; esac && {
+    echo "$d"
+    return
+  }
+
+  # If we reach this point, we'll have to create a directory manually.
+
+  # Get a copy of the template without its suffix of X's.
+  base_template_=`echo "$template_"|sed 's/XX*$//'`
+
+  # Calculate how many X's we've just removed.
+  template_length_=`echo "$template_" | wc -c`
+  nx_=`echo "$base_template_" | wc -c`
+  nx_=`expr $template_length_ - $nx_`
+
+  err_=
+  i_=1
+  while :; do
+    X_=`rand_bytes_ $nx_`
+    candidate_dir_="$destdir_slash_$base_template_$X_"
+    err_=`mkdir -m 0700 "$candidate_dir_" 2>&1` \
+      && { echo "$candidate_dir_"; return; }
+    test $MAX_TRIES_ -le $i_ && break;
+    i_=`expr $i_ + 1`
+  done
+  fail_ "$err_"
+}
+
+# =============================================================================
+# Core test framework
+
+# An arbitrary prefix to help distinguish test directories.
+testdir_prefix_ () { printf gt; }
+
+# Set up the environment for the test to run in.
+setup_ ()
+{
+  if test "$VERBOSE" = yes; then
+    # Test whether set -x may cause the selected shell to corrupt an
+    # application's stderr.  Many do, including zsh-4.3.10 and the /bin/sh
+    # from SunOS 5.11, OpenBSD 4.7 and Irix 6.5.
+    # If enabling verbose output this way would cause trouble, simply
+    # issue a warning and refrain.
+    if $gl_set_x_corrupts_stderr_; then
+      warn_ "using SHELL=$SHELL with 'set -x' corrupts stderr"
+    else
+      set -x
+    fi
+  fi
+
+  initial_cwd_=$PWD
+
+  # Create and enter the temporary directory.
+  pfx_=`testdir_prefix_`
+  test_dir_=`mktempd_ "$initial_cwd_" "$pfx_-$ME_.XXXX"` \
+    || fail_ "failed to create temporary directory in $initial_cwd_"
+  cd "$test_dir_" || fail_ "failed to cd to temporary directory"
+  # Set variables srcdir, builddir, for the convenience of the test.
+  case $srcdir in
+    /* | ?:*) ;;
+    *) srcdir="../$srcdir" ;;
+  esac
+  builddir=".."
+  export srcdir builddir
+
+  # As autoconf-generated configure scripts do, ensure that IFS
+  # is defined initially, so that saving and restoring $IFS works.
+  gl_init_sh_nl_='
+'
+  IFS=" ""	$gl_init_sh_nl_"
+
+  # This trap statement, along with a trap on 0 below, ensure that the
+  # temporary directory, $test_dir_, is removed upon exit as well as
+  # upon receipt of any of the listed signals.
+  for sig_ in 1 2 3 13 15; do
+    eval "trap 'Exit $(expr $sig_ + 128)' $sig_"
+  done
+
+  # Remove relative and non-accessible directories from PATH, including '.'
+  # and Zero-length entries.
+  saved_IFS="$IFS"; IFS="$PATH_SEPARATOR"
+  new_PATH=
+  for dir in $PATH; do
+    IFS="$saved_IFS"
+    case "$dir" in
+      [\\/]* | ?:[\\/]*)
+        test -d "$dir/." || continue
+        new_PATH="${new_PATH}${new_PATH:+$PATH_SEPARATOR}${dir}"
+        ;;
+    esac
+  done
+  IFS="$saved_IFS"
+  PATH="$new_PATH"
+  export PATH
+}
+
+# This is a stub function that is run upon trap (upon regular exit and
+# interrupt).  Override it with a per-test function, e.g., to unmount
+# a partition, or to undo any other global state changes.
+cleanup_ () { :; }
+
+# Run the user-overridable cleanup_ function, remove the temporary
+# directory and exit with the incoming value of $?.
+remove_tmp_ ()
+{
+  __st=$?
+  cleanup_
+  if test "$KEEP" = yes; then
+    echo "Not removing temporary directory $test_dir_"
+  else
+    # cd out of the directory we're about to remove
+    cd "$initial_cwd_" || cd / || cd /tmp
+    chmod -R u+rwx "$test_dir_"
+    # If removal fails and exit status was to be 0, then change it to 1.
+    rm -rf "$test_dir_" || { test $__st = 0 && __st=1; }
+  fi
+  exit $__st
+}
+
+# =============================================================================
+# Prepending directories to PATH
+
+# Given a directory name, DIR, if every entry in it that matches *.exe
+# contains only the specified bytes (see the case stmt below), then print
+# a space-separated list of those names and return 0.  Otherwise, don't
+# print anything and return 1.  Naming constraints apply also to DIR.
+find_exe_basenames_ ()
+{
+  feb_dir_=$1
+  feb_fail_=0
+  feb_result_=
+  feb_sp_=
+  for feb_file_ in $feb_dir_/*.exe; do
+    # If there was no *.exe file, or there existed a file named "*.exe" that
+    # was deleted between the above glob expansion and the existence test
+    # below, just skip it.
+    test "x$feb_file_" = "x$feb_dir_/*.exe" && test ! -f "$feb_file_" \
+      && continue
+    # Exempt [.exe, since we can't create a function by that name, yet
+    # we can't invoke [ by PATH search anyways due to shell builtins.
+    test "x$feb_file_" = "x$feb_dir_/[.exe" && continue
+    case $feb_file_ in
+      *[!-a-zA-Z/0-9_.+]*) feb_fail_=1; break;;
+      *) # Remove leading file name components as well as the .exe suffix.
+         feb_file_=${feb_file_##*/}
+         feb_file_=${feb_file_%.exe}
+         feb_result_="$feb_result_$feb_sp_$feb_file_";;
+    esac
+    feb_sp_=' '
+  done
+  test $feb_fail_ = 0 && printf %s "$feb_result_"
+  return $feb_fail_
+}
+
+# Consider the files in directory, $1.
+# For each file name of the form PROG.exe, create an alias named
+# PROG that simply invokes PROG.exe, then return 0.  If any selected
+# file name or the directory name, $1, contains an unexpected character,
+# define no alias and return 1.
+create_exe_shims_ ()
+{
+  case $EXEEXT in
+    '') return 0 ;;
+    .exe) ;;
+    *) echo "$0: unexpected \$EXEEXT value: $EXEEXT" 1>&2; return 1 ;;
+  esac
+
+  base_names_=`find_exe_basenames_ $1` \
+    || { echo "$0 (exe_shim): skipping directory: $1" 1>&2; return 0; }
+
+  if test -n "$base_names_"; then
+    for base_ in $base_names_; do
+      alias "$base_"="$base_$EXEEXT"
+    done
+  fi
+
+  return 0
+}
+
+# Use this function to prepend to PATH an absolute name for each
+# specified, possibly-$initial_cwd_-relative, directory.
+path_prepend_ ()
+{
+  while test $# != 0; do
+    path_dir_=$1
+    case $path_dir_ in
+      '') fail_ "invalid path dir: '$1'";;
+      /* | ?:*) abs_path_dir_=$path_dir_;;
+      *) abs_path_dir_=$initial_cwd_/$path_dir_;;
+    esac
+    case $abs_path_dir_ in
+      *$PATH_SEPARATOR*) fail_ "invalid path dir: '$abs_path_dir_'";;
+    esac
+    PATH="$abs_path_dir_$PATH_SEPARATOR$PATH"
+
+    # Create an alias, FOO, for each FOO.exe in this directory.
+    create_exe_shims_ "$abs_path_dir_" \
+      || fail_ "something failed (above): $abs_path_dir_"
+    shift
+  done
+  export PATH
+}
+
+# =============================================================================
+# Convenience environment variables for the tests
+
+# -----------------------------------------------------------------------------
+
+# Enable glibc's malloc-perturbing option.
+# This is useful for exposing code that depends on the fact that
+# malloc-related functions often return memory that is mostly zeroed.
+# If you have the time and cycles, use valgrind to do an even better job.
+: ${MALLOC_PERTURB_=87}
+export MALLOC_PERTURB_
+
+# -----------------------------------------------------------------------------
+
+# The interpreter for Bourne-shell scripts.
+# No special standards compatibility requirements.
+# Some environments, such as Android, don't have /bin/sh.
+if test -f /bin/sh$EXEEXT; then
+  BOURNE_SHELL=/bin/sh
+else
+  BOURNE_SHELL=sh
+fi
+
+# =============================================================================
+# Convenience functions for the tests
+
+# -----------------------------------------------------------------------------
+# Return value checking
+
+# This is used to simplify checking of the return value
+# which is useful when ensuring a command fails as desired.
+# I.e., just doing `command ... &&fail=1` will not catch
+# a segfault in command for example.  With this helper you
+# instead check an explicit exit code like
+#   returns_ 1 command ... || fail=1
+returns_ () {
+  # Disable tracing so it doesn't interfere with stderr of the wrapped command
+  { local is_tracing=`{ :; } 2>&1`; } 2>/dev/null
+  { set +x; } 2>/dev/null
+
+  local exp_exit="$1"
+  shift
+  "$@"
+  test $? -eq $exp_exit && ret_=0 || ret_=1
+
+  # Restore tracing if it was enabled.
+  if test -n "$is_tracing"; then
+    set -x
+  fi
+  { return $ret_; } 2>/dev/null
+}
+
+# -----------------------------------------------------------------------------
+# Text file comparison
+
+# Emit a header similar to that from diff -u;  Print the simulated "diff"
+# command so that the order of arguments is clear.  Don't bother with @@ lines.
+emit_diff_u_header_ ()
+{
+  printf '%s\n' "diff -u $*" \
+    "--- $1	1970-01-01" \
+    "+++ $2	1970-01-01"
+}
+
+# Arrange not to let diff or cmp operate on /dev/null,
+# since on some systems (at least OSF/1 5.1), that doesn't work.
+# When there are not two arguments, or no argument is /dev/null, return 2.
+# When one argument is /dev/null and the other is not empty,
+# cat the nonempty file to stderr and return 1.
+# Otherwise, return 0.
+compare_dev_null_ ()
+{
+  test $# = 2 || return 2
+
+  if test "x$1" = x/dev/null; then
+    test -s "$2" || return 0
+    emit_diff_u_header_ "$@"; sed 's/^/+/' "$2"
+    return 1
+  fi
+
+  if test "x$2" = x/dev/null; then
+    test -s "$1" || return 0
+    emit_diff_u_header_ "$@"; sed 's/^/-/' "$1"
+    return 1
+  fi
+
+  return 2
+}
+
+for diff_opt_ in -u -U3 -c '' no; do
+  test "$diff_opt_" != no &&
+    diff_out_=`exec 2>/dev/null
+      LC_ALL=C diff $diff_opt_ "$0" "$0" < /dev/null` &&
+    break
+done
+if test "$diff_opt_" != no; then
+  if test -z "$diff_out_"; then
+    # diff on msys2 does not support the '-' argument for denoting stdin.
+    case `(uname -o) 2>/dev/null` in
+      Msys)
+        compare_ ()
+        {
+          if test " $1" = " -"; then
+            cat > '(stdin)'
+            LC_ALL=C diff $diff_opt_ '(stdin)' "$2"
+          elif test " $2" = " -"; then
+            cat > '(stdin)'
+            LC_ALL=C diff $diff_opt_ "$1" '(stdin)'
+          else
+            LC_ALL=C diff $diff_opt_ "$@"
+          fi
+        }
+        ;;
+      *)
+        compare_ ()
+        {
+          LC_ALL=C diff $diff_opt_ "$@"
+        }
+    esac
+  else
+    compare_ ()
+    {
+      # If no differences were found, AIX and HP-UX 'diff' produce output
+      # like "No differences encountered".  Hide this output.
+      LC_ALL=C diff $diff_opt_ "$@" > diff.out
+      diff_status_=$?
+      test $diff_status_ -eq 0 || cat diff.out || diff_status_=2
+      rm -f diff.out || diff_status_=2
+      return $diff_status_
+    }
+  fi
+elif cmp -s /dev/null /dev/null 2>/dev/null; then
+  compare_ () { cmp -s "$@"; }
+else
+  compare_ () { cmp "$@"; }
+fi
+
+# Usage: compare EXPECTED ACTUAL
+#
+# Given compare_dev_null_'s preprocessing, defer to compare_ if 2 or more.
+# Otherwise, propagate $? to caller: any diffs have already been printed.
+compare ()
+{
+  # This looks like it can be factored to use a simple "case $?"
+  # after unchecked compare_dev_null_ invocation, but that would
+  # fail in a "set -e" environment.
+  if compare_dev_null_ "$@"; then
+    return 0
+  else
+    case $? in
+      1) return 1;;
+      *) compare_ "$@";;
+    esac
+  fi
+}
+
+# -----------------------------------------------------------------------------
+
+# If you want to override the testdir_prefix_ function,
+# or to add more utility functions, use this file.
+test -f "$srcdir/init.cfg" \
+  && . "$srcdir/init.cfg"
+
+# =============================================================================
+# Set up the environment for the test to run in.
+
+setup_ "$@"
+# This trap is here, rather than in the setup_ function, because some
+# shells run the exit trap at shell function exit, rather than script exit.
+trap remove_tmp_ EXIT
diff --git a/lib/test/parse-string-literal.c b/lib/test/parse-string-literal.c
new file mode 100644
index 00000000000..4604a28df1e
--- /dev/null
+++ b/lib/test/parse-string-literal.c
@@ -0,0 +1,114 @@
+/* Test driver for library function parse_string_literal
+
+Copyright (C) 2018-2025 Free Software Foundation, Inc.
+
+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/>.  */
+
+
+/* The argument given to this program is the initial version of the
+ temacs executable file used when building GNU Emacs.  This program computes
+ a digest fingerprint for the executable, and modifies the binary in
+ place, replacing all instances of the existing fingerprint (normally
+ the default fingerprint from libgnu's lib/fingerprint.c) with the
+ new value.  With option -r, it just prints the digest.   */
+
+#include <config.h>
+
+#include <limits.h>
+#include <stdarg.h>
+#include <stdint.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+
+#include <sysstdio.h>
+
+#include <fingerprint.h>
+#include <getopt.h>
+
+enum {
+  max_size = 64,
+  buffer_size = max_size + 16
+};
+static unsigned char buffer[buffer_size] = { 0 };
+
+
+int
+main (int argc, char **argv)
+{
+  char c;
+  bool zeroed = true;
+  bool sentinel = false;
+  bool nullterm = false;
+  unsigned int sz = (unsigned int) max_size;
+  unsigned char *data = NULL;
+  char *end;
+  
+  while (0 <= (c = getopt (argc, argv, "nbgs:")))
+    {
+      switch (c)
+        {
+	case 'b':  /* beef */
+	  zeroed = false;
+	  break;
+	case 'g':  /* guard */
+	  sentinel = true;
+	  break;
+	case 'n':  /* null terminate */
+	  nullterm = true;
+	  break;
+        case 's':  /* size */
+	  sz = strtoul (optarg, &end, 10);
+	  if ( end == optarg || *end )
+	    {
+	      fprintf (stderr,
+		       "size argument must be an "
+		       "unsigned integer,given '%s'\n",
+		       optarg);
+	      return EXIT_FAILURE;
+	    }
+	  if ( sz > max_size )
+	    {
+	      fprintf (stderr, "size argument must less than %d, given %u\n",
+		       max_size,sz);
+	      return EXIT_FAILURE;
+	    }
+          break;
+        default:
+          return EXIT_FAILURE;
+        }
+    }
+  if (optind >= argc)
+    {
+      fprintf (stderr, "No string literal specified!\n");
+      return EXIT_FAILURE;
+    }
+  data = (unsigned char *) argv[optind];
+
+  if (!zeroed || sentinel)
+    {
+      /* Fill the buffer with a distinctive pattern */
+      uint32_t *tmp = (uint32_t *) buffer;
+      uint64_t N = buffer_size / 4;
+      for (int i = sentinel ? (sz / 4) : 0; i < N; i++)
+	tmp[i] = 0xdeadbeef;
+    }
+  ptrdiff_t pos = 0;
+  PSLERR code = parse_string_literal (data, buffer, (int) sz, nullterm, &pos);
+  fwrite (buffer, 1, sz, stdout);
+  fwrite (buffer, 1, buffer_size, stderr);  
+  exit (code);
+}
-- 
2.49.0

From 191403a627590cf4b9ef4ee241b2a3a91715f4fd Mon Sep 17 00:00:00 2001
From: Onnie Lynn Winebarger <[email-masked]>
Date: Mon, 7 Jul 2025 06:53:04 -0400
Subject: [PATCH 07/12] Add support for stdin stream (noneditor mode)

---
 src/lread.c | 71 ++++++++++++++++++++++++++++++++++++++++++++---------
 1 file changed, 59 insertions(+), 12 deletions(-)

diff --git a/src/lread.c b/src/lread.c
index 4a4b82f0f41..5453279a4af 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -370,6 +370,8 @@ #define INIT_READ_STACK {NULL, 0, 0}
   bool read_eof;
   bool multibyte;
   Lisp_Object coding;
+  Lisp_Object full_name;
+  Lisp_Object name;
 } stdin_infile;

@@ -1484,6 +1486,39 @@ DEFUN ("reader-input-stream",
   return (make_fixnum (c));
 }
 
+DEFUN ("external-standard-input",
+       Fexternal_standard_input, Sexternal_standard_input, 0, 1, 0,
+       doc: /* Read CHARACTER from stdin.
+For use with `read' in noneditor mode */)
+  (Lisp_Object character)
+{
+  int c;
+  if (NILP (character))
+    c = -1;
+  else if (CHARACTERP (character))
+    c = XFIXNUM (character);
+  else
+    xsignal1 (Qerror,
+	      CALLN (Fformat,
+		     build_string ("external-standard-input: "
+				   "argument not a character: '%s'"),
+		     character));
+
+  specpdl_ref count = SPECPDL_INDEX ();
+  lread_frame this_frame = INIT_LREAD_FRAME ();
+  this_frame.loop_dynamic_frame = SPECPDL_INDEX ();
+  init_lread_input_from_stream (&this_frame,
+				Qstdin, Qnil, Qnil,
+				false, false, NULL, Qnil);
+  activate_lread_frame (&this_frame, LREAD_FRAME_SINGLE);
+  lread_init_dynamic_frame (&this_frame);
+  if (c >= 0)
+    UNREAD (&this_frame, c);
+  else
+    c = readbyte_from_file (&this_frame);
+  return unbind_to (count, make_fixnum (c));
+}
+
 static void
 skip_dyn_bytes (register lread_frame *frame, ptrdiff_t n)
 {
@@ -4191,17 +4226,6 @@ init_lread_input_from_stream (lread_frame *frame,
   frame->locate_syms = locate_syms;
   if (BUFFERP (stream))
     {
-#if 0
-      if (current_frame)
-	{
-	  lread_frame *source = current_frame;
-	  if (source->intype == LREAD_INPUT_INDIRECT)
-	    source = source->input.frame.source;
-	  if (source->intype == LREAD_INPUT_BUFFER
-	      && EQ (source->input.b.buffer, stream))
-	    goto indirect_frame;
-	}
-#endif
       frame->intype = LREAD_INPUT_BUFFER;
       init_inbuffer (frame,stream);
     }
@@ -4227,9 +4251,23 @@ init_lread_input_from_stream (lread_frame *frame,
 	  frame->multibyte = LREAD_MULTIBYTE_TRUE;
 	}
     }
+  else if (EQ (stream, Qexternal_standard_input) || EQ (stream, Qstdin))
+    {
+      frame->intype = LREAD_INPUT_FILE;
+      init_infile (frame, stdin_infile.s.stream,
+		   stdin_infile.s.seekable, stdin_infile.s.mule,
+		   stdin_infile.s.coding);
+      frame->char_offset = stdin_infile.char_offset;
+      frame->byte_offset = stdin_infile.byte_offset;
+      frame->unread_char = stdin_infile.unread_char;
+      frame->unread_bytes = stdin_infile.unread_bytes;
+      frame->read_eof = stdin_infile.read_eof;
+      frame->multibyte = stdin_infile.multibyte;
+      frame->full_name = stdin_infile.full_name;
+      frame->name = stdin_infile.name;
+    }
   else if (EQ (stream, Qreader_input_stream))
     {
-    indirect_frame:
       frame->intype = LREAD_INPUT_INDIRECT;
       lread_frame *source = current_frame;
       while (source && source->intype == LREAD_INPUT_INDIRECT)
@@ -7291,6 +7329,9 @@ init_lread (void)
   stdin_infile.unread_char = -1;
   stdin_infile.unread_bytes = 0;
   stdin_infile.read_eof = false;
+  stdin_infile.name = Fsymbol_name (Qstdin);
+  stdin_infile.full_name = stdin_infile.name;
+
 }
 
 /* Print a warning that directory intended for use USE and with name
@@ -7818,6 +7859,12 @@ syms_of_lread (void)
   DEFSYM (Qget_file_char, "get-file-char");
   DEFSYM (Qreader_input_stream, "reader-input-stream");
   defsubr (&Sreader_input_stream);
+  DEFSYM (Qstdin, "stdin");
+  DEFSYM (Qexternal_standard_input, "external-standard-input");
+  defsubr (&Sexternal_standard_input);
+  staticpro (&stdin_infile.coding);
+  staticpro (&stdin_infile.name);
+  staticpro (&stdin_infile.full_name);
   /* Used instead of Qget_file_char while loading *.elc files compiled
      by Emacs 21 or older.  */
   DEFSYM (Qget_emacs_mule_file_char, "get-emacs-mule-file-char");
-- 
2.49.0

From e1442b07d99971923afd176bde7dad3e9db1f078 Mon Sep 17 00:00:00 2001
From: Onnie Lynn Winebarger <[email-masked]>
Date: Sun, 6 Jul 2025 16:59:33 -0400
Subject: [PATCH 05/12] Support for noneditor mode and hard-coded executable
 options.

---
 src/emacs.c | 1123 ++++++++++++++++++++++++++++++++++++++++++++++++---
 1 file changed, 1076 insertions(+), 47 deletions(-)

diff --git a/src/emacs.c b/src/emacs.c
index cf8f4bd63f7..7c38ec0bbc5 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -160,6 +160,15 @@ #define MAIN_PROGRAM
 static const char emacs_copyright[] = COPYRIGHT;
 static const char emacs_bugreport[] = PACKAGE_BUGREPORT;
 
+/* these can be assigned to temacs */
+static struct temacs_eval_opts
+{
+  char none[16];
+  char args[16];
+  char stdin[16];
+  char both[16];
+} temacs_eval_opts = { "eval-none", "eval-args", "eval-stdin", "eval" };
+
 /* Put version info into the executable in the form that 'ident' uses.  */
 extern char const RCS_Id[];
 char const EXTERNALLY_VISIBLE RCS_Id[]
@@ -181,6 +190,12 @@ #define MAIN_PROGRAM
 struct gflags gflags;
 bool initialized;
 
+enum noneditor_eval_source noneditor_eval_source;
+
+
+union exe_config_store *exe_config =
+  (union exe_config_store *) fingerprint_storage.data;
+
 /* If true, Emacs should not attempt to use a window-specific code,
    but instead should use the virtual terminal under which it was started.  */
 bool inhibit_window_system;
@@ -220,9 +235,16 @@ #define MAIN_PROGRAM
 /* True means remove site-lisp directories from load-path.  */
 bool no_site_lisp;
 
+/* True means do not load "loadup.el" */
+static bool no_loadup;
+
 /* True means put details like time stamps into builds.  */
 bool build_details;
 
+#ifdef HAVE_PDUMPER
+static bool attempt_load_pdump;
+#endif
+
 /* Name for the server started by the daemon.*/
 static char *daemon_name;
 
@@ -265,7 +287,9 @@ #define MAIN_PROGRAM
 static void copy_args (int argc, char **argv);
 #endif
 static void sort_args (int argc, char **argv);
+static void make_noneditor_args (int argc, char **argv,int *nargs);
 static void syms_of_emacs (void);
+static void init_noneditor_eval_for_pdumper (void);
 
 /* C99 needs each string to be at most 4095 characters, and the usage
    strings below are split to not overflow this limit.  */
@@ -881,14 +905,17 @@ load_pdump (int argc, char **argv, char *dump_file)
 #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY
   int skip_args = 0, result;
 
-  while (skip_args < argc - 1)
+  if (!NILP(Vnoneditor))
     {
-      if (argmatch (argv, argc, "-dump-file", "--dump-file",
-		    6, &dump_file, &skip_args)
-	  || argmatch (argv, argc, "--", NULL, 2, NULL,
-		       &skip_args))
-	break;
-      skip_args++;
+      while (skip_args < argc - 1)
+	{
+	  if (argmatch (argv, argc, "-dump-file", "--dump-file",
+			6, &dump_file, &skip_args)
+	      || argmatch (argv, argc, "--", NULL, 2, NULL,
+			   &skip_args))
+	    break;
+	  skip_args++;
+	}
     }
 
   if (!dump_file)
@@ -919,6 +946,8 @@ load_pdump (int argc, char **argv, char *dump_file)
 #endif
     ;
   const char *argv0_base =
+    (exe_config != NULL && *(exe_config->s.argv0_base)) ?
+    exe_config->s.argv0_base :
 #ifdef NS_SELF_CONTAINED
     "Emacs"
 #else
@@ -930,15 +959,17 @@ load_pdump (int argc, char **argv, char *dump_file)
   const char *path_exec = PATH_EXEC;
   dump_file = NULL;
   int skip_args = 0;
-  while (skip_args < argc - 1)
+  if (NILP(Vnoneditor))
     {
-      if (argmatch (argv, argc, "-dump-file", "--dump-file", 6,
-		    &dump_file, &skip_args)
-	  || argmatch (argv, argc, "--", NULL, 2, NULL, &skip_args))
-	break;
-      skip_args++;
+      while (skip_args < argc - 1)
+	{
+	  if (argmatch (argv, argc, "-dump-file", "--dump-file", 6,
+			&dump_file, &skip_args)
+	      || argmatch (argv, argc, "--", NULL, 2, NULL, &skip_args))
+	    break;
+	  skip_args++;
+	}
     }
-
   /* Where's our executable?  */
   ptrdiff_t exec_bufsize, bufsize, needed;
   emacs_executable = find_emacs_executable (argv[0], &exec_bufsize);
@@ -1003,9 +1034,12 @@ load_pdump (int argc, char **argv, char *dump_file)
   /* Look for "emacs-FINGERPRINT.pdmp" in PATH_EXEC.  We hardcode
      "emacs" in "emacs-FINGERPRINT.pdmp" so that the Emacs binary
      still works if the user copies and renames it.  */
-  hexbuf_size = 2 * sizeof fingerprint;
+  /* "emacs" may be overridden by writing an alternate base name
+     into the exe_config when setting the fingerprint.  */
+  hexbuf_size = 2 * sizeof fingerprint_storage.hash;
   hexbuf = xmalloc (hexbuf_size + 1);
-  hexbuf_digest (hexbuf, (char *) fingerprint, sizeof fingerprint);
+  hexbuf_digest (hexbuf, (char *) fingerprint_storage.hash,
+		 sizeof fingerprint_storage.hash);
   hexbuf[hexbuf_size] = '\0';
   needed = (strlen (path_exec)
 	    + 1
@@ -1268,6 +1302,7 @@ maybe_load_seccomp (int argc, char **argv)
 }
 
 #endif  /* SECCOMP_USABLE */
+static char *temacs = NULL;
 
 #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
 int
@@ -1295,7 +1330,6 @@ android_emacs_init (int argc, char **argv, char *dump_file)
   maybe_load_seccomp (argc, argv);
 #endif
 
-  bool no_loadup = false;
   char *junk = 0;
   char *dname_arg = 0;
 #ifdef DAEMON_MUST_EXEC
@@ -1309,23 +1343,39 @@ android_emacs_init (int argc, char **argv, char *dump_file)
   /* Record (approximately) where the stack begins.  */
   stack_bottom = (char *) &stack_bottom_variable;
 
+  /* Initialize noneditor very early */
+  Vnoneditor = Qnil;
+
   const char *dump_mode = NULL;
   int skip_args = 0;
-  char *temacs = NULL;
-  while (skip_args < argc - 1)
+
+  /* Hard coded noneditor means no command line arguments
+     are processed as options */
+  if (EXE_CONFIGURED_NONEDITOR(exe_config))
     {
-      if (argmatch (argv, argc, "-temacs", "--temacs", 8, &temacs, &skip_args)
-	  || argmatch (argv, argc, "--", NULL, 2, NULL, &skip_args))
-	break;
-      skip_args++;
-    }
 #ifdef HAVE_PDUMPER
-  bool attempt_load_pdump = false;
+      pdumper_do_now_and_after_load (init_noneditor_eval_for_pdumper);
+#else
+      init_noneditor_eval_for_pdumper();
 #endif
+    }
+
+  /* Hard-coded "bare" and !noneditor means checking for  --temacs option */
+  if (NILP (Vnoneditor))
+    {
+      while (skip_args < argc - 1)
+	{
+	  if (argmatch (argv, argc, "-temacs", "--temacs", 8,
+			&temacs, &skip_args)
+	      || argmatch (argv, argc, "--", NULL, 2, NULL, &skip_args))
+	    break;
+	  skip_args++;
+	}
+    }
 
   /* Look for this argument first, before any heap allocation, so we
      can set heap flags properly if we're going to dump.  */
-  if (!initialized && temacs)
+  if (!initialized && temacs && NILP (Vnoneditor))
     {
 #ifdef HAVE_PDUMPER
       if (!strcmp (temacs, "pdump") || !strcmp (temacs, "pbootstrap"))
@@ -1336,10 +1386,28 @@ android_emacs_init (int argc, char **argv, char *dump_file)
       if (will_dump_p ())
         dump_mode = temacs;
 #endif
-      if (!dump_mode)
+      /* This option is for evaluating exrpessions in a bare environment,
+	 possibly to dump a noneditor environment */
+      if (!strncmp (temacs, "eval",4))
+	{
+	  /* eval options disable recognition of any other command line options */
+	  /* We require it to be the first command line argument and only option */
+	  int temacs_skip = 0;
+	  char *temacs_value = NULL;
+	  if (!argmatch (argv, argc, "-temacs", "--temacs", 8, &temacs_value, &temacs_skip))
+	    fatal ("temacs eval option is not the first command line argument");
+	  if (strcmp (temacs_value, temacs))
+	    fatal ("Multiple temacs options specified.");
+#ifdef HAVE_PDUMPER
+	  pdumper_do_now_and_after_load (init_noneditor_eval_for_pdumper);
+#else
+	  init_noneditor_eval_for_pdumper();
+#endif
+	}
+      else if (!dump_mode)
         fatal ("Invalid temacs mode '%s'", temacs);
     }
-  else
+  else if (NILP(Vnoneditor))
     {
       eassert (!temacs);
       eassert (!initialized);
@@ -1383,6 +1451,7 @@ android_emacs_init (int argc, char **argv, char *dump_file)
   ns_init_pool ();
 #endif
 
+  ptrdiff_t bufsize;
 #ifdef HAVE_PDUMPER
   if (attempt_load_pdump)
     {
@@ -1397,10 +1466,9 @@ android_emacs_init (int argc, char **argv, char *dump_file)
 	w32_init_file_name_codepage ();
 #endif
     }
-#else
-  ptrdiff_t bufsize;
-  initial_emacs_executable = find_emacs_executable (argv[0], &bufsize);
+  else  /* still want to know the executable */
 #endif
+    initial_emacs_executable = find_emacs_executable (argv[0], &bufsize);
 
   argc = maybe_disable_address_randomization (argc, argv);
 
@@ -1451,6 +1519,18 @@ android_emacs_init (int argc, char **argv, char *dump_file)
      should be explicitly recognized, ignored, and removed from
      'command-line-args-left' in 'command-line-1'.  */
 
+  emacs_wd = emacs_get_current_dir_name ();
+#ifdef WINDOWSNT
+  initial_wd = emacs_wd;
+#endif /* WINDOWSNT */
+#ifdef HAVE_PDUMPER
+  if (dumped_with_pdumper_p ())
+    pdumper_record_wd (emacs_wd);
+#endif
+  if (!NILP(Vnoneditor))
+    /* No command arguments are allowed to be processed */
+    goto after_initial_arg_processing;
+
   bool only_version = false;
   sort_args (argc, argv);
   old_argc = argc, argc = 0;
@@ -1469,7 +1549,7 @@ android_emacs_init (int argc, char **argv, char *dump_file)
       if (initialized)
         {
           dump_fingerprint (stdout, "",
-			    (unsigned char *) fingerprint);
+			    (unsigned char *) fingerprint_storage.hash);
           exit (0);
         }
       else
@@ -1479,14 +1559,6 @@ android_emacs_init (int argc, char **argv, char *dump_file)
         }
     }
 #endif
-  emacs_wd = emacs_get_current_dir_name ();
-#ifdef WINDOWSNT
-  initial_wd = emacs_wd;
-#endif /* WINDOWSNT */
-#ifdef HAVE_PDUMPER
-  if (dumped_with_pdumper_p ())
-    pdumper_record_wd (emacs_wd);
-#endif
 
   if (argmatch (argv, argc, "-chdir", "--chdir", 4, &ch_to_dir, &skip_args)
       && !only_version)
@@ -1513,6 +1585,7 @@ android_emacs_init (int argc, char **argv, char *dump_file)
       emacs_wd = emacs_get_current_dir_name ();
     }
 
+ after_initial_arg_processing:
 #if defined (HAVE_SETRLIMIT) && defined (RLIMIT_STACK) && !defined (CYGWIN)
   /* Extend the stack space available.  Don't do that if dumping,
      since some systems (e.g. DJGPP) might define a smaller stack
@@ -1612,6 +1685,10 @@ android_emacs_init (int argc, char **argv, char *dump_file)
 
   /* Handle the -t switch, which specifies filename to use as terminal.  */
   dev_tty = xstrdup (DEV_TTY);	/* the default terminal */
+
+  if (!NILP (Vnoneditor))
+    goto after_term_opt_processing;
+
   while (!only_version)
     {
       char *term;
@@ -1671,7 +1748,7 @@ android_emacs_init (int argc, char **argv, char *dump_file)
 
   /* Handle the --help option, which gives a usage message.  */
   if (argmatch (argv, argc, "-help", "--help", 3, NULL, &skip_args)
-      && !only_version)
+      && !only_version && !noneditor_eval_source)
     {
       int i;
       printf ("Usage: %s [OPTION-OR-FILENAME]...\n", argv[0]);
@@ -1892,6 +1969,8 @@ android_emacs_init (int argc, char **argv, char *dump_file)
 	daemon_name = xstrdup (dname_arg);
     }
 
+ after_term_opt_processing:
+
 #if defined HAVE_PTHREAD && !defined SYSTEM_MALLOC \
   && !defined DOUG_LEA_MALLOC
   /* Do not make gmalloc thread-safe when creating bootstrap-emacs, as
@@ -1981,6 +2060,8 @@ android_emacs_init (int argc, char **argv, char *dump_file)
      anyway).  */
   Vgc_cons_percentage = make_float (noninteractive && initialized ? 1.0 : 0.1);
 
+  if (!NILP (Vnoneditor))
+    goto after_startup_opt_processing;
   no_loadup
     = argmatch (argv, argc, "-nl", "--no-loadup", 6, NULL, &skip_args);
 
@@ -2043,7 +2124,7 @@ android_emacs_init (int argc, char **argv, char *dump_file)
     char *displayname = 0;
 
     /* Skip any number of -d options, but only use the last one.  */
-    while (!only_version)
+    while (!only_version && !noneditor_eval_source)
       {
 	int count_before_this = skip_args;
 
@@ -2082,11 +2163,12 @@ android_emacs_init (int argc, char **argv, char *dump_file)
 
       }
 
-    if (argmatch (argv, argc, "-x", 0, 1, &junk, &skip_args))
+    if (argmatch (argv, argc, "-x", 0, 1, &junk, &skip_args) && !noneditor_eval_source)
       {
 	noninteractive = 1;
 	no_site_lisp = 1;
 	/* This is picked up in startup.el.  */
+	/* but will cause issues for -temacs=eval */
 	argv[skip_args - 1] = (char *) "-scripteval";
 	skip_args -= 1;
 	sort_args (argc, argv);
@@ -2100,6 +2182,8 @@ android_emacs_init (int argc, char **argv, char *dump_file)
      except when building temacs
      because the -d argument has not been skipped in skip_args.  */
 
+ after_startup_opt_processing:
+
 #ifdef MSDOS
   /* Call early 'cause init_environment needs it.  */
   init_dosfns ();
@@ -2513,7 +2597,7 @@ android_emacs_init (int argc, char **argv, char *dump_file)
   init_sfntfont_android ();
 #endif
 
-  if (!initialized)
+  if (!initialized && !NILP (Vnoneditor))
     {
       char *file;
       /* Handle -l loadup, args passed by Makefile.  */
@@ -2528,10 +2612,14 @@ android_emacs_init (int argc, char **argv, char *dump_file)
 	  Vtop_level = list2 (Qload, build_unibyte_string (file));
 	}
       /* Unless next switch is -nl, load "loadup.el" first thing.  */
-      if (! no_loadup)
+      if (!no_loadup)
 	Vtop_level = list2 (Qload, build_string ("loadup.el"));
+    }
+
 
 #ifdef HAVE_NATIVE_COMP
+  if (!initialized)
+    {
       /* If we are going to load stuff in a non-initialized Emacs,
 	 update the value of native-comp-eln-load-path, so that the
 	 *.eln files will be found if they are there.  */
@@ -2540,8 +2628,8 @@ android_emacs_init (int argc, char **argv, char *dump_file)
 	  Fcons (Fexpand_file_name (XCAR (Vnative_comp_eln_load_path),
 				    Vinvocation_directory),
 		 Qnil);
-#endif
     }
+#endif
 
   /* Set up for profiling.  This is known to work on FreeBSD,
      GNU/Linux and MinGW.  It might work on some other systems too.
@@ -2567,6 +2655,17 @@ android_emacs_init (int argc, char **argv, char *dump_file)
   safe_run_hooks (Qafter_pdump_load_hook);
 #endif
 
+  if (!NILP (Vnoneditor) || noneditor_eval_source)
+    {
+      int noneditor_nargs;
+      make_noneditor_args (argc, argv, &noneditor_nargs);
+      noneditor_main (noneditor_nargs-1,argv + 1);
+
+      /* noneditor eval should never return here -
+	 Avoiding recursive edit (normal startup) is the point. */
+      fatal ("noneditor eval must exit without returning.");
+    }
+
 #if defined HAVE_ANDROID && !defined ANDROID_STUBIFY && 0
   /* This comes very late in the startup process because it requires
      most of lisp/international to be loaded.  This approach doesn't
@@ -2577,6 +2676,25 @@ android_emacs_init (int argc, char **argv, char *dump_file)
 		      list1 (Qandroid_enumerate_fonts));
 #endif
 
+  if (EXE_CONFIGURED_EVAL_SHIM (exe_config)
+      && *(exe_config->s.shim))
+    {
+      Lisp_Object x = CALLN (Fconcat,
+			     build_string ("(progn "),
+			     build_string (exe_config->s.shim),
+			     build_string (" )"));
+      x = list2 (Qeval, list2 (Qread, x));
+
+      /* evaluate the shim program then usual top-level
+	 ensure top-level is set back to the usual value
+	 so the shim is only evaluated once (by this mechanism, at least)
+	 but give the shim a chance to modify it */
+      Vtop_level = list4 (Qprogn,
+			  list3 (Qsetq, Qtop_level, Vtop_level),
+			  x,
+			  list2 (Qeval, Vtop_level));
+    }
+
   /* Enter editor command loop.  This never returns.  */
   set_initial_minibuffer_mode ();
   Frecursive_edit ();
@@ -2896,6 +3014,71 @@ sort_args (int argc, char **argv)
   xfree (new);
   xfree (priority);
 }
+
+/* argument processing for noneditor mode is minimal.
+   --dump and --temacs options cannot be ignored, but we discard them here.
+*/
+
+void
+make_noneditor_args (int argc, char **argv, int *nargs)
+{
+  bool to_discard[argc];
+  int discarded = 0;
+  int skip;
+  char *value  = NULL;
+  *nargs = argc;
+
+  for (int j = 0; j < (argc - 1); j++)
+    {
+      skip = j;
+      if (argmatch (argv, argc, "-dump-file", "--dump-file", 6, &value,
+		    &skip)
+	  || argmatch (argv, argc, "-temacs", "--temacs", 8, &value, &skip))
+	{
+	  discarded += (skip - j);
+	  for (; j < skip; j++)
+	    {
+	      to_discard[j+1] = true;
+	    }
+	  continue;
+	}
+      if (argmatch (argv, argc, "--", NULL, 2, NULL, &skip))
+	{
+	  for (; j < (argc-1); j++)
+	    to_discard[j+1] = false;
+	  break;
+	}
+	to_discard[j+1] = false;
+    }
+  *nargs = argc - discarded;
+  if (discarded > 0)
+    {
+      int j,k;
+      /* There is no reordering, we just move nondiscarded arguments forward.*/
+      for (j = 1; j < argc && !to_discard[j]; j++);
+      for (k = j;  k < *nargs && j < argc; j++)
+	{
+	  if (!to_discard[j])
+	    argv[k++] = argv[j];
+	}
+      for (j=*nargs; j < argc; j++)
+	{
+	  argv[j] = NULL;
+	}
+    }
+
+  /* Preserve the pristine arguments recorded by init_cmdargs. */
+  Voriginal_command_line_args = Vcommand_line_args;
+  Vcommand_line_args = Qnil;
+
+  for (int i = *nargs - 1; i >= 0; i--)
+    {
+      Vcommand_line_args
+	= Fcons (build_unibyte_string (argv[i]), Vcommand_line_args);
+    }
+
+}
+
 
 DEFUN ("kill-emacs", Fkill_emacs, Skill_emacs, 0, 2, "P",
        doc: /* Exit the Emacs job and kill it.
@@ -3131,6 +3314,76 @@ shut_down_emacs (int sig, Lisp_Object stuff)
 #endif
 }
 
+
+
+
+/* Ensure these settings survive a dump
+ * for creating dedicated noneditor mode tools.
+ */
+void init_noneditor_eval_for_pdumper (void)
+{
+  bool bare = EXE_CONFIGURED_BARE(exe_config) || (temacs != NULL);
+  no_loadup = true;
+  inhibit_window_system = 1;
+  noninteractive = 1;
+  Vundo_outer_limit = Qnil;
+  no_site_lisp = true;
+#ifdef HAVE_PDUMPER
+  attempt_load_pdump = !bare;
+#endif
+
+  noneditor_eval_source = NONEDITOR_EVAL_NONE;
+  if (EXE_CONFIGURED_NONEDITOR (exe_config))
+    {
+      noneditor_eval_source = exe_config->s.flags & NONEDITOR_EVAL_MASK;
+    }
+  else if (bare) /* --temacs option on the command line */
+    {
+      if (!strcmp (temacs,"eval"))
+	noneditor_eval_source = NONEDITOR_EVAL_BOTH;
+      else if (!strcmp (temacs,"eval-args"))
+	noneditor_eval_source = NONEDITOR_EVAL_ARGS;
+      else if (!strcmp (temacs,"eval-stdin"))
+	noneditor_eval_source = NONEDITOR_EVAL_STDIN;
+      else if (!strcmp (temacs,"eval-none"))
+	noneditor_eval_source = NONEDITOR_EVAL_NONE;
+      else
+	fatal ("Unrecognized temacs evaluation option '%s'",temacs);
+    }
+  else
+    {
+      /* Must be loaded from a dump, if Vnoneditor wasn't set default to stdin.*/
+      if (NILP(Vnoneditor))
+	noneditor_eval_source = NONEDITOR_EVAL_STDIN;
+    }
+  if (NILP(Vnoneditor))
+    {
+      switch (noneditor_eval_source)
+	{
+	case NONEDITOR_EVAL_NONE:
+	  if (bare && !temacs) temacs = temacs_eval_opts.none;
+	  /* Just return 0 exit code */
+	  Vnoneditor = make_fixnum(0);
+	  break;
+	case NONEDITOR_EVAL_ARGS:
+	  if (bare && !temacs) temacs = temacs_eval_opts.args;
+	  Vnoneditor = Qcommand_line_args;
+	  break;
+	case NONEDITOR_EVAL_STDIN:
+	  if (bare && !temacs) temacs = temacs_eval_opts.stdin;
+	  Vnoneditor = Qstdin;
+	  break;
+	case NONEDITOR_EVAL_BOTH:
+	  if (bare && !temacs) temacs = temacs_eval_opts.both;
+	  Vnoneditor = Qt;
+	  break;
+	default:
+	  fatal ("Impossible");
+	}
+    }
+
+}
+
 
 
 /* Recover from setlocale (LC_ALL, "").  */
@@ -3418,6 +3671,704 @@ DEFUN ("daemon-initialized", Fdaemon_initialized, Sdaemon_initialized, 0, 0, 0,
   return Qt;
 }
 
+static Lisp_Object process_fingerprint_errors(FINGERPRINT_ERROR fr,
+					      int errnos[3],
+					      char *file,
+					      char *outfiles);
+
+static void
+release_fingerprint_buffer (void *p)
+{
+  if (p == NULL) return;
+  struct fingerprint_buffer *fb = (struct fingerprint_buffer *) p;
+  int errnos[3];
+  ptrdiff_t filename_sz = strlen(fb->file)+1;
+  char *file = alloca(filename_sz);
+  if (file == NULL)
+    {
+      xsignal1 (Qerror,
+		CALLN (Fformat,
+		       build_string ("alloca failed: could not copy '%s'"),
+		       build_string (fb->file)));
+    }
+  memcpy (file, fb->file, filename_sz);
+  ptrdiff_t outfilename_sz = 0;
+  char *outfile = NULL;
+  if (fb->outfile == fb->file)
+    {
+      outfile = file;
+      outfilename_sz = filename_sz;
+    }
+  else if (fb->outfile != NULL)
+    {
+      outfilename_sz = strlen(fb->file)+1;
+      outfile = alloca(outfilename_sz);
+      if (outfile == NULL)
+	{
+	  xsignal1 (Qerror,
+		    CALLN (Fformat,
+			   build_string ("alloca failed: could not copy '%s'"),
+			   build_string (outfile)));
+	}
+      memcpy (outfile, fb->outfile, outfilename_sz);
+    }
+  FINGERPRINT_ERROR r = fingerprint_release_buffer (fb, errnos);
+  Lisp_Object errs =  process_fingerprint_errors (r, errnos, file, outfile);
+  if (!NILP(errs))
+    {
+      xsignal (Qcustom_executable_error, errs);
+    }
+
+}
+
+Lisp_Object
+process_fingerprint_errors(FINGERPRINT_ERROR fr,int errnos[3],
+			   char *file, char *outfile)
+{
+  Lisp_Object errs = Qnil;
+  const int errbuf_sz = 256;
+  char errbuf[errbuf_sz];
+  char *errmsg;
+  if (outfile == NULL)
+    outfile = file;
+  if (fr & FINGERPRINT_ERROR_INFILE_CLOSE)
+    {
+      errmsg = strerror_r (errnos[2], errbuf, errbuf_sz);
+      errs = Fcons (CALLN (Fformat,
+			   build_string ("Error closing %s: %s"),
+			   build_string (file),
+			   build_string(errmsg)),
+		    errs);
+    }
+  if (fr & FINGERPRINT_ERROR_OUTFILE_CLOSE)
+    {
+      errmsg = strerror_r (errnos[1], errbuf, errbuf_sz);
+      errs = Fcons (CALLN (Fformat,
+			   build_string ("Error closing %s: %s"),
+			   build_string (outfile),
+			   build_string(errmsg)),
+		    errs);
+    }
+  switch (fr & FINGERPRINT_ERROR_UNIQUE_MASK)
+    {
+    case FINGERPRINT_ERROR_NONE:
+      break;
+    case FINGERPRINT_ERROR_NO_INFILE:
+      errs = Fcons (CALLN (Fformat,
+			   build_string ("Internal error: missing or extra "
+					 "file operand, although '%s' "
+					 "specified"),
+			   build_string (file)),
+		    errs);
+      break;
+    case FINGERPRINT_ERROR_INFILE_NOT_OPENED:
+      errmsg = strerror_r (errnos[0], errbuf, errbuf_sz);
+      errs = Fcons (CALLN (Fformat,
+			   build_string ("Could not open %s: %s\n"),
+			   build_string (file),
+			   build_string (errmsg)),
+		    errs);
+      break;
+    case FINGERPRINT_ERROR_INFILE_NOT_REGULAR:
+      errs = Fcons (CALLN (Fformat,
+			   build_string ("%s is not a regular file"),
+			   build_string (file)),
+		    errs);
+      break;
+    case FINGERPRINT_ERROR_BUFFER_SIZE:
+      errs = Fcons (CALLN (Fformat,
+			   build_string ("%s: file too big"),
+			   build_string (file)),
+		    errs);
+      break;
+    case FINGERPRINT_ERROR_BUFFER_ALLOCATION:
+    case FINGERPRINT_ERROR_FPSTORE_ALLOCATION:
+      errmsg = strerror_r (errnos[0], errbuf, errbuf_sz);
+      errs = Fcons (CALLN (Fformat,
+			   build_string ("malloc: %s\n"),
+			   build_string(errmsg)),
+		    errs);
+      break;
+    case FINGERPRINT_ERROR_INFILE_READ:
+      errs = Fcons (CALLN (Fformat,
+			   build_string ("Could not read %s"),
+			   build_string (file)),
+		    errs);
+      break;
+    case FINGERPRINT_ERROR_HASH_NOT_FOUND:
+      errs = Fcons (CALLN (Fformat,
+			   build_string ("%s: missing fingerprint"),
+			   build_string (file)),
+		    errs);
+      break;
+    case FINGERPRINT_ERROR_HASH_TOO_MANY:
+      errs = Fcons (CALLN (Fformat,
+			   build_string ("Fingerprint is not unique in file %s"),
+			   build_string (file)),
+		    errs);
+      break;
+    case FINGERPRINT_ERROR_OUTFILE_CREATION:
+      errmsg = strerror_r (errnos[0], errbuf, errbuf_sz);
+      errs = Fcons (CALLN (Fformat,
+			   build_string ("Error creating %s: %s\n"),
+			   build_string (outfile),
+			   build_string (errmsg)),
+		    errs);
+      break;
+    case FINGERPRINT_ERROR_OUTFILE_WRITE:
+      errmsg = strerror_r (errnos[0], errbuf, errbuf_sz);
+      errs = Fcons (CALLN (Fformat, build_string ("Error writing %s: %s\n"),
+			   build_string (outfile),
+			   build_string (errmsg)),
+		    errs);
+      break;
+    case FINGERPRINT_ERROR_NO_INPLACE:
+      errs = Fcons (build_string ("Inplace modification disallowed"),
+		    errs);
+      break;
+    case FINGERPRINT_ERROR_RAW_NO_DIGEST:
+      errs = Fcons (build_string ("Internal error"),
+		    errs);
+      break;
+    case FINGERPRINT_ERROR_DATA_OVERFLOW:
+      errs = Fcons (build_string ("Data exceeds available space"),
+		    errs);
+      break;
+    default:
+      errs = Fcons (build_string ("Unrecognized fingerprint error"),
+		    errs);
+    }
+  return errs;
+}
+
+static Lisp_Object
+make_flag_list(enum ECFG_FLAG flags)
+{
+  Lisp_Object r = Qnil;
+  if (flags & ECFG_EVAL_SHIM)
+    r = Fcons (Qshim, r);
+  if (flags & ECFG_EVAL_STDIN)
+    r = Fcons (Qstdin, r);
+  if (flags & ECFG_EVAL_ARGS)
+    r = Fcons (Qargs, r);
+  if (flags & ECFG_BARE)
+    r = Fcons (Qbare, r);
+  if (flags & ECFG_NONEDITOR)
+    r = Fcons (Qnoneditor, r);
+  if (flags & ECFG_CONFIGURED)
+    r = Fcons (Qconfigured, r);
+  return r;
+}
+
+static Lisp_Object
+make_executable_custom_settings (exe_config_header *cfg, ptrdiff_t shim_size)
+{
+  if (cfg == NULL)
+    return Qnil;
+  Lisp_Object r = Qnil;
+  r = Fcons ( list2 (Qshim, make_string (cfg->shim,
+					 strnlen(cfg->shim,
+						 shim_size))),
+	      r);
+  r = Fcons ( list2 (Qdump_file_base,
+		     make_string (cfg->argv0_base,
+				  strnlen(cfg->argv0_base,
+					  ECFG_ARGV0_BASE_SIZE))),
+	      r);
+  r = Fcons ( list2 (Qflags,
+		     make_flag_list(cfg->flags)),
+	      r);
+  return r;
+}
+
+static Lisp_Object
+make_executable_fingerprint_data (struct fingerprint_storage_header *store,
+				  ptrdiff_t max_shim_size)
+{
+  Lisp_Object result =
+    make_executable_custom_settings ((exe_config_header *) store->data,
+				     max_shim_size);
+  const uint64_t intmask = ~((~0LLU) << FIXNUM_BITS);
+  /* If this ever overflows, something would have to be corrupted
+     we are not looking at a real fingerprint_storage_header */
+  Lisp_Object store_size = make_fixnum (intmask & store->size);
+  Lisp_Object fp_vec = make_vector (FINGERPRINT_HASH_SIZE, Qnil);
+  Lisp_Object pc_fp_vec = make_vector (FINGERPRINT_HASH_SIZE, Qnil);
+  for (ptrdiff_t i = 0; i < FINGERPRINT_HASH_SIZE; i++)
+    {
+      ASET (fp_vec, i, make_fixnum(store->hash[i]));
+      ASET (pc_fp_vec, i, make_fixnum(store->pristine_hash_c[i]));
+    }
+
+  result = list4 (list2 (Qpristine_fingerprint_complement, pc_fp_vec),
+		  list2 (Qfingerprint, fp_vec),
+		  list2 (Qsize, store_size),
+		  result);
+  return result;
+}
+
+DEFUN ("get-emacs-executable-custom-settings",
+       Fget_emacs_executable_custom_settings,
+       Sget_emacs_executable_custom_settings,
+       0, 0, 0,
+       doc: /* Get hard-coded options embedded in current emacs executable.
+Returns a list of
+executable configuration flags
+last-resort basename for dump file
+string of the shim program, if any.*/)
+  (void)
+{
+  return make_executable_custom_settings ((exe_config_header *) exe_config, ECFG_SHIM_SIZE);
+}
+
+
+DEFUN ("get-emacs-executable-fingerprint-data",
+       Fget_emacs_executable_fingerprint_data,
+       Sget_emacs_executable_fingerprint_data,
+       1, 2, 0,
+       doc: /* Get data in fingerprint storage from specified emacs executable.
+Returns a list of
+ones-complement of the pristine fingerprint hash
+value of the fingerprint hash as seen by the emacs runtime
+size of the data segment following the fingerprint
+the emacs executable custom settings
+(see get-emacs-executable-custom-settings).
+The size of the shim program returned will be truncated to the specified maximum
+shim size, or the maximum size allowed for the shim of the current
+emacs executable otherwise.
+	    */)
+  (Lisp_Object emacs_exe, Lisp_Object max_shim_size)
+{
+  const ptrdiff_t hdr_sz = offsetof (struct fingerprint_storage_header,data);
+  const ptrdiff_t execfg_hdr_sz = offsetof (exe_config_header, shim);
+
+  char *filename;
+  ptrdiff_t filename_size = 0;
+  if (NILP (emacs_exe))
+    emacs_exe = build_string (initial_emacs_executable);
+  if (!STRINGP(emacs_exe))
+    {
+      xsignal1 (Qinvalid_executable_path,
+		CALLN (Fformat,
+		       build_string ("Invalid emacs executable argument: %S"),
+		       emacs_exe));
+    }
+  filename_size = STRING_BYTES(XSTRING (emacs_exe)) + 1;
+  filename = alloca(filename_size+1);
+  if (filename == NULL)
+    {
+      xsignal1 (Qerror,
+		CALLN (Fformat,
+		       build_string ("alloca failed: Could not copy string '%s'"),
+		       emacs_exe));
+    }
+  if (filename_size <= 1)
+    {
+      xsignal1 (Qinvalid_executable_path,build_string ("Empty executable path"));
+    }
+  memcpy (filename, SSDATA (emacs_exe), filename_size-1);
+  filename[filename_size] = 0;
+
+
+  struct fingerprint_replacement_options opts =
+  {
+    true,
+    false,  /* allow modifying the executable in-place */
+    -1
+  };
+  int errnos[3] = { 0 };
+  struct fingerprint_buffer *fb;
+  specpdl_ref count = SPECPDL_INDEX ();
+  FINGERPRINT_ERROR r =
+    fingerprint_get_buffer(filename, NULL, &opts, &fb, errnos);
+  if (r != FINGERPRINT_ERROR_NONE)
+    {
+      Lisp_Object errs =  process_fingerprint_errors (r, errnos, filename, NULL);
+      if (!NILP(errs))
+	{
+	  xsignal (Qcustom_executable_error, errs);
+	}
+    }
+  if (fb == NULL)
+    {
+      xsignal1 (Qcustom_executable_error, build_string ("Unkown fingerprint error"));
+    }
+  record_unwind_protect_ptr(release_fingerprint_buffer, (void *) fb);
+  uint64_t ec_size = fb->hdr->size;
+  exe_config_header *ech = (exe_config_header *) fb->hdr->data;
+  uint64_t flags0 = ech->flags;
+  char *argv0_base0 = ech->argv0_base;
+  uint64_t ec_shim_sz = ec_size - offsetof (exe_config_header, shim);
+  char *shim0 = ech->shim;
+
+  if (NILP (max_shim_size))
+    max_shim_size = make_fixnum (ec_shim_sz-1);
+  if (!FIXNUMP(max_shim_size))
+    xsignal1(Qerror,
+	     CALLN(Fformat,
+		   build_string ("Invalid maximum shim size argument: %s"),
+		   max_shim_size));
+  ptrdiff_t max_sz = XLI (max_shim_size);
+  if (max_sz < 0)
+	xsignal1(Qerror,
+		 CALLN(Fformat,
+		       build_string ("Invalid maximum size argument: %s"),
+		       max_shim_size));
+
+  ptrdiff_t lim = hdr_sz + execfg_hdr_sz + max_sz + 1;
+  unsigned char *store = xmalloc (lim);
+  if (store == NULL)
+    {
+      xsignal(Qerror,
+	      build_string ("Could not allocate memory for "
+			    "fingerprint storage data"));
+    }
+  record_unwind_protect_ptr(xfree,(void *) store);
+  memcpy (store, (unsigned char *) fb->hdr, lim-1);
+  store[lim-1] = 0;
+
+  struct fingerprint_storage_header *hdr =
+    (struct fingerprint_storage_header *) store;
+
+  return unbind_to (count, make_executable_fingerprint_data (hdr, max_sz));
+
+}
+
+static uint64_t
+process1_custom_executable_flag (uint64_t flags, Lisp_Object delta_flag, int pos)
+{
+  if (EQ (delta_flag,Qoriginal))
+    {
+      if (pos > 0)
+	{
+	  xsignal1 (Qinvalid_executable_flag,
+		    CALLN (Fformat,
+			   build_string ("%s flag only allowed in isolation "
+					 "or at beginning of flag list"),
+			   delta_flag));
+	}
+    }
+  else if (EQ (delta_flag, Qclear))
+    {
+      flags = ECFG_NONE;
+    }
+  else if (EQ (delta_flag, Qnoneditor))
+    flags |= ECFG_NONEDITOR;
+  else if (EQ (delta_flag, Qstdin))
+    flags |= ECFG_EVAL_STDIN;
+  else if (EQ (delta_flag, Qcommand_line_args) || EQ (delta_flag, Qargs))
+    flags |= ECFG_EVAL_ARGS;
+  else if (EQ (delta_flag, Qbare))
+    flags |= ECFG_BARE;
+  else if (EQ (delta_flag, Qshim))
+    flags |= ECFG_EVAL_SHIM;
+  else if (EQ (delta_flag, Qnoshim))
+    flags &= (uint64_t) ~((uint64_t) ECFG_EVAL_SHIM);
+  else if (EQ (delta_flag, Qnostdin))
+    flags &= (uint64_t) ~((uint64_t) ECFG_EVAL_STDIN);
+  else if (EQ (delta_flag, Qnoargs))
+    flags &= (uint64_t) ~((uint64_t) ECFG_EVAL_ARGS);
+  else if (EQ (delta_flag, Qnot_bare))
+    flags &= (uint64_t) ~((uint64_t) ECFG_BARE);
+  else if (EQ (delta_flag, Qeditor))
+    flags &= (uint64_t) ~((uint64_t) ECFG_NONEDITOR);
+  else if (EQ (delta_flag, Qconfigured))
+    flags |= ECFG_CONFIGURED;
+  else if (EQ (delta_flag, Qunconfigured))
+    flags &= (uint64_t) ~((uint64_t) ECFG_CONFIGURED);
+  else
+    {
+      xsignal1 (Qinvalid_executable_flag, delta_flag);
+    }
+  return flags;
+}
+
+static uint64_t
+process_custom_executable_flags (uint64_t flags0, Lisp_Object delta_flags)
+{
+  uint64_t flags = ECFG_NONE;
+
+  if (NILP(delta_flags))
+    {
+      /* no flags */
+      flags = ECFG_NONE;
+    }
+  else if (CONSP (delta_flags))
+    {
+      Lisp_Object tail = delta_flags;
+      int pos = 0;
+      FOR_EACH_TAIL (tail)
+	{
+	  flags = process1_custom_executable_flag (flags,
+						   XCAR (tail),
+						   pos);
+	  pos++;
+	}
+    }
+  else
+    {
+      flags = process1_custom_executable_flag (flags,delta_flags,-1);
+    }
+  /* set the configured flag if any option is set */
+  if (flags & (uint64_t) ~((uint64_t) ECFG_CONFIGURED))
+      flags |= ECFG_CONFIGURED;
+
+  return flags;
+}
+
+DEFUN ("make-custom-emacs-executable",
+       Fmake_custom_emacs_executable, Smake_custom_emacs_executable, 1, 6, 0,
+       doc: /* Make a customized copy of an emacs executable.
+User specifies options to be stored into executable */)
+  (Lisp_Object outfile, Lisp_Object flag_ls, Lisp_Object basename,
+   Lisp_Object shim, Lisp_Object hash, Lisp_Object emacs_exe)
+{
+  /* ptrdiff_t max_shim_size = (char *) (exe_config + sizeof *exe_config) */
+  /*   - (char *) exe_config->s.shim; */
+
+  bool reset_hash = (EQ (hash, Qreset)
+		     || EQ (hash, Qpristine));
+  bool keep_hash = EQ (hash, Qoriginal) || EQ (hash, Qnil);
+  bool modify_before = EQ (hash,Qcustom); // update before hashing
+  bool modify_after = EQ (hash,Qstandard); // update after hashing
+  if (!modify_before && !modify_after && !reset_hash)
+    {
+      xsignal1 (Qcustom_executable_error,
+		CALLN (Fformat,
+		       build_string ("Invalid hash option: %S"),
+		       hash));
+    }
+  bool keep_basename = EQ (basename, Qoriginal) || EQ (basename, Qnil);
+  bool clear_basename = (EQ (basename, Qreset) || EQ (basename, Qclear));
+  bool keep_shim = EQ (shim, Qoriginal);
+  bool clear_shim = (EQ (shim, Qreset) || EQ (shim, Qclear));
+  char *filename;
+  ptrdiff_t filename_size = 0;
+  if (NILP (emacs_exe))
+    emacs_exe = build_string (initial_emacs_executable);
+  if (!STRINGP(emacs_exe))
+    {
+      xsignal1 (Qinvalid_executable_path,
+		CALLN (Fformat,
+		       build_string ("Invalid emacs executable argument: %S"),
+		       emacs_exe));
+    }
+  filename_size = STRING_BYTES(XSTRING (emacs_exe)) + 1;
+  filename = alloca(filename_size+1);
+  if (filename == NULL)
+    {
+      xsignal1 (Qerror,
+		CALLN (Fformat,
+		       build_string ("alloca failed: Could not copy string '%s'"),
+		       emacs_exe));
+    }
+  if (filename_size <= 1)
+    {
+      xsignal1 (Qinvalid_executable_path,build_string ("Empty executable path"));
+    }
+  memcpy (filename, SSDATA (emacs_exe), filename_size-1);
+  filename[filename_size] = 0;
+
+  char *outfilename;
+  ptrdiff_t outfilename_size = 0;
+  if (!STRINGP(outfile))
+      xsignal2 (Qinvalid_executable_path, outfile, build_string ("Not a string"));
+  outfilename_size = STRING_BYTES(XSTRING (outfile)) + 1;
+  outfilename = (char *) alloca(outfilename_size+1);
+  if (outfilename == NULL)
+    {
+      xsignal1 (Qerror,
+		CALLN (Fformat,
+		       build_string ("alloca failed: Could not copy string '%s'"),
+		       outfile));
+    }
+  if (outfilename_size <= 1)
+      xsignal1 (Qinvalid_executable_path,build_string ("Empty executable path"));
+  memcpy (outfilename, SSDATA (outfile), outfilename_size-1);
+  outfilename[outfilename_size] = 0;
+
+
+  /* Now have all required information */
+  struct fingerprint_replacement_options opts =
+  {
+    false,
+    true,  /* allow modifying the executable in-place */
+    -1
+  };
+
+  int errnos[3] = { 0 };
+  struct fingerprint_buffer *fb;
+  specpdl_ref count = SPECPDL_INDEX ();
+  FINGERPRINT_ERROR r =
+    fingerprint_get_buffer(filename, outfilename, &opts, &fb, errnos);
+  if (r != FINGERPRINT_ERROR_NONE)
+    {
+      Lisp_Object errs =  process_fingerprint_errors (r, errnos, filename, outfilename);
+      if (!NILP(errs))
+	{
+	  xsignal (Qcustom_executable_error, errs);
+	}
+    }
+  if (fb == NULL)
+    {
+      xsignal1 (Qcustom_executable_error, build_string ("Unkown fingerprint error"));
+    }
+  record_unwind_protect_ptr(release_fingerprint_buffer, (void *) fb);
+  uint64_t ec_size = fb->hdr->size;
+  exe_config_header *ech = (exe_config_header *) fb->hdr->data;
+  uint64_t flags0 = ech->flags;
+  char *argv0_base0 = ech->argv0_base;
+  uint64_t ec_shim_sz = ec_size - offsetof (exe_config_header, shim);
+  char *shim0 = ech->shim;
+
+  uint64_t flags = process_custom_executable_flags (flags0, flag_ls);
+
+  char *basename_bytes = NULL;
+  ptrdiff_t basename_size = 0;
+  if (NILP (basename))
+    {
+      keep_basename = true;
+      basename_bytes = argv0_base0;
+      basename_size = ECFG_ARGV0_BASE_SIZE;
+    }
+  else if (STRINGP (basename) || SYMBOLP (basename))
+    {
+      if (SYMBOLP (basename))
+	basename = XSYMBOL (basename)->u.s.name;
+      basename_size = STRING_BYTES (XSTRING (basename)) + 1;
+      if (basename_size > ECFG_ARGV0_BASE_SIZE)
+	{
+	  xsignal1 (Qinvalid_dumpfile_basename,
+		    CALLN (Fformat,
+			   build_string ("Name '%s' is too long - "
+					 "limit is %s bytes"),
+			   basename,
+			   make_fixnum (ECFG_ARGV0_BASE_SIZE)));
+	}
+      basename_bytes = alloca (basename_size);
+      if (basename_bytes == NULL)
+	{
+	  xsignal1 (Qerror,
+		    CALLN (Fformat,
+			   build_string ("alloca failed: could not copy '%s'"),
+			   basename));
+	}
+      memcpy (basename_bytes, SSDATA (basename), basename_size);
+    }
+  else
+    {
+      xsignal1 (Qinvalid_dumpfile_basename,
+		CALLN (Fformat,
+		       build_string ("Value must be a string "
+				     "or symbol, given %S"),
+		       basename));
+    }
+
+  Lisp_Object shim_str = Qnil;
+  if (NILP(shim))
+    {
+      if (flags & ECFG_EVAL_SHIM)
+	  shim_str = build_string (ech->shim);
+      else
+	shim_str = build_string ("");
+    }
+  else if (keep_shim)
+    shim_str = build_string (ech->shim);
+  else if (clear_shim)
+	shim_str = build_string ("");
+  else
+    {
+      /* shim is an s-expression
+	 print to a string that can be evaluated */
+      shim_str =
+	Fprin1_to_string (shim, Qnil,
+			  list( Fcons (Qlength, Qnil),
+				Fcons (Qlevel, Qnil),
+				Fcons (Qcircle, Qt),
+				Fcons (Qcharset_text_property, Qnil)));
+      /* could test that the string reads back without error */
+    }
+  ptrdiff_t shim_str_sz = STRING_BYTES (XSTRING (shim_str))+1;
+  if (shim_str_sz >= ec_shim_sz)
+    {
+      xsignal2 (Qcustom_executable_error,
+		build_string ("Shim program too large"),
+		shim_str);
+    }
+
+  /* do not modify the private copy of the original header in
+     the fingerprint_buffer */
+  /* Aim for correctness, optimize later if it is an issue. */
+  uint64_t hdr_size =
+    sizeof (struct fingerprint_storage_header) + fb->hdr->size;
+  struct fingerprint_storage_header *hdr
+    = (struct fingerprint_storage_header *) xmalloc (hdr_size);
+  /* make sure this is freed */
+  record_unwind_protect_ptr (xfree, hdr);
+  memcpy ((unsigned char *) hdr, (unsigned char *) fb->hdr, hdr_size);
+
+  exe_config_header *ec_hdr = (exe_config_header *) hdr->data;
+  ec_hdr->flags = flags;
+  memcpy (ec_hdr->argv0_base, basename_bytes,basename_size);
+  if (basename_size < ECFG_ARGV0_BASE_SIZE)
+    memset (ec_hdr->argv0_base + basename_size,
+	    0,
+	    (ECFG_ARGV0_BASE_SIZE - basename_size));
+  memset (ec_hdr->shim, 0, ec_shim_sz);
+  memcpy (ec_hdr->shim, SSDATA (shim_str), shim_str_sz);
+
+  /* if all the data is cleared, ensure the configuration flag is as well */
+  if (ec_hdr->shim[0] == 0 && ec_hdr->argv0_base[0] == 0
+      && ((ec_hdr->flags & (uint64_t) ~((uint64_t) ECFG_CONFIGURED)) == 0))
+    {
+      ec_hdr->flags = ECFG_NONE;
+    }
+
+  if (modify_before)
+    {
+      fingerprint_set_data (fb, hdr->size, (unsigned char *) ec_hdr);
+      if (fb->code != FINGERPRINT_ERROR_NONE)
+	goto done;
+    }
+
+  if (reset_hash)
+    {
+      fingerprint_reset_hash(fb);
+      if (fb->code != FINGERPRINT_ERROR_NONE)
+	goto done;
+    }
+  else if (!keep_hash)
+    {
+      if (!modify_before)
+	{
+	  unsigned char zdata[1] = { 0 };
+	  /* this will cause the data to be zeroed */
+	  /* before calculating the fingerprint */
+	  fingerprint_set_data (fb, 1, zdata);
+	  if (fb->code != FINGERPRINT_ERROR_NONE)
+	    goto done;
+	}
+      fingerprint_set_hash (fb);
+      if (fb->code != FINGERPRINT_ERROR_NONE)
+	goto done;
+    }
+  /* else leave hash as it is */
+
+  if (modify_after)
+    {
+      fingerprint_set_data (fb, hdr->size, (unsigned char *) ec_hdr);
+      if (fb->code != FINGERPRINT_ERROR_NONE)
+	goto done;
+    }
+  fingerprint_write_outfile (fb);
+  if (fb->code != FINGERPRINT_ERROR_NONE)
+    goto done;
+
+ done:
+  return
+    unbind_to (count,make_executable_custom_settings (ec_hdr, ec_shim_sz));
+}
+
 void
 syms_of_emacs (void)
 {
@@ -3437,11 +4388,73 @@ syms_of_emacs (void)
   defsubr (&Sinvocation_directory);
   defsubr (&Sdaemonp);
   defsubr (&Sdaemon_initialized);
+  defsubr (&Smake_custom_emacs_executable);
+  defsubr (&Sget_emacs_executable_custom_settings);
+  defsubr (&Sget_emacs_executable_fingerprint_data);
+
 
   DEFVAR_LISP ("command-line-args", Vcommand_line_args,
 	       doc: /* Args passed by shell to Emacs, as a list of strings.
 Many arguments are deleted from the list as they are processed.  */);
 
+  /* also need command-line-args as an explicit symbol for noneditor */
+  DEFSYM (Qcommand_line_args,"command-line-args");
+  DEFSYM (Qargs,"args");
+  DEFSYM (Qconfigured, "configured");
+  DEFSYM (Qunconfigured, "unconfigured");
+  DEFSYM (Qnoneditor, "noneditor");
+  DEFSYM (Qeditor, "editor");
+  DEFSYM (Qbare, "bare");
+  DEFSYM (Qnot_bare, "not-bare");
+  DEFSYM (Qshim, "shim");
+  DEFSYM (Qnoshim, "noshim");
+  DEFSYM (Qnostdin, "nostdin");
+  DEFSYM (Qnoargs, "noargs");
+  DEFSYM (Qoriginal, "original");
+  DEFSYM (Qclear, "clear");
+  DEFSYM (Qflags, "flags");
+  DEFSYM (Qsize, "size");
+  DEFSYM (Qdump_file_base, "dump-file-base");
+  DEFSYM (Qcustom, "custom");
+  /* Moved from w32font so definition is not be platform-dependent */
+  DEFSYM (Qstandard, "standard");
+  DEFSYM (Qpristine, "pristine");
+  DEFSYM (Qfingerprint, "fingerprint");
+  DEFSYM (Qversion, "version");
+  DEFSYM (Qpristine_fingerprint_complement, "pristine-fingerprint-complement");
+  DEFSYM (Qcustom_executable_error,"custom-executable-error");
+  DEFSYM (Qinvalid_executable_flag,"invalid-executable-flag");
+  DEFSYM (Qincompatible_executable_flags,"incompatible-executable-flags");
+  DEFSYM (Qinvalid_executable_path,"invalid-executable-path");
+  DEFSYM (Qinvalid_dumpfile_basename,"invalid-dumpfile-basename");
+
+  Fput (Qcustom_executable_error, Qerror_conditions,
+	list1 (Qerror));
+  Fput (Qcustom_executable_error, Qerror_message,
+	build_string ("Error in make-custom-emacs-executable"));
+  Fput (Qinvalid_executable_flag, Qerror_conditions,
+	list2 (Qcustom_executable_error, Qerror));
+  Fput (Qinvalid_executable_flag, Qerror_message,
+	build_string ("Invalid flag for custom emacs executable"));
+  Fput (Qincompatible_executable_flags, Qerror_conditions,
+	list2 (Qcustom_executable_error, Qerror));
+  Fput (Qincompatible_executable_flags, Qerror_message,
+	build_string ("Incompatible flags for custom emacs executable"));
+  Fput (Qinvalid_executable_path, Qerror_conditions,
+	list2 (Qcustom_executable_error, Qerror));
+  Fput (Qinvalid_executable_path, Qerror_message,
+	build_string ("Invalid output path specified for custom emacs executable"));
+  Fput (Qinvalid_dumpfile_basename, Qerror_conditions,
+	list2 (Qcustom_executable_error, Qerror));
+  Fput (Qinvalid_dumpfile_basename, Qerror_message,
+	build_string ("Invalid basename for dump file"));
+
+
+  DEFVAR_LISP ("original-command-line-args", Voriginal_command_line_args,
+	       doc: /* Args passed by shell to Emacs, as a list of strings.
+In noneditor mode, this will contain the command line with
+--dump-file and --temacs options intact. */);
+
   DEFVAR_LISP ("system-type", Vsystem_type,
 	       doc: /* The value is a symbol indicating the type of operating system you are using.
 Special values:
@@ -3479,6 +4492,21 @@ syms_of_emacs (void)
   DEFVAR_BOOL ("noninteractive", noninteractive1,
                doc: /* Non-nil means Emacs is running without interactive terminal.  */);
 
+  DEFVAR_LISP ("noneditor", Vnoneditor,
+               doc: /* Non-nil means running as a noninteractive command-line tool.
+If t, then expressions will be read and evaluated from the command line or stdin.
+If 'command-line-args, then only expressions in the command line arguments
+will be read and evaluated. The variable command-line-args will be set to nil.
+If 'stdin, then only expressions from stdin will be read and evaluated.
+Any other non-nil value indicates it was set before dumping and will be
+used as the "main" program after setting up minimal infrastructure
+for non-local exits by signal and throw, in place of the simple
+read-eval loop used for Qt.
+If set to a function, that function will be invoked with no arguments.
+Any other value will be taken to be and the "main" program will be
+(eval noneditor). */);
+
+
   DEFVAR_LISP ("kill-emacs-hook", Vkill_emacs_hook,
 	       doc: /* Hook run when `kill-emacs' is called.
 Since `kill-emacs' may be invoked when the terminal is disconnected (or
@@ -3513,8 +4541,9 @@ syms_of_emacs (void)
 within the variable `invocation-directory' or its parent.  For example,
 this is the case when running an uninstalled Emacs executable from its
 build directory.  */);
+  /*  This is initialized in init_cmdargs
   Vinstallation_directory = Qnil;
-
+  */
   DEFVAR_LISP ("system-messages-locale", Vsystem_messages_locale,
 	       doc: /* System locale for messages.  */);
   Vsystem_messages_locale = Qnil;
-- 
2.49.0

From cd452b733f303d4688ea36e8970e6815b62f4d61 Mon Sep 17 00:00:00 2001
From: Onnie Lynn Winebarger <[email-masked]>
Date: Mon, 7 Jul 2025 07:15:27 -0400
Subject: [PATCH 09/12] Updated pdumper for changes in fingerprint

---
 src/pdumper.c | 36 ++++++++++++++++++++----------------
 src/pdumper.h |  2 +-
 2 files changed, 21 insertions(+), 17 deletions(-)

diff --git a/src/pdumper.c b/src/pdumper.c
index b3de90bfa03..0747fd265e1 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -317,11 +317,11 @@ dump_reloc_set_offset (struct dump_reloc *reloc, dump_off offset)
 
 void
 dump_fingerprint (FILE *output, char const *label,
-		  unsigned char const xfingerprint[sizeof fingerprint])
+		  unsigned char const xfingerprint[sizeof fingerprint_storage.hash])
 {
-  enum { hexbuf_size = 2 * sizeof fingerprint };
+  enum { hexbuf_size = 2 * sizeof fingerprint_storage.hash };
   char hexbuf[hexbuf_size];
-  hexbuf_digest (hexbuf, xfingerprint, sizeof fingerprint);
+  hexbuf_digest (hexbuf, xfingerprint, sizeof fingerprint_storage.hash);
   fprintf (output, "%s%s%.*s\n", label, *label ? ": " : "",
 	   hexbuf_size, hexbuf);
 }
@@ -363,7 +363,7 @@ dump_fingerprint (FILE *output, char const *label,
   char magic[sizeof (dump_magic)];
 
   /* Associated Emacs binary.  */
-  unsigned char fingerprint[sizeof fingerprint];
+  unsigned char fingerprint[sizeof fingerprint_storage.hash];
 
   /* Relocation table for the dump file; each entry is a
      struct dump_reloc.  */
@@ -2807,7 +2807,7 @@ dump_obarray (struct dump_context *ctx, Lisp_Object object)
 static dump_off
 dump_buffer (struct dump_context *ctx, const struct buffer *in_buffer)
 {
-#if CHECK_STRUCTS && !defined HASH_buffer_23EB984887
+#if CHECK_STRUCTS && !defined HASH_buffer_B02F648B82
 # error "buffer changed. See CHECK_STRUCTS comment in config.h."
 #endif
   struct buffer munged_buffer = *in_buffer;
@@ -4176,6 +4176,10 @@ DEFUN ("dump-emacs-portable",
   Lisp_Object symbol = Qcommand_line_processed;
   specbind (symbol, Qnil);
 
+  /* Ensure noneditor is consistent with noneditor_eval_source if applicable */
+  if (NILP(Vnoneditor) && noneditor_eval_source)
+    specbind (Vnoneditor, Qstdin);
+
   CHECK_STRING (filename);
   filename = Fexpand_file_name (filename, Qnil);
   filename = ENCODE_FILE (filename);
@@ -4267,9 +4271,9 @@ DEFUN ("dump-emacs-portable",
   memcpy (&ctx->header.magic, dump_magic, sizeof (dump_magic));
   ctx->header.magic[0] = '!'; /* Note that dump is incomplete.  */
 
-  static_assert (sizeof (fingerprint) == sizeof (ctx->header.fingerprint));
-  for (int i = 0; i < sizeof fingerprint; i++)
-    ctx->header.fingerprint[i] = fingerprint[i];
+  static_assert (sizeof (fingerprint_storage.hash) == sizeof (ctx->header.fingerprint));
+  for (int i = 0; i < sizeof fingerprint_storage.hash; i++)
+    ctx->header.fingerprint[i] = fingerprint_storage.hash[i];
 
   const dump_off header_start = ctx->offset;
   dump_fingerprint (stderr, "Dumping fingerprint", ctx->header.fingerprint);
@@ -5741,10 +5745,10 @@ pdumper_load (const char *dump_filename, char *argv0)
     }
 
   err = PDUMPER_LOAD_VERSION_MISMATCH;
-  static_assert (sizeof (header->fingerprint) == sizeof (fingerprint));
-  unsigned char desired[sizeof fingerprint];
-  for (int i = 0; i < sizeof fingerprint; i++)
-    desired[i] = fingerprint[i];
+  static_assert (sizeof (header->fingerprint) == sizeof (fingerprint_storage.hash));
+  unsigned char desired[sizeof fingerprint_storage.hash];
+  for (int i = 0; i < sizeof fingerprint_storage.hash; i++)
+    desired[i] = fingerprint_storage.hash[i];
   if (memcmp (header->fingerprint, desired, sizeof desired) != 0)
     {
       dump_fingerprint (stderr, "desired fingerprint", desired);
@@ -5944,9 +5948,9 @@ init_pdumper_once (void)
 syms_of_pdumper (void)
 {
 #ifdef HAVE_PDUMPER
-  unsigned char desired[sizeof fingerprint];
+  unsigned char desired[sizeof fingerprint_storage.hash];
   int i;
-  char hexbuf[2 * sizeof fingerprint];
+  char hexbuf[2 * sizeof fingerprint_storage.hash];
 
   defsubr (&Sdump_emacs_portable);
   defsubr (&Sdump_emacs_portable__sort_predicate);
@@ -5961,8 +5965,8 @@ syms_of_pdumper (void)
   DEFSYM (Qafter_pdump_load_hook, "after-pdump-load-hook");
   defsubr (&Spdumper_stats);
 
-  for (i = 0; i < sizeof fingerprint; i++)
-    desired[i] = fingerprint[i];
+  for (i = 0; i < sizeof fingerprint_storage.hash; i++)
+    desired[i] = fingerprint_storage.hash[i];
 
   hexbuf_digest (hexbuf, desired, sizeof desired);
 
diff --git a/src/pdumper.h b/src/pdumper.h
index fa402942e98..70d9b99f846 100644
--- a/src/pdumper.h
+++ b/src/pdumper.h
@@ -53,7 +53,7 @@ #define PDUMPER_REMEMBER_SCALAR(thing)                  \
   pdumper_remember_scalar (&(thing), sizeof (thing))
 
 extern void dump_fingerprint (FILE *output, const char *label,
-                              unsigned char const fingerp[sizeof fingerprint]);
+                              unsigned char const fingerp[sizeof fingerprint_storage.hash]);
 
 extern void pdumper_remember_scalar_impl (void *data, ptrdiff_t nbytes);
 
-- 
2.49.0

From f8f11b552a6c5d68fa8aa3f9d82ba5f2c366eca8 Mon Sep 17 00:00:00 2001
From: Onnie Lynn Winebarger <[email-masked]>
Date: Mon, 7 Jul 2025 07:13:14 -0400
Subject: [PATCH 08/12] Add eval_stream to lisp.h for global use

---
 src/lisp.h  |  1 +
 src/lread.c | 18 +++++++++++++++---
 2 files changed, 16 insertions(+), 3 deletions(-)

diff --git a/src/lisp.h b/src/lisp.h
index f1b18c0be61..7fb7705dbf4 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4837,6 +4837,7 @@ LOADHIST_ATTACH (Lisp_Object x)
 extern void init_lread (void);
 extern void syms_of_lread (void);
 extern void mark_lread (void);
+extern Lisp_Object eval_stream(Lisp_Object stream, int *nexprs);
 
 INLINE Lisp_Object
 intern (const char *str)
diff --git a/src/lread.c b/src/lread.c
index 5453279a4af..24d74e16ee5 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3903,9 +3903,18 @@ readevalloop (Lisp_Object frameptr)
   return frame->value;
 }
 
+static void
+save_frame_nexprs (void *p)
+{
+  if (current_frame && p)
+    {
+      int *nexprs = p;
+      *nexprs = current_frame->nexprs;
+    }
+}
 
-static Lisp_Object
-enter_stream_readevalloop (Lisp_Object stream)
+Lisp_Object
+eval_stream (Lisp_Object stream, int *nexprs)
 {
   Lisp_Object val = Qnil;
   lread_frame this_frame = INIT_LREAD_FRAME();
@@ -3918,10 +3927,13 @@ enter_stream_readevalloop (Lisp_Object stream)
   init_lread_eval_params(&this_frame, Qnil, Qnil,
 			 Qnil, false);
   activate_lread_frame (&this_frame, LREAD_FRAME_INTEGRAL);
+  if (nexprs)
+    record_unwind_protect_ptr (save_frame_nexprs, nexprs);
   val = readevalloop_eof_trampoline (make_mint_ptr (&this_frame));
   return unbind_to (this_frame.loop_dynamic_frame, val);
 }
 
+
 static Lisp_Object
 enter_buffer_readevalloop (Lisp_Object buffer,
 			   Lisp_Object printflag,
@@ -3994,7 +4006,7 @@ DEFUN ("eval-stream", Feval_stream, Seval_stream, 1, 1, "",
 for any input stream argument.  */)
   (Lisp_Object stream)
 {
-  return enter_stream_readevalloop (stream);
+  return eval_stream (stream, NULL);
 }
 
 /* NB: the unibyte argument to eval-buffer used to set the load_convert_to_unibyte,
-- 
2.49.0

From f55f8b229ea9fbe33c9242e9d3a5d6a5eb28f134 Mon Sep 17 00:00:00 2001
From: Onnie Lynn Winebarger <[email-masked]>
Date: Mon, 7 Jul 2025 06:11:59 -0400
Subject: [PATCH 06/12] Apply reentrant reader patch for Feval_stream

---
 src/lread.c | 3926 ++++++++++++++++++++++++++++++++++++---------------
 1 file changed, 2800 insertions(+), 1126 deletions(-)

diff --git a/src/lread.c b/src/lread.c
index 40eb6ad7875..4a4b82f0f41 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -46,6 +46,7 @@ #define DEFINE_SYMBOLS
 #include "pdumper.h"
 #include <c-ctype.h>
 #include <vla.h>
+#include "systty.h"
 
 #ifdef MSDOS
 #include "msdos.h"
@@ -168,6 +169,252 @@ #define USE_ANDROID_ASSETS
 # endif
 #endif
 
+
+enum {
+  INFILE_BUFFER_SIZE = MAX_MULTIBYTE_LENGTH - 1
+};
+/* File and lookahead for get-file-char and get-emacs-mule-file-char
+   to read from.  Used by Fload.  */
+struct infile
+{
+  /* The input stream.  */
+  file_stream stream;
+
+  /* Lookahead byte count.  */
+  signed char lookahead;
+
+  /* Lookahead bytes, in reverse order.  Keep these here because it is
+     not portable to ungetc more than one byte at a time.  */
+  unsigned char buf[INFILE_BUFFER_SIZE];
+  /* is this seekable? */
+  bool seekable;
+  bool mule;
+  Lisp_Object coding;
+};
+
+struct instring
+{
+  Lisp_Object string;
+  ptrdiff_t start;
+  ptrdiff_t limit;
+};
+
+
+struct inbuffer
+{
+  Lisp_Object buffer;
+};
+
+struct inmarker
+{
+  struct inbuffer b;
+  Lisp_Object marker;
+};
+
+struct inproc
+{
+  Lisp_Object proc;
+};
+struct inindirect
+{
+  struct lread_frame *source;
+};
+
+typedef enum lread_input_type
+{
+  LREAD_INPUT_UNINIT,
+  LREAD_INPUT_FILE,
+  LREAD_INPUT_FILE_MULE,
+  LREAD_INPUT_STRING,
+  LREAD_INPUT_BUFFER,
+  LREAD_INPUT_MARKER,
+  LREAD_INPUT_PROCEDURE,
+  LREAD_INPUT_BINARY,
+  LREAD_INPUT_INDIRECT,
+  LREAD_INPUT_NULL
+} lread_input_type;
+
+#define VALID_INPUT_TYPE(in) ( ((in) >= LREAD_INPUT_UNINIT) && ((in) <= LREAD_INPUT_NULL) )
+
+#define FROM_FILE_P(arg)			\
+  ((arg) == LREAD_INPUT_FILE || (arg) == LREAD_INPUT_FILE_MULE)
+#define FROM_BUFFER_P(arg) ((arg) == LREAD_INPUT_BUFFER)
+#define FROM_MARKER_P(arg) ((arg) == LREAD_INPUT_MARKER)
+#define HAS_BUFFER_P(arg) ((FROM_BUFFER_P (arg)) || (FROM_MARKER_P (arg)))
+
+struct innull
+{
+};
+
+enum {
+  LREAD_INPUT_SIZE = MAX (MAX (sizeof (struct infile),
+			       sizeof (struct inmarker)),
+			  sizeof (struct instring))
+};
+typedef union lread_input
+{
+  unsigned char uninit[LREAD_INPUT_SIZE];
+  struct infile f;
+  struct instring s;
+  struct inbuffer b;
+  struct inmarker m;
+  struct inproc p;
+  struct inindirect frame;
+  struct innull n;
+} lread_input;
+
+#define INIT_LREAD_INPUT (lread_input) { .uninit  =  { 0 } }
+
+
+struct saved_string {
+  char *string;			/* string in allocated buffer */
+  ptrdiff_t size;		/* allocated size of buffer */
+  ptrdiff_t length;		/* length of string in buffer */
+  file_offset position;		/* position in file the string came from */
+};
+#define INIT_SAVED_STRING ((struct saved_string) { NULL, 0, 0, 0 })
+
+
+typedef enum lread_multibyte
+{
+  LREAD_MULTIBYTE_INDETERMINATE = -1, /* For resetting	*/
+  LREAD_MULTIBYTE_FALSE	 = 0,
+  LREAD_MULTIBYTE_TRUE	= 1
+} lread_multibyte;
+
+
+#define VALID_MULTIBYTE_MASK ((lread_multibyte) ~(1L))
+#define VALID_MULTIBYTE(m) ( ( (VALID_MULTIBYTE_MASK) & ( (lread_multibyte) m ) ) == ((lread_multibyte) 0) )
+/* The reference obarray for interning symbols established at initialization
+   only written to once.  */
+static Lisp_Object initial_obarray;
+
+static Lisp_Object make_obarray (unsigned bits);
+
+/* When an object is read, the type of the top read stack entry indicates
+   the syntactic context.  */
+enum read_entry_type
+{
+				/* preceding syntactic context */
+  RE_list_start,		/* "(" */
+
+  RE_list,			/* "(" (+ OBJECT) */
+  RE_list_dot,			/* "(" (+ OBJECT) "." */
+
+  RE_vector,			/* "[" (* OBJECT) */
+  RE_record,			/* "#s(" (* OBJECT) */
+  RE_char_table,		/* "#^[" (* OBJECT) */
+  RE_sub_char_table,		/* "#^^[" (* OBJECT) */
+  RE_byte_code,			/* "#[" (* OBJECT) */
+  RE_string_props,		/* "#(" (* OBJECT) */
+
+  RE_special,			/* "'" | "#'" | "`" | "," | ",@" */
+
+  RE_numbered,			/* "#" (+ DIGIT) "=" */
+};
+
+struct read_stack_entry
+{
+  enum read_entry_type type;
+  union {
+    /* RE_list, RE_list_dot */
+    struct {
+      Lisp_Object head;		/* first cons of list */
+      Lisp_Object tail;		/* last cons of list */
+    } list;
+
+    /* RE_vector, RE_record, RE_char_table, RE_sub_char_table,
+       RE_byte_code, RE_string_props */
+    struct {
+      Lisp_Object elems;	/* list of elements in reverse order */
+      bool old_locate_syms;	/* old value of locate_syms */
+    } vector;
+
+    /* RE_special */
+    struct {
+      Lisp_Object symbol;	/* symbol from special syntax */
+    } special;
+
+    /* RE_numbered */
+    struct {
+      Lisp_Object number;	/* number as a fixnum */
+      Lisp_Object placeholder;	/* placeholder object */
+    } numbered;
+  } u;
+};
+
+struct read_stack
+{
+  struct read_stack_entry *stack;  /* base of stack */
+  ptrdiff_t size;		   /* allocated size in entries */
+  ptrdiff_t sp;			   /* current number of entries */
+};
+
+#define INIT_READ_STACK {NULL, 0, 0}
+
+/* stdin is the only file descriptor for which nested reads are
+   expected to consume characters in a non-reentrant way
+   That is, a user providing input to a lisp program being "loaded"
+   from stdin should not expect that input to be read again as part
+   of that lisp program.
+   Closing and reopening stdin must reinitialize this data for this
+   to work.
+*/
+static struct lread_stdio_data
+{
+  struct infile s;
+  ptrdiff_t char_offset;
+  ptrdiff_t byte_offset;
+  int unread_char;
+  int unread_bytes;
+  bool read_eof;
+  bool multibyte;
+  Lisp_Object coding;
+} stdin_infile;
+
+
+/* Save all state to restore for read */
+/* i.e.  all static C variables Fread references	 */
+/* Should this include initial_obarray and oblookup_last_bucket_number? */
+typedef enum lread_frame_type
+{
+  LREAD_FRAME_UNINIT,
+  /* some form of "read" call*/
+  LREAD_FRAME_SINGLE,
+  /* readevalloop that does not hide changes to lisp state */
+  LREAD_FRAME_INTEGRAL,
+  /* readevalloop that hides changes to lisp state */
+  LREAD_FRAME_DYNAMIC_WIND
+} lread_frame_type;
+
+typedef struct lread_frame lread_frame;
+typedef int (*readonechar_func)(register lread_frame *);
+struct lread_frame
+{
+  lread_frame_type type;
+  lread_frame *prev;
+  lread_input_type intype;
+  lread_input input;
+  readonechar_func readonechar;
+  /* frame may require unwinding around interrupt processing/eval */
+  specpdl_ref dynamic_frame;
+  specpdl_ref restore_frame_idx;
+  /* When READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char,
+     we use this to keep an unread character because
+     a file stream can't handle multibyte-char unreading.  The value -1
+     means that there's no unread character.  */
+  int unread_char;
+  /* The number of bytes required to encode unread_char*/
+  int unread_bytes;
+  bool read_eof;
+  ptrdiff_t char_offset;
+  ptrdiff_t byte_offset;
+  struct saved_string saved_strings[2];
+  struct read_stack rdstack;
+  ptrdiff_t base_sp;
+  /* A list of file names for files being loaded in Fload.
+     Used to check for recursive loads */
+  Lisp_Object loads_in_progress;
 /* The objects or placeholders read with the #n=object form.
 
    A hash table maps a number to either a placeholder (while the
@@ -180,7 +427,7 @@ #define USE_ANDROID_ASSETS
    top-level calls to read0.  In between calls, it may be an empty
    hash table left unused from the previous call (to reduce
    allocations), or nil.  */
-static Lisp_Object read_objects_map;
+  Lisp_Object objects_map;
 
 /* The recursive objects read with the #n=object form.
 
@@ -197,59 +444,526 @@ #define USE_ANDROID_ASSETS
    hash table before all top-level calls to read0.  In between calls,
    it may be an empty hash table left unused from the previous call
    (to reduce allocations), or nil.  */
-static Lisp_Object read_objects_completed;
+  Lisp_Object objects_completed;
+  lread_multibyte multibyte;
+  bool locate_syms;
+  Lisp_Object start;
+  Lisp_Object end;
+  bool interrupted;
+  /* only set for emacs-mule encoded file, for last read character */
+  struct charset *mule_charset;
+  /* These are only used in MULTIPLE type frames*/
+  int nexprs;
+  specpdl_ref loop_dynamic_frame;
+  bool whole_buffer;
+  Lisp_Object full_name;
+  Lisp_Object name;
+  Lisp_Object sourcename;
+  Lisp_Object readfun;
+  bool printflag;
+  Lisp_Object value;
+  Lisp_Object error;
+  bool read_expr;
+};
 
-/* File and lookahead for get-file-char and get-emacs-mule-file-char
-   to read from.  Used by Fload.  */
-static struct infile
+#ifdef WRAP_SPECPDL_REF
+#define SPECPDL_REF_UNINIT (specpdl_ref) { -1 }
+#define UNINIT_SPECPDL_REF(r) ((r).bytes == -1)
+#else
+#defineSPECPDL_REF_UNINIT -1
+#define UNINIT_SPECPDL_REF(r) ((r) == -1)
+#endif
+
+#define INIT_LREAD_FRAME()	(lread_frame)				\
+  {									\
+    .type = LREAD_FRAME_UNINIT,						\
+      .intype = LREAD_INPUT_UNINIT,					\
+      .input = INIT_LREAD_INPUT,					\
+      .dynamic_frame = SPECPDL_REF_UNINIT,				\
+      .restore_frame_idx = SPECPDL_REF_UNINIT,				\
+      .unread_char = -1,						\
+      .unread_bytes = 0,						\
+      .read_eof = false,						\
+      .char_offset = 0,							\
+      .byte_offset = 0,							\
+      .saved_strings = { INIT_SAVED_STRING, INIT_SAVED_STRING },	\
+      .rdstack = INIT_READ_STACK,					\
+      .base_sp = 0,							\
+      .loads_in_progress = Qnil,					\
+      .objects_map = Qnil,						\
+      .objects_completed = Qnil,					\
+      .multibyte = LREAD_MULTIBYTE_INDETERMINATE,			\
+      .locate_syms = false,						\
+      .start = Qnil,							\
+      .end = Qnil,							\
+      .full_name = Qnil,						\
+      .name = Qnil,							\
+      .sourcename = Qnil,						\
+      .readfun = Qnil,							\
+      .printflag = false,						\
+      .nexprs = 0,							\
+      .loop_dynamic_frame = SPECPDL_REF_UNINIT,				\
+      .whole_buffer = false,						\
+      .value = Qnil,							\
+      .error = Qnil,							\
+      .interrupted = false,						\
+      .prev = NULL,							\
+      .read_expr = false,						\
+      .mule_charset = NULL						\
+    }
+
+/* This should be thread-local */
+static lread_frame *current_frame = NULL;
+static void init_lread_input_from_stream (lread_frame *frame,
+					  Lisp_Object stream,
+					  Lisp_Object start,
+					  Lisp_Object end,
+					  bool locate_syms,
+					  bool seekable,
+					  FILE *stream_file,
+					  Lisp_Object coding);
+
+static void init_lread_eval_params (lread_frame *frame,
+				    Lisp_Object full_name,
+				    Lisp_Object name,
+				    Lisp_Object readfun,
+				    bool whole_buffer);
+
+static void activate_lread_frame (lread_frame *new_frame, lread_frame_type new_type);
+static void restore_lread_frame (void *p);
+
+
+void unreadchar (register lread_frame *frame, int c);
+static AVOID invalid_syntax_lisp (register lread_frame *frame, Lisp_Object s);
+static AVOID invalid_syntax (register lread_frame *frame, const char *s);
+
+/* Keep track of which functions require a frame parameter
+   by declaring them here, whether it's needed or not */
+static int character_name_to_code (register lread_frame *frame,
+				   char const *name, ptrdiff_t name_len);
+static int read_char_escape (register lread_frame *frame, int next_char);
+static void invalid_radix_integer (register lread_frame *frame,
+				   EMACS_INT radix);
+static Lisp_Object read_integer (register lread_frame *frame, int radix);
+static Lisp_Object read_char_literal (register lread_frame *frame);
+static Lisp_Object read_string_literal (register lread_frame *frame);
+static Lisp_Object get_lazy_string (register lread_frame *frame,
+				    Lisp_Object val);
+static bool skip_lazy_string (register lread_frame *frame);
+static Lisp_Object bytecode_from_rev_list (register lread_frame *frame,
+					   Lisp_Object elems);
+
+static Lisp_Object char_table_from_rev_list (register lread_frame *frame,
+					     Lisp_Object elems);
+static Lisp_Object sub_char_table_from_rev_list (register lread_frame *frame,
+						 Lisp_Object elems);
+static Lisp_Object string_props_from_rev_list (register lread_frame *frame,
+					       Lisp_Object elems);
+static Lisp_Object read_bool_vector (register lread_frame *frame);
+static void skip_space_and_comments (register lread_frame *frame);
+static Lisp_Object read0 (register lread_frame *frame);
+
+static bool handle_read_stream_defaults (Lisp_Object *stream);
+static struct buffer *lread_get_buffer (register lread_frame *frame);
+static Lisp_Object lread_get_buffer_obj (register lread_frame *frame);
+
+
+static Lisp_Object readevalloop (Lisp_Object frameptr);
+static Lisp_Object readevalloop_eof_handler (Lisp_Object ignored);
+static Lisp_Object lread_set_read_eof (Lisp_Object data);
+static bool setup_buffer_for_readevalloop (register lread_frame *frame,
+					   Lisp_Object start, Lisp_Object end);
+static void prepare_buffer_for_interruptible_read (register lread_frame *frame,
+						   struct buffer *buf);
+static Lisp_Object readevalloop_eof_trampoline (Lisp_Object frameptr);
+
+static void build_load_history (register lread_frame *frame, Lisp_Object, bool);
+
+static ptrdiff_t obarray_index (struct Lisp_Obarray *oa, const char *str,
+				ptrdiff_t size_byte);
+static Lisp_Object oblookup_considering_shorthand (Lisp_Object, const char *,
+						   ptrdiff_t, ptrdiff_t,
+						   char **, ptrdiff_t *,
+						   ptrdiff_t *);
+
+/* Grow a read buffer BUF that contains OFFSET useful bytes of data,
+   by at least MAX_MULTIBYTE_LENGTH bytes.  Update *BUF_ADDR and
+   *BUF_SIZE accordingly; 0 <= OFFSET <= *BUF_SIZE.  If *BUF_ADDR is
+   initially null, BUF is on the stack: copy its data to the new heap
+   buffer.  Otherwise, BUF must equal *BUF_ADDR and can simply be
+   reallocated.  Either way, remember the heap allocation (which is at
+   pdl slot COUNT) so that it can be freed when unwinding the stack.*/
+
+static char *
+grow_read_buffer (char *buf, ptrdiff_t offset,
+		  char **buf_addr, ptrdiff_t *buf_size, specpdl_ref count)
 {
-  /* The input stream.  */
-  file_stream stream;
+  char *p = xpalloc (*buf_addr, buf_size, MAX_MULTIBYTE_LENGTH, -1, 1);
+  if (!*buf_addr)
+    {
+      memcpy (p, buf, offset);
+      record_unwind_protect_ptr (xfree, p);
+    }
+  else
+    set_unwind_protect_ptr (count, xfree, p);
+  *buf_addr = p;
+  return p;
+}
 
-  /* Lookahead byte count.  */
-  signed char lookahead;
+/* grow_read_buffer, but for ints (emacs character values) */
+static int *
+grow_int_buffer (int *buf, ptrdiff_t offset,
+		 int **buf_addr, ptrdiff_t *buf_size, specpdl_ref count)
+{
+  int *p = xpalloc (*buf_addr, buf_size, 1, -1, sizeof (int));
+  if (!*buf_addr)
+    {
+      memcpy (p, buf, offset * sizeof (int));
+      record_unwind_protect_ptr (xfree, p);
+    }
+  else
+    set_unwind_protect_ptr (count, xfree, p);
+  *buf_addr = p;
+  return p;
+}
 
-  /* Lookahead bytes, in reverse order.  Keep these here because it is
-     not portable to ungetc more than one byte at a time.  */
-  unsigned char buf[MAX_MULTIBYTE_LENGTH - 1];
-} *infile;
+INLINE void
+lread_unwind_for_eval (register lread_frame *frame)
+{
+  eassert (!UNINIT_SPECPDL_REF(frame->dynamic_frame));
+  unbind_to (frame->dynamic_frame, Qnil);
+}
 
-/* For use within read-from-string (this reader is non-reentrant!!)  */
-static ptrdiff_t read_from_string_index;
-static ptrdiff_t read_from_string_index_byte;
-static ptrdiff_t read_from_string_limit;
+INLINE void
+lread_init_dynamic_frame (register lread_frame *frame)
+{
+  eassert (UNINIT_SPECPDL_REF(frame->dynamic_frame));
+  frame->dynamic_frame = SPECPDL_INDEX ();
+}
 
-/* Position in object from which characters are being read by `readchar'.  */
-static EMACS_INT readchar_offset;
 
-struct saved_string {
-  char *string;		        /* string in allocated buffer */
-  ptrdiff_t size;		/* allocated size of buffer */
-  ptrdiff_t length;		/* length of string in buffer */
-  file_offset position;		/* position in file the string came from */
-};
+Lisp_Object
+lread_set_read_eof (Lisp_Object data)
+{
+  current_frame->read_eof = true;
+  return Qnil;
+}
+
+Lisp_Object
+readevalloop_eof_handler (Lisp_Object ignored)
+{
+  register lread_frame *frame = current_frame;
+  frame->read_eof = true;
+  return frame->value;
+}
+
+
+#define UNRECOGNIZED_LREAD_INPUT_CASES(src)	\
+    case LREAD_INPUT_UNINIT:\
+      xsignal1 (Qerror,\
+		CALLN (Fformat,\
+		       build_string ("Internal error: " src \
+				     ": type of input to "	    \
+				     "read(-*) uninitialized: %s"), \
+		       make_fixnum((EMACS_INT) frame->intype)));   \
+      break;\
+    default:\
+      xsignal1 (Qerror,\
+		CALLN (Fformat,\
+		       build_string ("Internal error:: " src \
+				     ": type of input to "		\
+				     "read(-*) unrecognized: %s"),	\
+		       make_fixnum((EMACS_INT) frame->intype)));
+
+
+static bool
+lread_frame_requires_rewind_buffer (register lread_frame *frame)
+{
+  switch (frame->intype)
+    {
+    case LREAD_INPUT_FILE:
+    case LREAD_INPUT_FILE_MULE:
+      return !(frame->input.f.seekable);
+    case LREAD_INPUT_PROCEDURE:
+      return true;
+    case LREAD_INPUT_INDIRECT:
+      return lread_frame_requires_rewind_buffer (frame->input.frame.source);
+    case LREAD_INPUT_BUFFER:
+    case LREAD_INPUT_MARKER:
+    case LREAD_INPUT_STRING:
+    case LREAD_INPUT_BINARY:
+    case LREAD_INPUT_NULL:
+      return false;
+      UNRECOGNIZED_LREAD_INPUT_CASES ("requires_rewind_buffer");
+    }
+}
+
+static void
+lread_rewind_input (register lread_frame *frame, int lookahead, int *buf)
+{
+  switch (frame->intype)
+    {
+    case LREAD_INPUT_FILE:
+    case LREAD_INPUT_FILE_MULE:
+      {
+	if (frame->input.f.seekable)
+	  {
+	    rewind (frame->input.f.stream);
+	  }
+	else if (buf)
+	  {
+	    /* At least try ungetc */
+	    unsigned char charbuf[MAX_MULTIBYTE_LENGTH] = {0};
+	    int len = 0;
+	    if (frame->multibyte)
+	      {
+		for (int i = lookahead -1; i >= 0; i--)
+		  {
+		    len = CHAR_STRING (buf[i], charbuf);
+		    for (int j = len - 1; j >= 0; j--)
+		      {
+			ungetc (charbuf[j], frame->input.f.stream);
+		      }
+		  }
+	      }
+	    else
+	      {
+		for (int i = lookahead -1; i >= 0; i--)
+		  {
+		    ungetc ((unsigned char) CHAR_TO_BYTE8(buf[i]), frame->input.f.stream);
+		  }
+	      }
+	  }
+	else
+	  {
+	    xsignal1 (Qerror,
+		      build_string ("Internal error: cannot rewind "
+			"non-seekable stream in read(-*)."));
+	  }
+      }
+      break;
+    case LREAD_INPUT_STRING:
+      {
+	frame->char_offset = frame->input.s.start;
+	frame->byte_offset
+	  = string_char_to_byte (frame->input.s.string,
+				 frame->input.s.start);
+      }
+      break;
+    case LREAD_INPUT_PROCEDURE:
+      {
+	if (buf)
+	  {
+	    for (int i = lookahead -1; i >= 0; i--)
+	      {
+		calln (frame->input.p.proc, make_fixnum (buf[i]));
+	      }
+	  }
+	else
+	  {
+	    xsignal1 (Qerror,
+		      build_string ("Internal error: cannot rewind "
+				    "read(-*) stream specified as "
+				    "by a function."));
+	  }
+      }
+      break;
+    case LREAD_INPUT_BUFFER:
+    case LREAD_INPUT_MARKER:
+      {
+	BUF_TEMP_SET_PT (XBUFFER (frame->input.b.buffer),
+			 BUF_BEGV (XBUFFER (frame->input.b.buffer)));
+      }
+      break;
+    case LREAD_INPUT_INDIRECT:
+      {
+	lread_frame *source = frame->input.frame.source;
+	lread_rewind_input (source, lookahead, buf);
+	frame->char_offset = source->char_offset;
+	frame->byte_offset = source->byte_offset;
+	frame->unread_char = source->unread_char;
+	frame->unread_bytes = source->unread_bytes;
+	frame->mule_charset = source->mule_charset;
+	return;
+      }
+      break;
+    case LREAD_INPUT_BINARY:
+    case LREAD_INPUT_NULL:
+      {
+	/* Nothing to do*/
+      }
+      break;
+      UNRECOGNIZED_LREAD_INPUT_CASES ("rewind_input");
+    }
+  frame->char_offset = 0;
+  frame->byte_offset = 0;
+}
 
-/* The last two strings skipped with #@ (most recent first).  */
-static struct saved_string saved_strings[2];
+static void
+init_infile (register lread_frame *frame,
+	     file_stream stream, bool seekable, bool mule,
+	     Lisp_Object coding)
+{
+  frame->input.f = (struct infile) { .stream = 0,
+				     .lookahead = 0,
+				     .buf =  { 0 },
+				     .seekable = false,
+				     .mule = false };
+  frame->input.f.stream = stream;
+  frame->input.f.seekable = seekable;
+  frame->input.f.mule = mule;
+  if (frame->input.f.seekable &&
+      (ftello (frame->input.f.stream) != 0))
+    {
+      fseeko (frame->input.f.stream, 0, SEEK_SET);
+    }
+  if (NILP (coding))
+    coding = Qno_conversion;
+  frame->input.f.coding = coding;
+  if (!VALID_MULTIBYTE (frame->multibyte))
+    {
+      CHECK_CODING_SYSTEM (frame->input.f.coding);
+      ptrdiff_t id = CODING_SYSTEM_ID (frame->input.f.coding);
+      frame->multibyte = NILP (CODING_ATTR_FOR_UNIBYTE (CODING_ID_ATTRS (id))) ?
+	LREAD_MULTIBYTE_TRUE : LREAD_MULTIBYTE_FALSE;
+    }
+}
 
-/* A list of file names for files being loaded in Fload.  Used to
-   check for recursive loads.  */
+static void
+init_instring (register lread_frame *frame,
+	       Lisp_Object string)
+{
+  ptrdiff_t startval, endval;
+  frame->input.s
+    = (struct instring) { .string = Qnil, .start = 0, .limit = 0 };
+
+  if (NILP (frame->start))
+    frame->start  = make_fixnum(0);
+  if (NILP (frame->end))
+    frame->end = make_fixnum (SCHARS (string));
+
+  CHECK_FIXNUM (frame->start);
+  CHECK_FIXNUM (frame->end);
+  frame->input.s.string = string;
+
+  validate_subarray (string, frame->start, frame->end, SCHARS (string),
+		     &startval, &endval);
+  frame->input.s.start = startval;
+  frame->input.s.limit = endval;
+  frame->char_offset = frame->input.s.start;
+  frame->byte_offset
+    = string_char_to_byte (frame->input.s.string,
+			   frame->input.s.start);
+  if (!VALID_MULTIBYTE (frame->multibyte))
+    frame->multibyte = STRING_MULTIBYTE (frame->input.s.string);
+}
 
-static Lisp_Object Vloads_in_progress;
+static void
+init_inbuffer (register lread_frame *frame,
+	       Lisp_Object buffer)
+{
+  struct buffer *buf = XBUFFER (buffer);
+  frame->input.b = (struct inbuffer) { .buffer = Qnil };
 
-static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
-                                 Lisp_Object);
+  if (NILP (frame->full_name))
+    {
+      frame->full_name =  BVAR (buf, filename);
+    }
+  if (!NILP (frame->name) && NILP (frame->full_name))
+    {
+      if (NILP (Ffile_name_absolute_p (frame->name)))
+	frame->full_name = Fexpand_file_name (frame->name, BVAR (buf, directory));
+      else
+	frame->full_name = frame->name;
+    }
+  if (NILP (frame->name) && !NILP (frame->full_name))
+    {
+      frame->name = Ffile_name_nondirectory (frame->full_name);
+    }
+  frame->input.b.buffer = buffer;
+  frame->char_offset = BUF_PT (buf);
+  frame->byte_offset = BUF_PT_BYTE (buf);
+  if (!VALID_MULTIBYTE (frame->multibyte))
+    frame->multibyte = ! NILP (BVAR (buf, enable_multibyte_characters));
+}
 
-static void readevalloop (Lisp_Object, struct infile *, Lisp_Object, bool,
-                          Lisp_Object, Lisp_Object,
-                          Lisp_Object, Lisp_Object);
+static void
+init_inmarker (register lread_frame *frame,
+	       Lisp_Object marker)
+{
+  init_inbuffer (frame, Fmarker_buffer(marker));
+  frame->input.m.marker = marker;
+  if (NILP (frame->start))
+    frame->start = marker;
+}
 
-static void build_load_history (Lisp_Object, bool);
+/* Determine multibyte */
+INLINE void
+report_lread_multibyte (register lread_frame *frame)
+{
+  /* Expect any interruption of read that might cause
+     a change in the coding to set the interrupted frame's
+     multibyte status to indeterminate.  Otherwise,
+     the coding of an input is required to remain constant
+     for the duration of a single call to read */
+  if (frame->multibyte != LREAD_MULTIBYTE_INDETERMINATE)
+    return;
+  switch (frame->intype)
+    {
+    case LREAD_INPUT_FILE:
+      {
+	frame->multibyte = LREAD_MULTIBYTE_TRUE;
+      }
+      break;
+    case LREAD_INPUT_FILE_MULE:
+      frame->multibyte = LREAD_MULTIBYTE_TRUE;
+      break;
+    case LREAD_INPUT_STRING:
+      {
+	frame->multibyte
+	  = (STRING_MULTIBYTE (frame->input.s.string))
+	  ? LREAD_MULTIBYTE_TRUE
+	  : LREAD_MULTIBYTE_FALSE;
+      }
+      break;
+    case LREAD_INPUT_PROCEDURE:
+      frame->multibyte = LREAD_MULTIBYTE_TRUE;
+      break;
+    case LREAD_INPUT_BUFFER:
+      {
+	struct buffer *inbuffer = XBUFFER (frame->input.b.buffer);
+	frame->multibyte
+	  = (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
+	  ? LREAD_MULTIBYTE_TRUE
+	  : LREAD_MULTIBYTE_FALSE;
+      }
+      break;
+    case LREAD_INPUT_MARKER:
+      {
+	struct buffer *inbuffer = XBUFFER (frame->input.m.b.buffer);
+	frame->multibyte
+	  = (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
+	  ? LREAD_MULTIBYTE_TRUE
+	  : LREAD_MULTIBYTE_FALSE;
+      }
+      break;
+    case LREAD_INPUT_INDIRECT:
+      report_lread_multibyte (frame->input.frame.source);
+      frame->multibyte = frame->input.frame.source->multibyte;
+      break;
+    case LREAD_INPUT_BINARY:
+	frame->multibyte = LREAD_MULTIBYTE_FALSE;
+	break;
+    case LREAD_INPUT_NULL:
+      {
+	/* Completely meaningless */
+	frame->multibyte = LREAD_MULTIBYTE_TRUE;
+      }
+      break;
+      UNRECOGNIZED_LREAD_INPUT_CASES("report_multibyte");
+    }
 
-static Lisp_Object oblookup_considering_shorthand (Lisp_Object, const char *,
-						   ptrdiff_t, ptrdiff_t,
-						   char **, ptrdiff_t *,
-						   ptrdiff_t *);
+}
 
 
 /* Function that reads one byte from the current source READCHARFUN
@@ -258,7 +972,80 @@ #define USE_ANDROID_ASSETS
    is 0 or positive, it unreads C, and the return value is not
    interesting.  */
 
-static int readbyte_from_file (int, Lisp_Object);
+
+static int readbyte_from_file (register lread_frame *frame);
+
+
+static int
+readbyte_from_stdio (register lread_frame *frame)
+{
+  if (frame->input.f.lookahead)
+    {
+      return (frame->input.f.buf[--(frame->input.f.lookahead)]);
+    }
+
+  int c;
+
+  block_input ();
+
+#if !defined USE_ANDROID_ASSETS
+
+  /* Interrupted reads have been observed while reading over the network.  */
+  while ((c = getc (frame->input.f.stream)) == EOF && errno == EINTR
+	 && ferror (frame->input.f.stream))
+    {
+      unblock_input ();
+      maybe_quit ();
+      block_input ();
+      clearerr (frame->input.f.stream);
+    }
+
+#else
+
+  {
+    char byte;
+    ssize_t rc;
+
+  retry:
+    rc = android_asset_read (frame->input.f.stream, &byte, 1);
+
+    if (rc == 0)
+      c = EOF;
+    else if (rc == -1)
+      {
+	if (errno == EINTR)
+	  {
+	    unblock_input ();
+	    maybe_quit ();
+	    block_input ();
+	    goto retry;
+	  }
+	else
+	  c = EOF;
+      }
+    else
+      c = (unsigned char) byte;
+  }
+
+#endif
+
+  unblock_input ();
+  if (c == EOF)
+    {
+      frame->read_eof = true;
+      c = -1;
+    }
+  return c;
+}
+
+static int
+readbyte_from_file (register lread_frame *frame)
+{
+  eassert (FROM_FILE_P (frame->intype) && (frame->input.f.stream));
+
+  return readbyte_from_stdio (frame);
+}
+
 
 /* Handle unreading and rereading of characters.
    Write READCHAR to read a character,
@@ -266,187 +1053,448 @@ #define USE_ANDROID_ASSETS
 
    These macros correctly read/unread multibyte characters.  */
 
-#define READCHAR readchar (readcharfun, NULL)
-#define UNREAD(c) unreadchar (readcharfun, c)
+#define READCHAR(frame) (frame->readonechar(frame))
+#define UNREAD(frame,c) unreadchar (frame, c)
+
+
+INLINE int
+get_emacs_mule_char_length (struct charset *cs, int c)
+{
+  int dimension = CHARSET_DIMENSION (cs);
+  unsigned code = ENCODE_CHAR (cs, c);
+  int sz;
+  for (sz = 0; dimension > 0 && (code & 0xFF); dimension--)
+    {
+      sz++;
+      code >>= 8;
+    }
+  return sz;
+}
+
+
+/* internal form of /dev/null */
+static int
+readchar_from_null (register lread_frame *frame)
+{
+  frame->read_eof = true;
+  return -1;
+}
+
+INLINE int
+handle_buffered_unread_character (register lread_frame *frame)
+{
+  int c = frame->unread_char;
+  frame->unread_char = -1;
+  frame->char_offset++;
+  frame->byte_offset += frame->unread_bytes;
+  frame->unread_bytes = 0;
+  return c;
+}
+
+INLINE int
+handle_readchar_eof (register lread_frame *frame)
+{
+  frame->read_eof = true;
+  return -1;
+}
+
+INLINE int
+handle_readchar_unibyte (register lread_frame *frame, int c)
+{
+  frame->char_offset++;
+  frame->byte_offset++;
+  return c;
+}
+
+/* Handle emacs-internal coding */
+static int
+readchar_from_multibyte_file (register lread_frame *frame)
+{
+  if (frame->unread_char >= 0)
+    return handle_buffered_unread_character (frame);
+  int c = readbyte_from_file (frame);
+  if (c < 0)
+    return handle_readchar_eof (frame);
+  if (ASCII_CHAR_P (c))
+    return handle_readchar_unibyte (frame, c);
+  int i = 0;
+  unsigned char buf[MAX_MULTIBYTE_LENGTH] = { 0 };
+  buf[i++] = c;
+  int len = BYTES_BY_CHAR_HEAD (c);
+  while (i < len)
+    {
+      buf[i++] = c = readbyte_from_file (frame);
+      if (c < 0 || ! TRAILING_CODE_P (c))
+	{
+	  for (i -= c < 0; 0 < --i; )
+	    frame->input.f.buf[frame->input.f.lookahead++] = buf[i];
+	  return BYTE8_TO_CHAR (buf[0]);
+	}
+    }
+  frame->char_offset++;
+  c = STRING_CHAR (buf);
+  frame->byte_offset += CHAR_BYTES(c);
+  return c;
+}
+
+static int
+readchar_from_unibyte_file (register lread_frame *frame)
+{
+  if (frame->unread_char >= 0)
+    return handle_buffered_unread_character (frame);
+  int c = readbyte_from_file (frame);
+  if (c < 0)
+    return handle_readchar_eof (frame);
+  return handle_readchar_unibyte (frame, c);
+}
+
+/* Read one non-ASCII character from INFILE.  The character is
+   encoded in `emacs-mule' and the first byte is already read in
+   C.  */
+
+static int
+readchar_from_mule_file (register lread_frame *frame)
+{
+  if (frame->unread_char >= 0)
+    return handle_buffered_unread_character (frame);
+  int c = readbyte_from_file (frame);
+  if (c < 0)
+    return handle_readchar_eof (frame);
+  if (ASCII_CHAR_P (c))
+    return handle_readchar_unibyte (frame, c);
+  /* Emacs-mule coding uses at most 4-byte for one character.  */
+  int len = emacs_mule_bytes[c];
+  struct charset *charset;
+  unsigned code;
+
+  if (len == 1)
+    /* C is not a valid leading-code of `emacs-mule'.  */
+    return BYTE8_TO_CHAR (c);
+
+  int i = 0;
+  unsigned char buf[4] = { 0 };
+  buf[i++] = c;
+  while (i < len)
+    {
+      buf[i++] = c = readbyte_from_file (frame);
+      if (c < 0xA0)
+	{
+	  for (i -= c < 0; 0 < --i; )
+	    frame->input.f.buf[frame->input.f.lookahead++] = buf[i];
+	  return BYTE8_TO_CHAR (buf[0]);
+	}
+    }
+
+  if (len == 2)
+    {
+      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
+      code = buf[1] & 0x7F;
+    }
+  else if (len == 3)
+    {
+      if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
+	  || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
+	{
+	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
+	  code = buf[2] & 0x7F;
+	}
+      else
+	{
+	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
+	  code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
+	}
+    }
+  else
+    {
+      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
+      code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
+    }
+  frame->mule_charset = charset;
+  c = DECODE_CHAR (charset, code);
+  if (c < 0)
+    invalid_syntax (frame, "invalid multibyte form");
+  return c;
+}
+
+static int
+readchar_from_multibyte_string (register lread_frame *frame)
+{
+  if (frame->char_offset >= frame->input.s.limit)
+    return handle_readchar_eof (frame);
+  int c = fetch_string_char_advance_no_check (frame->input.s.string,
+					      &(frame->char_offset),
+					      &(frame->byte_offset));
+  return c;
+}
+
+static int
+readchar_from_unibyte_string (register lread_frame *frame)
+{
+  if (frame->char_offset >= frame->input.s.limit)
+    return handle_readchar_eof (frame);
+  int c = SREF (frame->input.s.string, frame->byte_offset);
+  return handle_readchar_unibyte (frame, c);
+}
+
+
+INLINE struct buffer *
+readchar_from_buffer_start (register lread_frame *frame)
+{
+  struct buffer *inbuffer = XBUFFER (frame->input.b.buffer);
+  if (! BUFFER_LIVE_P (inbuffer))
+    return NULL;
+  frame->byte_offset = BUF_PT_BYTE (inbuffer);
+  if (frame->byte_offset >= BUF_ZV_BYTE (inbuffer))
+    return NULL;
+  return inbuffer;
+}
+
+INLINE int
+readchar_buffer_fetch_multibyte (register lread_frame *frame,
+				 struct buffer *inbuffer)
+{
+  /* Fetch the character code from the buffer.  */
+  unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, frame->byte_offset);
+  int clen;
+  int c = string_char_and_length (p, &clen);
+  frame->byte_offset += clen;
+  return c;
+}
+
+INLINE int
+readchar_buffer_fetch_unibyte (register lread_frame *frame,
+			       struct buffer *inbuffer)
+{
+  int c = BUF_FETCH_BYTE (inbuffer, frame->byte_offset);
+  c = UNIBYTE_TO_CHAR (c);
+  frame->byte_offset++;
+  return c;
+}
 
-/* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source.  */
-#define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
+INLINE void
+readchar_buffer_end (register lread_frame *frame, struct buffer *inbuffer)
+{
+  frame->char_offset = BUF_PT (inbuffer) + 1;
+  SET_BUF_PT_BOTH (inbuffer, frame->char_offset, frame->byte_offset);
+}
 
-/* When READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char,
-   we use this to keep an unread character because
-   a file stream can't handle multibyte-char unreading.  The value -1
-   means that there's no unread character.  */
-static int unread_char = -1;
+static int
+readchar_from_multibyte_buffer (register lread_frame *frame)
+{
+  struct buffer *inbuffer = readchar_from_buffer_start (frame);
+  if (inbuffer == NULL)
+    return handle_readchar_eof (frame);
+  int c = readchar_buffer_fetch_multibyte (frame, inbuffer);
+  readchar_buffer_end (frame, inbuffer);
+  return c;
+}
 
 static int
-readchar (Lisp_Object readcharfun, bool *multibyte)
+readchar_from_unibyte_buffer (register lread_frame *frame)
 {
-  Lisp_Object tem;
-  register int c;
-  int (*readbyte) (int, Lisp_Object);
-  unsigned char buf[MAX_MULTIBYTE_LENGTH];
-  int i, len;
-  bool emacs_mule_encoding = 0;
+  struct buffer *inbuffer = readchar_from_buffer_start (frame);
+  if (inbuffer == NULL)
+    return handle_readchar_eof (frame);
+  int c = readchar_buffer_fetch_unibyte (frame, inbuffer);
+  readchar_buffer_end (frame, inbuffer);
+  return c;
+}
 
-  if (multibyte)
-    *multibyte = 0;
+INLINE struct buffer *
+readchar_from_marker_start (register lread_frame *frame)
+{
+  struct buffer *inbuffer = XBUFFER ( (frame->input.m.b.buffer) );
+  if (! BUFFER_LIVE_P (inbuffer))
+    return NULL;
+  frame->byte_offset = marker_byte_position (frame->input.m.marker);
+  if (frame->byte_offset >= BUF_ZV_BYTE (inbuffer))
+    return NULL;
+  return inbuffer;
+}
 
-  readchar_offset++;
 
-  if (BUFFERP (readcharfun))
-    {
-      register struct buffer *inbuffer = XBUFFER (readcharfun);
+INLINE void
+readchar_marker_end (register lread_frame *frame)
+{
+  XMARKER (frame->input.m.marker)->bytepos = frame->byte_offset;
+  XMARKER (frame->input.m.marker)->charpos = ++(frame->char_offset);
+}
 
-      ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
 
-      if (! BUFFER_LIVE_P (inbuffer))
-	return -1;
+static int
+readchar_from_multibyte_marker (register lread_frame *frame)
+{
+  struct buffer *inbuffer = readchar_from_marker_start (frame);
+  if (inbuffer == NULL)
+    return handle_readchar_eof (frame);
+  int c = readchar_buffer_fetch_multibyte (frame, inbuffer);
+  readchar_marker_end (frame);
+  return c;
+}
 
-      if (pt_byte >= BUF_ZV_BYTE (inbuffer))
-	return -1;
+static int
+readchar_from_unibyte_marker (register lread_frame *frame)
+{
+  struct buffer *inbuffer = readchar_from_marker_start (frame);
+  if (inbuffer == NULL)
+    return handle_readchar_eof (frame);
+  int c = readchar_buffer_fetch_unibyte (frame, inbuffer);
+  readchar_marker_end (frame);
+  return c;
+}
 
-      if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
-	{
-	  /* Fetch the character code from the buffer.  */
-	  unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
-	  int clen;
-	  c = string_char_and_length (p, &clen);
-	  pt_byte += clen;
-	  if (multibyte)
-	    *multibyte = 1;
-	}
-      else
-	{
-	  c = BUF_FETCH_BYTE (inbuffer, pt_byte);
-	  if (! ASCII_CHAR_P (c))
-	    c = BYTE8_TO_CHAR (c);
-	  pt_byte++;
-	}
-      SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
+static int
+readchar_from_multibyte_procedure (register lread_frame *frame)
+{
+  if (frame->unread_char >= 0)
+    return handle_buffered_unread_character (frame);
+  Lisp_Object tem = call0 (frame->input.p.proc);
+  int c = (!FIXNUMP (tem)) ? -1 : XFIXNUM(tem);
+  if (c == -1)
+    return handle_readchar_eof (frame);
+  frame->char_offset++;
+  /* Just approximate byte count as if it were coded in emacs-internal */
+  frame->byte_offset += CHAR_BYTES(c);
+  return c;
+}
 
-      return c;
-    }
-  if (MARKERP (readcharfun))
-    {
-      register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
+static int
+readchar_from_indirect (register lread_frame *frame)
+{
+  lread_frame *source = frame->input.frame.source;
+  int c;
+  c = READCHAR (source);
+  frame->char_offset = source->char_offset;
+  frame->byte_offset = source->byte_offset;
+  frame->mule_charset = source->mule_charset;
+  frame->unread_char = source->unread_char;
+  frame->unread_bytes = source->unread_bytes;
+  frame->read_eof = source->read_eof;
+  return c;
+}
 
-      ptrdiff_t bytepos = marker_byte_position (readcharfun);
+/* define some useful case constants */
+enum {
+  UNIBYTE_FILE = LREAD_INPUT_FILE << 1 | LREAD_MULTIBYTE_FALSE,
+  MULTIBYTE_FILE = LREAD_INPUT_FILE << 1 | LREAD_MULTIBYTE_TRUE,
+  UNIBYTE_FILE_MULE = LREAD_INPUT_FILE_MULE << 1 | LREAD_MULTIBYTE_FALSE,
+  MULTIBYTE_FILE_MULE = LREAD_INPUT_FILE_MULE << 1 | LREAD_MULTIBYTE_TRUE,
+  UNIBYTE_STRING = LREAD_INPUT_STRING << 1 | LREAD_MULTIBYTE_FALSE,
+  MULTIBYTE_STRING = LREAD_INPUT_STRING << 1 | LREAD_MULTIBYTE_TRUE,
+  UNIBYTE_BUFFER = LREAD_INPUT_BUFFER << 1 | LREAD_MULTIBYTE_FALSE,
+  MULTIBYTE_BUFFER = LREAD_INPUT_BUFFER << 1 | LREAD_MULTIBYTE_TRUE,
+  UNIBYTE_MARKER = LREAD_INPUT_MARKER << 1 | LREAD_MULTIBYTE_FALSE,
+  MULTIBYTE_MARKER = LREAD_INPUT_MARKER << 1 | LREAD_MULTIBYTE_TRUE,
+  UNIBYTE_PROCEDURE = LREAD_INPUT_PROCEDURE << 1 | LREAD_MULTIBYTE_FALSE,
+  MULTIBYTE_PROCEDURE = LREAD_INPUT_PROCEDURE << 1 | LREAD_MULTIBYTE_TRUE,
+  UNIBYTE_BINARY = LREAD_INPUT_BINARY << 1 | LREAD_MULTIBYTE_FALSE,
+  MULTIBYTE_BINARY = LREAD_INPUT_BINARY << 1 | LREAD_MULTIBYTE_TRUE,
+  UNIBYTE_INDIRECT = LREAD_INPUT_INDIRECT << 1 | LREAD_MULTIBYTE_FALSE,
+  MULTIBYTE_INDIRECT = LREAD_INPUT_INDIRECT << 1 | LREAD_MULTIBYTE_TRUE,
+  UNIBYTE_NULL = LREAD_INPUT_NULL << 1 | LREAD_MULTIBYTE_FALSE,
+  MULTIBYTE_NULL = LREAD_INPUT_NULL << 1 | LREAD_MULTIBYTE_TRUE
+};
 
-      if (bytepos >= BUF_ZV_BYTE (inbuffer))
-	return -1;
+static readonechar_func readonechar_tbl[MULTIBYTE_NULL + 1] =
+  {
+    NULL,
+    [UNIBYTE_FILE] = readchar_from_unibyte_file,
+    [MULTIBYTE_FILE] = readchar_from_multibyte_file,
+    [UNIBYTE_FILE_MULE] = NULL,
+    [MULTIBYTE_FILE_MULE] = readchar_from_mule_file,
+    [UNIBYTE_STRING] = readchar_from_unibyte_string,
+    [MULTIBYTE_STRING] = readchar_from_multibyte_string,
+    [UNIBYTE_BUFFER] = readchar_from_unibyte_buffer,
+    [MULTIBYTE_BUFFER] = readchar_from_multibyte_buffer,
+    [UNIBYTE_MARKER] = readchar_from_unibyte_marker,
+    [MULTIBYTE_MARKER] = readchar_from_multibyte_marker,
+    [UNIBYTE_PROCEDURE] = NULL,
+    [MULTIBYTE_PROCEDURE] = readchar_from_multibyte_procedure,
+    [UNIBYTE_INDIRECT] = readchar_from_indirect,
+    [MULTIBYTE_INDIRECT] = readchar_from_indirect,
+    [UNIBYTE_NULL] = readchar_from_null,
+    [MULTIBYTE_NULL] = readchar_from_null
+  };
 
-      if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
-	{
-	  /* Fetch the character code from the buffer.  */
-	  unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
-	  int clen;
-	  c = string_char_and_length (p, &clen);
-	  bytepos += clen;
-	  if (multibyte)
-	    *multibyte = 1;
-	}
+static void
+initialize_readonechar (register lread_frame *frame)
+{
+ retry:
+  if (VALID_MULTIBYTE (frame->multibyte))
+    {
+      if (VALID_INPUT_TYPE (frame->intype))
+	frame->readonechar = readonechar_tbl[(frame->intype << 1) | frame->multibyte];
       else
-	{
-	  c = BUF_FETCH_BYTE (inbuffer, bytepos);
-	  if (! ASCII_CHAR_P (c))
-	    c = BYTE8_TO_CHAR (c);
-	  bytepos++;
-	}
-
-      XMARKER (readcharfun)->bytepos = bytepos;
-      XMARKER (readcharfun)->charpos++;
-
-      return c;
+	xsignal1 (Qerror,
+		  CALLN (Fformat,
+			 build_string ("Invalid input type for read(-*): %S"),
+			 make_fixnum(frame->intype)));
     }
-
-  if (EQ (readcharfun, Qget_file_char))
+  else
     {
-      eassert (infile);
-      readbyte = readbyte_from_file;
-      goto read_multibyte;
+      report_lread_multibyte(frame);
+      if (VALID_MULTIBYTE (frame->multibyte))
+	goto retry;
+      xsignal1 (Qerror,
+		build_string ("Internal error: multibyte-ness of "
+			      "input to read(-*) could not be "
+			      "determined"));
     }
+  if (!frame->readonechar)
+    xsignal1 (Qerror,
+	      CALLN (Fformat,
+		     build_string ("Invalid readonechar function "
+				   "for read(-*): input type %S, "
+				   "multibyte %S"),
+		     make_fixnum(frame->intype), make_fixnum(frame->multibyte)));
+}
 
-  if (STRINGP (readcharfun))
+DEFUN ("reader-input-stream",
+       Freader_input_stream, Sreader_input_stream, 0, 1, 0,
+       doc: /* Read CHARACTER from current reader stream.
+Only for internal use.*/)
+  (Lisp_Object character)
+{
+  register lread_frame *frame = current_frame;
+  int c;
+  if (NILP (character))
+    c = -1;
+  else if (CHARACTERP (character))
+    c = XFIXNUM (character);
+  else
+    xsignal1 (Qerror,
+	      CALLN (Fformat,
+		     build_string ("reader-input-stream: "
+				   "argument not a character: '%s'"),
+		     character));
+  if (frame && frame->readonechar)
     {
-      if (read_from_string_index >= read_from_string_limit)
-	c = -1;
-      else if (STRING_MULTIBYTE (readcharfun))
+      if (c >= 0)
 	{
-	  if (multibyte)
-	    *multibyte = 1;
-	  c = (fetch_string_char_advance_no_check
-	       (readcharfun,
-		&read_from_string_index,
-		&read_from_string_index_byte));
+	  UNREAD (frame, c);
 	}
       else
-	{
-	  c = SREF (readcharfun, read_from_string_index_byte);
-	  read_from_string_index++;
-	  read_from_string_index_byte++;
-	}
-      return c;
+	c = READCHAR (frame);
     }
-
-  if (EQ (readcharfun, Qget_emacs_mule_file_char))
-    {
-      readbyte = readbyte_from_file;
-      eassert (infile);
-      emacs_mule_encoding = 1;
-      goto read_multibyte;
-    }
-
-  tem = call0 (readcharfun);
-
-  if (!FIXNUMP (tem))
-    return -1;
-  return XFIXNUM (tem);
-
- read_multibyte:
-  if (unread_char >= 0)
-    {
-      c = unread_char;
-      unread_char = -1;
-      return c;
-    }
-  c = (*readbyte) (-1, readcharfun);
-  if (c < 0)
-    return c;
-  if (multibyte)
-    *multibyte = 1;
-  if (ASCII_CHAR_P (c))
-    return c;
-  if (emacs_mule_encoding)
-    return read_emacs_mule_char (c, readbyte, readcharfun);
-  i = 0;
-  buf[i++] = c;
-  len = BYTES_BY_CHAR_HEAD (c);
-  while (i < len)
+  else
     {
-      buf[i++] = c = (*readbyte) (-1, readcharfun);
-      if (c < 0 || ! TRAILING_CODE_P (c))
-	{
-	  for (i -= c < 0; 0 < --i; )
-	    (*readbyte) (buf[i], readcharfun);
-	  return BYTE8_TO_CHAR (buf[0]);
-	}
+      xsignal1 (Qerror,
+		build_string ("reader-input-stream: reader not active"));
     }
-  return STRING_CHAR (buf);
+  return (make_fixnum (c));
 }
 
-#define FROM_FILE_P(readcharfun)			\
-  (EQ (readcharfun, Qget_file_char)			\
-   || EQ (readcharfun, Qget_emacs_mule_file_char))
-
 static void
-skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
+skip_dyn_bytes (register lread_frame *frame, ptrdiff_t n)
 {
-  if (FROM_FILE_P (readcharfun))
+  if (FROM_FILE_P (frame->intype) && !frame->multibyte)
     {
       block_input ();		/* FIXME: Not sure if it's needed.  */
-      file_seek (infile->stream, n - infile->lookahead, SEEK_CUR);
+      file_seek (frame->input.f.stream, n - frame->input.f.lookahead, SEEK_CUR);
+      frame->char_offset += n;
+      frame->byte_offset += n;
       unblock_input ();
-      infile->lookahead = 0;
+      frame->input.f.lookahead = 0;
     }
   else
     { /* We're not reading directly from a file.  In that case, it's difficult
@@ -457,153 +1505,204 @@ skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
 	 that \037 is the final char.  */
       int c;
       do {
-	c = READCHAR;
+	c = READCHAR (frame);
       } while (c >= 0 && c != '\037');
     }
 }
 
 static void
-skip_dyn_eof (Lisp_Object readcharfun)
+skip_dyn_eof (register lread_frame *frame)
 {
-  if (FROM_FILE_P (readcharfun))
+  if (FROM_FILE_P (frame->intype) && !frame->multibyte)
     {
       block_input ();		/* FIXME: Not sure if it's needed.  */
-      file_seek (infile->stream, 0, SEEK_END);
+      ptrdiff_t n = file_tell (frame->input.f.stream);
+      file_seek (frame->input.f.stream, 0, SEEK_END);
+      n = file_tell (frame->input.f.stream) - n;
+      frame->char_offset += n;
+      frame->byte_offset += n;
       unblock_input ();
-      infile->lookahead = 0;
+      frame->input.f.lookahead = 0;
+      frame->read_eof = true;
     }
   else
-    while (READCHAR >= 0);
+    while (READCHAR (frame) >= 0);
 }
 
-/* Unread the character C in the way appropriate for the stream READCHARFUN.
-   If the stream is a user function, call it with the char as argument.  */
-
-static void
-unreadchar (Lisp_Object readcharfun, int c)
+void
+unreadchar (register lread_frame *frame,int c)
 {
-  readchar_offset--;
-  if (c == -1)
-    /* Don't back up the pointer if we're unreading the end-of-input mark,
-       since readchar didn't advance it when we read it.  */
-    ;
-  else if (BUFFERP (readcharfun))
-    {
-      struct buffer *b = XBUFFER (readcharfun);
-      ptrdiff_t charpos = BUF_PT (b);
-      ptrdiff_t bytepos = BUF_PT_BYTE (b);
-
-      if (! NILP (BVAR (b, enable_multibyte_characters)))
-	bytepos -= buf_prev_char_len (b, bytepos);
-      else
-	bytepos--;
-
-      SET_BUF_PT_BOTH (b, charpos - 1, bytepos);
-    }
-  else if (MARKERP (readcharfun))
-    {
-      struct buffer *b = XMARKER (readcharfun)->buffer;
-      ptrdiff_t bytepos = XMARKER (readcharfun)->bytepos;
-
-      XMARKER (readcharfun)->charpos--;
-      if (! NILP (BVAR (b, enable_multibyte_characters)))
-	bytepos -= buf_prev_char_len (b, bytepos);
-      else
-	bytepos--;
-
-      XMARKER (readcharfun)->bytepos = bytepos;
-    }
-  else if (STRINGP (readcharfun))
-    {
-      read_from_string_index--;
-      read_from_string_index_byte
-	= string_char_to_byte (readcharfun, read_from_string_index);
-    }
-  else if (FROM_FILE_P (readcharfun))
+  if (c < 0)
+    return;
+  switch (frame->intype)
     {
-      unread_char = c;
+    case LREAD_INPUT_FILE:
+      {
+	frame->unread_char = c;
+	frame->char_offset--;
+	if (frame->multibyte)
+	  {
+	    frame->unread_bytes = CHAR_BYTES(c);
+	    frame->byte_offset -= frame->unread_bytes;
+	  }
+	else
+	  {
+	    frame->unread_bytes = 1;
+	    frame->byte_offset--;
+	  }
+      }
+      break;
+    case LREAD_INPUT_FILE_MULE:
+      {
+	frame->unread_char = c;
+	frame->char_offset--;
+	frame->unread_bytes
+	  = get_emacs_mule_char_length (frame->mule_charset, c);
+	frame->byte_offset -= frame->unread_bytes;
+      }
+      break;
+    case LREAD_INPUT_STRING:
+      {
+	frame->char_offset--;
+	frame->byte_offset -= frame->multibyte ? CHAR_BYTES (c) : 1;
+      }
+      break;
+    case LREAD_INPUT_PROCEDURE:
+      {
+	calln (frame->input.p.proc, make_fixnum (c));
+	frame->char_offset--;
+	frame->byte_offset -= CHAR_BYTES(c);
+      }
+      break;
+    case LREAD_INPUT_BUFFER:
+      {
+	struct buffer *b = XBUFFER (frame->input.b.buffer);
+	frame->char_offset = BUF_PT (b);
+	frame->byte_offset = BUF_PT_BYTE (b);
+	if (frame->multibyte)
+	  frame->byte_offset -= buf_prev_char_len (b, frame->byte_offset);
+	else
+	  frame->byte_offset--;
+	frame->char_offset--;
+	SET_BUF_PT_BOTH (b, frame->char_offset, frame->byte_offset);
+      }
+      break;
+    case LREAD_INPUT_MARKER:
+      {
+	struct buffer *b = XMARKER (frame->input.m.marker)->buffer;
+	frame->byte_offset = XMARKER (frame->input.m.marker)->bytepos;
+	frame->char_offset = --(XMARKER (frame->input.m.marker)->charpos);
+	if (frame->multibyte)
+	  frame->byte_offset -= buf_prev_char_len (b, frame->byte_offset);
+	else
+	  frame->byte_offset--;
+	XMARKER (frame->input.m.marker)->bytepos = frame->byte_offset;
+      }
+      break;
+    case LREAD_INPUT_BINARY:
+    case LREAD_INPUT_NULL:
+      break;
+    case LREAD_INPUT_INDIRECT:
+      unreadchar (frame->input.frame.source, c);
+      break;
+      UNRECOGNIZED_LREAD_INPUT_CASES("unreadchar")
     }
-  else
-    calln (readcharfun, make_fixnum (c));
 }
 
-static int
-readbyte_from_stdio (void)
-{
-  if (infile->lookahead)
-    return infile->buf[--infile->lookahead];
-
-  int c;
-  file_stream instream = infile->stream;
-
-  block_input ();
-
-#if !defined USE_ANDROID_ASSETS
+/* Make sure the file stream eats the final unreadchar
+   after a read operation that won't be continued,
+   i.e.  in a single operation */
 
-  /* Interrupted reads have been observed while reading over the network.  */
-  while ((c = getc (instream)) == EOF && errno == EINTR && ferror (instream))
+static void
+closing_unreadchar (register lread_frame *frame)
+{
+  switch (frame->intype)
     {
-      unblock_input ();
-      maybe_quit ();
-      block_input ();
-      clearerr (instream);
-    }
-
-#else
-
-  {
-    char byte;
-    ssize_t rc;
-
-  retry:
-    rc = android_asset_read (instream, &byte, 1);
-
-    if (rc == 0)
-      c = EOF;
-    else if (rc == -1)
+    case LREAD_INPUT_PROCEDURE:
+    case LREAD_INPUT_BUFFER:
+    case LREAD_INPUT_MARKER:
+    case LREAD_INPUT_STRING:
+    case LREAD_INPUT_BINARY:
+    case LREAD_INPUT_NULL:
+      break;
+    case LREAD_INPUT_FILE:
+    case LREAD_INPUT_FILE_MULE:
       {
-	if (errno == EINTR)
+	/* always put back any loose bytes that have been peeked
+	   but not part of a character consumed by read0 */
+	for (int i = frame->input.f.lookahead-1; i >= 0; i--)
 	  {
-	    unblock_input ();
-	    maybe_quit ();
-	    block_input ();
-	    goto retry;
+	    ungetc (frame->input.f.buf[i], frame->input.f.stream);
+	  }
+	frame->input.f.lookahead = 0;
+	/* Then any character that has been unread
+	   has to be turned into a byte
+	   encoding and returned */
+	if (frame->unread_char >= 0)
+	  {
+	    int c = frame->unread_char;
+	    int dim = frame->unread_bytes;
+	    unsigned char buf[MAX_MULTIBYTE_LENGTH];
+	    frame->unread_char = -1;
+	    frame->unread_bytes = 0;
+	    if (frame->multibyte && !frame->input.f.mule)
+	      {
+		/* only emacs-internal coding allowed
+		   for actual multibyte file streams
+		   Only case is reading from standard
+		   input in non-editor mode.
+		*/
+		int len = CHAR_STRING (c, buf);
+		eassume (len == dim);
+		for (int i = (len - 1); i >= 0; i--)
+		  ungetc (buf[i], frame->input.f.stream);
+	      }
+	    else if (!frame->multibyte)
+	      {
+		/* unibyte */
+	      }
+	    else
+	      {
+		/* emacs-mule encoding
+		   Least likely case last */
+		int sz = CHARSET_DIMENSION (frame->mule_charset);
+		unsigned code = ENCODE_CHAR (frame->mule_charset, c);
+		int len;
+		for (len = 0; sz > 0 && (code & 0xFF); sz--)
+		  {
+		    buf[len++] = (unsigned char) (code & 0xFF);
+		    code >>= 8;
+		  }
+		eassume (len == dim);
+		for (int i = (len - 1); i >= 0; i--)
+		  ungetc (buf[i], frame->input.f.stream);
+	      }
 	  }
-	else
-	  c = EOF;
       }
-    else
-      c = (unsigned char) byte;
-  }
-
-#endif
-
-  unblock_input ();
-
-  return (c == EOF ? -1 : c);
-}
+      break;
+    case LREAD_INPUT_INDIRECT:
+      {
+	lread_frame *source = frame->input.frame.source;
+	closing_unreadchar (source);
+	frame->char_offset = source->char_offset;
+	frame->byte_offset = source->byte_offset;
+	frame->unread_char = source->unread_char;
+	frame->unread_bytes = source->unread_bytes;
+	frame->mule_charset = source->mule_charset;
+      }
+      break;
 
-static int
-readbyte_from_file (int c, Lisp_Object readcharfun)
-{
-  eassert (infile);
-  if (c >= 0)
-    {
-      eassert (infile->lookahead < sizeof infile->buf);
-      infile->buf[infile->lookahead++] = c;
-      return 0;
+      UNRECOGNIZED_LREAD_INPUT_CASES("closing_unreadchar");
     }
-
-  return readbyte_from_stdio ();
 }
-
 /* Signal Qinvalid_read_syntax error.
    S is error string of length N (if > 0)  */
 
-static AVOID
-invalid_syntax_lisp (Lisp_Object s, Lisp_Object readcharfun)
+AVOID
+invalid_syntax_lisp (register lread_frame *frame, Lisp_Object s)
 {
-  if (BUFFERP (readcharfun))
+ retry:
+  if (HAS_BUFFER_P (frame->intype))
     {
       ptrdiff_t line, column;
 
@@ -612,7 +1711,7 @@ invalid_syntax_lisp (Lisp_Object s, Lisp_Object readcharfun)
 	specpdl_ref count = SPECPDL_INDEX ();
 
 	record_unwind_protect_excursion ();
-	set_buffer_internal (XBUFFER (readcharfun));
+	set_buffer_internal (lread_get_buffer(frame));
 	line = count_lines (BEGV_BYTE, PT_BYTE) + 1;
 	column = current_column ();
 	unbind_to (count, Qnil);
@@ -621,79 +1720,26 @@ invalid_syntax_lisp (Lisp_Object s, Lisp_Object readcharfun)
       xsignal (Qinvalid_read_syntax,
 	       list3 (s, make_fixnum (line), make_fixnum (column)));
     }
-  else
-    xsignal1 (Qinvalid_read_syntax, s);
-}
-
-static AVOID
-invalid_syntax (const char *s, Lisp_Object readcharfun)
-{
-  invalid_syntax_lisp (build_string (s), readcharfun);
-}
-
-
-/* Read one non-ASCII character from INFILE.  The character is
-   encoded in `emacs-mule' and the first byte is already read in
-   C.  */
-
-static int
-read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun)
-{
-  /* Emacs-mule coding uses at most 4-byte for one character.  */
-  unsigned char buf[4];
-  int len = emacs_mule_bytes[c];
-  struct charset *charset;
-  int i;
-  unsigned code;
-
-  if (len == 1)
-    /* C is not a valid leading-code of `emacs-mule'.  */
-    return BYTE8_TO_CHAR (c);
-
-  i = 0;
-  buf[i++] = c;
-  while (i < len)
-    {
-      buf[i++] = c = (*readbyte) (-1, readcharfun);
-      if (c < 0xA0)
-	{
-	  for (i -= c < 0; 0 < --i; )
-	    (*readbyte) (buf[i], readcharfun);
-	  return BYTE8_TO_CHAR (buf[0]);
-	}
-    }
-
-  if (len == 2)
-    {
-      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
-      code = buf[1] & 0x7F;
-    }
-  else if (len == 3)
-    {
-      if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
-	  || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
-	{
-	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
-	  code = buf[2] & 0x7F;
-	}
-      else
-	{
-	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
-	  code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
-	}
-    }
-  else
+  else if (frame->intype == LREAD_INPUT_INDIRECT
+      && frame->input.frame.source && frame != frame->input.frame.source)
     {
-      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
-      code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
+      /* Shut up infinite recursion warning */
+      frame = frame->input.frame.source;
+      goto retry;
     }
-  c = DECODE_CHAR (charset, code);
-  if (c < 0)
-    invalid_syntax ("invalid multibyte form", readcharfun);
-  return c;
+  else
+    xsignal1 (Qinvalid_read_syntax, s);
+}
+
+AVOID
+invalid_syntax (register lread_frame *frame, const char *s)
+{
+  invalid_syntax_lisp (frame, build_string (s));
 }

+
+
 /* An in-progress substitution of OBJECT for PLACEHOLDER.  */
 struct subst
 {
@@ -708,13 +1754,10 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea
   Lisp_Object seen;
 };
 
-static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
-                                        Lisp_Object, bool);
-static Lisp_Object read0 (Lisp_Object, bool);
-
 static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object);
 static void substitute_in_interval (INTERVAL, void *);
 
+
 
 /* Get a character from the tty.  */
 
@@ -988,42 +2031,63 @@ DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3,
   Cookie_Lex			/* explicit lexical binding */
 } lexical_cookie_t;
 
-/* Determine if the lisp code read using READCHARFUN defines a
-   `lexical-binding' file variable return its value.
-   After returning, the stream is positioned following the first line,
-   if it is a comment or #! line, otherwise nothing is read.  */
+/* Determine if the lisp code read from the input of FRAME defines a
+   `lexical-binding' file variable return its value.  */
 
 static lexical_cookie_t
-lisp_file_lexical_cookie (Lisp_Object readcharfun)
+lisp_file_lexical_cookie (register lread_frame *frame)
 {
-  int ch = READCHAR;
-
+  specpdl_ref count = SPECPDL_INDEX ();
+  /* hold an 80-column lines because of automatic adding of cookie
+     at end of first line, which may already be 80 characters or more */
+  int stack_buffer[80] = { 0 };
+  int *heapbuf = NULL;
+  bool needs_buffer = lread_frame_requires_rewind_buffer (frame);
+  int *buf = needs_buffer ? stack_buffer : NULL;
+  ptrdiff_t buf_sz = needs_buffer ? sizeof stack_buffer : 0;
+  int lookahead = 0;
+  int *p = buf;
+  int *end = buf + buf_sz;
+  /* Allow the cookie anywhere in a leading comment block,
+     not just the first line.  */
+  lexical_cookie_t rv = Cookie_None;
+  int ch = -1;
+#define COOKIE_READ_AND_BUFFER(c)					\
+  c = READCHAR (frame);							\
+  if (c < 0)								\
+    goto not_found;							\
+  if (needs_buffer)							\
+    {									\
+      *p++ = c;								\
+      if (end - p < 2)							\
+	{								\
+	  lookahead = p - buf;						\
+	  buf = grow_int_buffer (buf, lookahead,			\
+				 &heapbuf, &buf_sz,			\
+				 count);				\
+	  p = buf + lookahead;						\
+	  end = buf + buf_sz;						\
+	}								\
+    }
+  COOKIE_READ_AND_BUFFER (ch);
   if (ch == '#')
     {
-      ch = READCHAR;
+      COOKIE_READ_AND_BUFFER (ch);
       if (ch != '!')
-        {
-          UNREAD (ch);
-          UNREAD ('#');
-          return Cookie_None;
-        }
+	goto not_found;
       while (ch != '\n' && ch != EOF)
-        ch = READCHAR;
-      if (ch == '\n') ch = READCHAR;
+	{
+	  COOKIE_READ_AND_BUFFER (ch);
+	}
+      if (ch == '\n')
+	goto not_found;
       /* It is OK to leave the position after a #! line, since
 	 that is what read0 does.  */
     }
 
-  if (ch != ';')
-    /* The first line isn't a comment, just give up.  */
-    {
-      UNREAD (ch);
-      return Cookie_None;
-    }
-  else
+  if (ch == ';')
     /* Look for an appropriate file-variable in the first line.  */
     {
-      lexical_cookie_t rv = Cookie_None;
       enum {
 	NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX
       } beg_end_state = NOMINAL;
@@ -1044,7 +2108,7 @@ #define UPDATE_BEG_END_STATE(ch)				\
       /* Skip until we get to the file vars, if any.  */
       do
 	{
-	  ch = READCHAR;
+	  COOKIE_READ_AND_BUFFER (ch);
 	  UPDATE_BEG_END_STATE (ch);
 	}
       while (!in_file_vars && ch != '\n' && ch != EOF);
@@ -1054,11 +2118,13 @@ #define UPDATE_BEG_END_STATE(ch)				\
 	  char var[100], val[100];
 	  unsigned i;
 
-	  ch = READCHAR;
+	  COOKIE_READ_AND_BUFFER (ch);
 
 	  /* Read a variable name.  */
 	  while (ch == ' ' || ch == '\t')
-	    ch = READCHAR;
+	    {
+	      COOKIE_READ_AND_BUFFER (ch);
+	    }
 
 	  i = 0;
 	  beg_end_state = NOMINAL;
@@ -1067,12 +2133,12 @@ #define UPDATE_BEG_END_STATE(ch)				\
 	      if (i < sizeof var - 1)
 		var[i++] = ch;
 	      UPDATE_BEG_END_STATE (ch);
-	      ch = READCHAR;
+	      COOKIE_READ_AND_BUFFER (ch);
 	    }
 
-	  /* Stop scanning if no colon was found before end marker.  */
+	  /* Check next line if no colon was found before end marker.  */
 	  if (!in_file_vars || ch == '\n' || ch == EOF)
-	    break;
+	    goto finish_line;
 
 	  while (i > 0 && (var[i - 1] == ' ' || var[i - 1] == '\t'))
 	    i--;
@@ -1081,10 +2147,12 @@ #define UPDATE_BEG_END_STATE(ch)				\
 	  if (ch == ':')
 	    {
 	      /* Read a variable value.  */
-	      ch = READCHAR;
+	      COOKIE_READ_AND_BUFFER (ch);
 
 	      while (ch == ' ' || ch == '\t')
-		ch = READCHAR;
+		{
+		  COOKIE_READ_AND_BUFFER (ch);
+		}
 
 	      i = 0;
 	      beg_end_state = NOMINAL;
@@ -1093,7 +2161,7 @@ #define UPDATE_BEG_END_STATE(ch)				\
 		  if (i < sizeof val - 1)
 		    val[i++] = ch;
 		  UPDATE_BEG_END_STATE (ch);
-		  ch = READCHAR;
+		  COOKIE_READ_AND_BUFFER (ch);
 		}
 	      if (! in_file_vars)
 		/* The value was terminated by an end-marker, which remove.  */
@@ -1106,16 +2174,25 @@ #define UPDATE_BEG_END_STATE(ch)				\
 		/* This is it...  */
 		{
 		  rv = strcmp (val, "nil") != 0 ? Cookie_Lex : Cookie_Dyn;
-		  break;
+		  goto finish_line;
 		}
 	    }
 	}
-
+    finish_line:
       while (ch != '\n' && ch != EOF)
-	ch = READCHAR;
-
-      return rv;
+	{
+	  COOKIE_READ_AND_BUFFER (ch);
+	}
+      if (rv != Cookie_None)
+	goto done;
+      COOKIE_READ_AND_BUFFER (ch);
     }
+ not_found:
+  lread_rewind_input(frame, lookahead, buf);
+ done:
+  unbind_to (count, Qnil);
+  return rv;
+
 }
 
 /* Value is a version number of byte compiled code if the file
@@ -1165,7 +2242,7 @@ safe_to_load_version (Lisp_Object file, lread_fd fd)
 static void
 record_load_unwind (Lisp_Object old)
 {
-  Vloads_in_progress = old;
+  current_frame->loads_in_progress = old;
 }
 
 /* This handler function is used via internal_condition_case_1.  */
@@ -1205,21 +2282,7 @@ DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
       Lisp_Object exts = Vload_file_rep_suffixes;
       Lisp_Object suffix = XCAR (suffixes);
       FOR_EACH_TAIL (exts)
-	{
-	  Lisp_Object ext = XCAR (exts);
-#ifdef HAVE_MODULES
-	  if (SCHARS (ext) > 0
-	      && (suffix_p (suffix, MODULES_SUFFIX)
-# ifdef MODULES_SECONDARY_SUFFIX
-		  || suffix_p (suffix, MODULES_SECONDARY_SUFFIX)
-# endif
-		 )
-	      && !NILP (Fmember (ext, Fsymbol_value (
-					Qjka_compr_load_suffixes))))
-	    continue;
-#endif
-	  lst = Fcons (concat2 (suffix, ext), lst);
-	}
+	lst = Fcons (concat2 (suffix, XCAR (exts)), lst);
     }
   return Fnreverse (lst);
 }
@@ -1238,10 +2301,9 @@ suffix_p (Lisp_Object string, const char *suffix)
 static void
 close_infile_unwind (void *arg)
 {
-  struct infile *prev_infile = arg;
-  eassert (infile && infile != prev_infile);
-  file_stream_close (infile->stream);
-  infile = prev_infile;
+  lread_frame *frame = (lread_frame *) arg;
+  eassert (FROM_FILE_P(frame->intype) && frame->input.f.stream);
+  file_stream_close (frame->input.f.stream);
 }
 
 /* Compute the filename we want in `load-history' and `load-file-name'.  */
@@ -1286,9 +2348,9 @@ close_file_unwind_android_fd (void *ptr)
 #endif
 
 static Lisp_Object
-get_lexical_binding (Lisp_Object stream, Lisp_Object from)
+get_lexical_binding (register lread_frame *frame, Lisp_Object from)
 {
-  lexical_cookie_t lexc = lisp_file_lexical_cookie (stream);
+  lexical_cookie_t lexc = lisp_file_lexical_cookie (frame);
   return ((lexc == Cookie_Lex
 	   ? Qt
 	   : (lexc == Cookie_Dyn
@@ -1300,6 +2362,7 @@ get_lexical_binding (Lisp_Object stream, Lisp_Object from)
 			  from)))));
 }
 
+
 DEFUN ("load", Fload, Sload, 1, 5, 0,
        doc: /* Execute a file of Lisp code named FILE.
 First try FILE with `.elc' appended, then try with `.el', then try
@@ -1468,7 +2531,7 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
   if (EQ (Qt, Vuser_init_file))
     Vuser_init_file = found;
 
-  /* If FD is -2, that means openp found a magic file.  */
+  /* If FD is -2, that means openp found a magic file. */
   if (lread_fd_cmp (-2))
     {
       if (NILP (Fequal (found, file)))
@@ -1497,6 +2560,17 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
 	fd = -2;
 #endif
     }
+  /* This dummy frame needs to be activated before any reference
+     to a null current_frame may occur, and before any
+     new entries are pushed on the SPECPDL, but after
+     we know the file exists and that we are handling it */
+  lread_frame load_frame = INIT_LREAD_FRAME ();
+  load_frame.loop_dynamic_frame = SPECPDL_INDEX ();
+  init_lread_input_from_stream (&load_frame,
+				Qnil, Qnil, Qnil,
+				false, false, NULL, Qnil);
+  activate_lread_frame (&load_frame, LREAD_FRAME_INTEGRAL);
+  lread_init_dynamic_frame (&load_frame);
 
 #if !defined USE_ANDROID_ASSETS
   if (0 <= fd)
@@ -1541,14 +2615,19 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
 
      Also, just loading a file recursively is not always an error in
      the general case; the second load may do something different.  */
+  /* dummy frame that read from /dev/null */
+  eassume (current_frame != NULL);
   {
     int load_count = 0;
-    Lisp_Object tem = Vloads_in_progress;
+    Lisp_Object tem = current_frame->loads_in_progress;
     FOR_EACH_TAIL_SAFE (tem)
       if (!NILP (Fequal (found, XCAR (tem))) && (++load_count > 3))
-	signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
-    record_unwind_protect (record_load_unwind, Vloads_in_progress);
-    Vloads_in_progress = Fcons (found, Vloads_in_progress);
+	signal_error ("Recursive load",
+		      Fcons (found, current_frame->loads_in_progress));
+    record_unwind_protect (record_load_unwind,
+			   current_frame->loads_in_progress);
+    current_frame->loads_in_progress
+      = Fcons (found, current_frame->loads_in_progress);
   }
 
   /* All loads are by default dynamic, unless the file itself specifies
@@ -1638,6 +2717,7 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
       /* We are loading a source file (*.el).  */
       if (!NILP (Vload_source_file_function))
 	{
+	  /* mule.el has been loaded and load-with-code-conversion is available */
 	  Lisp_Object val;
 
 	  if (lread_fd_p)
@@ -1648,10 +2728,11 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
 	  val = calln (Vload_source_file_function, found, hist_file_name,
 		       NILP (noerror) ? Qnil : Qt,
 		       (NILP (nomessage) || force_load_messages) ? Qnil : Qt);
-	  return unbind_to (count, val);
+	  return unbind_to (load_frame.loop_dynamic_frame, val);
 	}
     }
 
+  bool seekable = true;
   if (!lread_fd_p)
     {
       /* We somehow got here with fd == -2, meaning the file is deemed
@@ -1668,6 +2749,12 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
       efound = ENCODE_FILE (found);
       stream = emacs_fopen (SSDATA (efound), fmode);
 #else
+      struct stat st;
+      if (lread_fstat (fd, &st) != 0)
+	report_file_error ("Load file status failure", file);
+      /* At least for regular files, ensure resuming a read
+	 operation will start where it left off.  */
+      seekable = S_ISREG (st.st_mode);
 #if !defined USE_ANDROID_ASSETS
       stream = emacs_fdopen (fd, fmode);
 #else
@@ -1680,9 +2767,11 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
 #endif
     }
 
-  /* Declare here rather than inside the else-part because the storage
-     might be accessed by the unbind_to call below.  */
-  struct infile input;
+  /* Initial attempts to reuse "load_frame" failed, so
+     allocate and activate another read-eval* frame here*/
+  lread_frame this_frame = INIT_LREAD_FRAME ();
+  Lisp_Object coding = Qnil;
+  this_frame.loop_dynamic_frame = SPECPDL_INDEX();
 
   if (is_module || is_native_elisp)
     {
@@ -1693,17 +2782,27 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
           lread_close (fd);
           clear_unwind_protect (fd_index);
         }
+      this_frame.intype = LREAD_INPUT_BINARY;
     }
   else
     {
       if (!file_stream_valid_p (stream))
         report_file_error ("Opening stdio stream", file);
-      set_unwind_protect_ptr (fd_index, close_infile_unwind, infile);
-      input.stream = stream;
-      input.lookahead = 0;
-      infile = &input;
-      unread_char = -1;
+
+      AUTO_LIST3 (stream_arg, Qget_file_char, file, hist_file_name);
+      if (version && version < 22)
+	{
+	  XSETCAR (stream_arg, Qget_emacs_mule_file_char);
+	  coding = Qemacs_mule;
+	  specbind (Qload_force_doc_strings, Qt);
+	}
+
+      init_lread_input_from_stream (&this_frame, stream_arg,
+				    Qnil, Qnil,
+				    false, seekable,
+				    stream, coding);
     }
+  init_lread_eval_params(&this_frame, found, hist_file_name, Qnil, false);
 
   if (! NILP (Vpurify_flag))
     Vpreloaded_file_list = Fcons (file, Vpreloaded_file_list);
@@ -1731,9 +2830,10 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
   if (is_module)
     {
 #ifdef HAVE_MODULES
+      activate_lread_frame (&this_frame, LREAD_FRAME_INTEGRAL);
       loadhist_initialize (found);
       Fmodule_load (found);
-      build_load_history (found, true);
+      build_load_history (&this_frame,found, true);
 #else
       /* This cannot happen.  */
       emacs_abort ();
@@ -1742,9 +2842,10 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
   else if (is_native_elisp)
     {
 #ifdef HAVE_NATIVE_COMP
+      activate_lread_frame (&this_frame, LREAD_FRAME_INTEGRAL);
       loadhist_initialize (hist_file_name);
       Fnative_elisp_load (found, Qnil);
-      build_load_history (hist_file_name, true);
+      build_load_history (&this_frame,hist_file_name, true);
 #else
       /* This cannot happen.  */
       emacs_abort ();
@@ -1753,20 +2854,12 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
     }
   else
     {
+      activate_lread_frame (&this_frame, LREAD_FRAME_INTEGRAL);
+      set_unwind_protect_ptr (fd_index, close_infile_unwind, &this_frame);
       Fset (Qlexical_binding,
-	    get_lexical_binding (Qget_file_char, compiled ? Qnil : file));
+	    get_lexical_binding(&this_frame, compiled ? Qnil : file));
 
-      if (! version || version >= 22)
-        readevalloop (Qget_file_char, &input, hist_file_name,
-                      0, Qnil, Qnil, Qnil, Qnil);
-      else
-        {
-          /* We can't handle a file which was compiled with
-             byte-compile-dynamic by older version of Emacs.  */
-          specbind (Qload_force_doc_strings, Qt);
-          readevalloop (Qget_emacs_mule_file_char, &input, hist_file_name,
-                        0, Qnil, Qnil, Qnil, Qnil);
-        }
+      readevalloop_eof_trampoline (make_mint_ptr(&this_frame));
     }
   unbind_to (count, Qnil);
 
@@ -1774,11 +2867,11 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
   if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
     calln (Qdo_after_load_evaluation, hist_file_name);
 
-  for (int i = 0; i < ARRAYELTS (saved_strings); i++)
+  for (int i = 0; i < ARRAYELTS (this_frame.saved_strings); i++)
     {
-      xfree (saved_strings[i].string);
-      saved_strings[i].string = NULL;
-      saved_strings[i].size = 0;
+      xfree (this_frame.saved_strings[i].string);
+      this_frame.saved_strings[i].string = NULL;
+      this_frame.saved_strings[i].size = 0;
     }
 
   /* The "...done" messages are shown only in interactive mode, because
@@ -2288,7 +3381,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
    part of it.  */
 
 static void
-build_load_history (Lisp_Object filename, bool entire)
+build_load_history (register lread_frame *frame, Lisp_Object filename, bool entire)
 {
   Lisp_Object tail, prev, newelt;
   Lisp_Object tem, tem2;
@@ -2326,7 +3419,7 @@ build_load_history (Lisp_Object filename, bool entire)
 
 		  if (NILP (Fmember (newelt, tem)))
 		    Fsetcar (tail, Fcons (XCAR (tem),
-		     			  Fcons (newelt, XCDR (tem))));
+					  Fcons (newelt, XCDR (tem))));
 		  maybe_quit ();
 		}
 	    }
@@ -2349,19 +3442,28 @@ build_load_history (Lisp_Object filename, bool entire)
       Vcurrent_load_list = Qt;
     }
 }
-
-static void
-readevalloop_1 (int old)
+Lisp_Object
+readevalloop_eof_trampoline (Lisp_Object frameptr)
 {
-  load_convert_to_unibyte = old;
+  lread_frame *frame = xmint_pointer (frameptr);
+  eassert (!UNINIT_SPECPDL_REF(frame->loop_dynamic_frame));
+  Lisp_Object val =
+    internal_condition_case_1 (readevalloop,
+			       frameptr,
+			       list1 (Qend_of_file),
+			       readevalloop_eof_handler);
+  build_load_history (frame, frame->sourcename,
+		      FROM_FILE_P (frame->intype) || frame->whole_buffer);
+  return unbind_to (frame->loop_dynamic_frame, val);
 }
 
 /* Signal an `end-of-file' error, if possible with file name
    information.  */
 
 static AVOID
-end_of_file_error (void)
+end_of_file_error (register lread_frame *frame)
 {
+  frame->read_eof = true;
   if (STRINGP (Vload_true_file_name))
     xsignal1 (Qend_of_file, Vload_true_file_name);
 
@@ -2389,63 +3491,278 @@ readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand)
   return val;
 }
 
-/* UNIBYTE specifies how to set load_convert_to_unibyte
-   for this invocation.
-   READFUN, if non-nil, is used instead of `read'.
+Lisp_Object
+lread_get_buffer_obj (register lread_frame *frame)
+{
+  switch (frame->intype)
+    {
+    case LREAD_INPUT_BUFFER:
+      return frame->input.b.buffer;
+      break;
+    case LREAD_INPUT_MARKER:
+      return frame->input.m.b.buffer;
+      break;
+    case LREAD_INPUT_INDIRECT:
+      return lread_get_buffer_obj (frame->input.frame.source);
+      break;
+    default:
+    /* skip */
+    }
+  return Qnil;
+}
+
+struct buffer *
+lread_get_buffer (register lread_frame *frame)
+{
+  switch (frame->intype)
+    {
+    case LREAD_INPUT_BUFFER:
+      return XBUFFER(frame->input.b.buffer);
+      break;
+    case LREAD_INPUT_MARKER:
+      return XBUFFER (frame->input.m.b.buffer);
+      break;
+    case LREAD_INPUT_INDIRECT:
+      return lread_get_buffer (frame->input.frame.source);
+      break;
+    default:
+    /* skip */
+    }
+  return NULL;
+}
+
+static Lisp_Object
+buffer_point_marker (Lisp_Object buffer)
+{
+  struct buffer *buf = XBUFFER (buffer);
+  if (buf == current_buffer)
+    return Fpoint_marker();
+  if (NILP (BVAR (buf, pt_marker)))
+    return build_marker (buf, BUF_PT (buf), BUF_PT_BYTE (buf));
+  /* else */
+  return Fcopy_marker (BVAR (buf, pt_marker), Qnil);
+}
+
+/* Don't alter the buffer, just construct markers for
+   frame->start and frame->end directly */
+bool
+setup_buffer_for_readevalloop (register lread_frame *frame,
+			       Lisp_Object start, Lisp_Object end)
+{
+  specpdl_ref count = SPECPDL_INDEX ();
+  Lisp_Object buffer = lread_get_buffer_obj (frame);
+  struct buffer *buf = NILP (buffer) ? NULL : XBUFFER (buffer);
+  if (NILP (start))
+    {
+      frame->start = buffer_point_marker (buffer);
+    }
+  else if (FIXNUMP (start))
+    {
+      Lisp_Object tmp = Fmake_marker();
+      frame->start = Fset_marker (tmp, start, buffer);
+    }
+  else if (!MARKERP (start))
+    xsignal1 (Qerror, CALLN (Fformat,
+			     build_string ("read: start argument must be nil, "
+			       "number, or marker: %S"),
+			     start));
+  else
+    {
+      /* There is no guarantee the marker is from the buffer */
+      if (XMARKER (start)->buffer == buf)
+	frame->start = start;
+      else
+	{
+	  Lisp_Object tmp = Fmake_marker ();
+	  frame->start
+	    = Fset_marker (tmp,
+			   make_fixnum (XMARKER(start)->charpos),
+			   buffer);
+	}
+    }
+  if (NILP (end))
+    {
+      Lisp_Object tmp = Fmake_marker();
+      frame->end = Fset_marker (tmp, make_fixnum (BUF_Z (buf)),buffer);
+    }
+  else if (FIXNUMP (end))
+    {
+      Lisp_Object tmp = Fmake_marker();
+      frame->end = Fset_marker (tmp, end,buffer);
+    }
+  else if (!MARKERP (end))
+    xsignal1 (Qerror, CALLN (Fformat,
+			     build_string ("read: end argument must be nil, "
+			       "number, or marker: %S"),
+			     end));
+  else
+    {
+      if (XMARKER (end)->buffer == buf)
+	frame->end = end;
+      else
+	{
+	  Lisp_Object tmp = Fmake_marker ();
+	  frame->end = Fset_marker (tmp,
+				    make_fixnum (XMARKER(end)->charpos),
+				    buffer);
+	}
+    }
+  /* is restriction the whole buffer? */
+  bool rv = ((XMARKER (frame->start)->charpos == BUF_BEG (buf))
+	     && (XMARKER (frame->end)->charpos == BUF_Z (buf)));
+  unbind_to (count,Qnil);
+  return rv;
+}
+
+INLINE void
+check_live_input (register lread_frame *frame, struct buffer *buf)
+{
+  /* The only input type that eval might kill is a buffer */
+  if (buf != 0 && !BUFFER_LIVE_P (buf))
+    error ("Reading from killed buffer");
+
+}
+
+/* During "eval-region", readevalloop performs evaluations in 2 contexts
+   with respect to "current-buffer" and restrictions on it that might either
+   affect or be affected by the operation of reading the buffer.
+
+   The first is the evaluation context in which the "eval-region" is called,
+       and also in which the forms being read are called.
+   The second is the context in which the stream is read.
+
+   readevalloop treats the two contexts as if a sort of dynamic-wind surrounds
+   each:
+   (dynamic-wind wind-up-eval eval-context unwind-eval)
+   (dynamic-wind wind-up-read read-context unwind-read)
+
+   This procedure is a combination of "unwind-eval" and "wind-up-read",
+   but the "unwind-eval" has the form "unwind-protect wind-up-eval"
+ */
+void
+prepare_buffer_for_interruptible_read (register lread_frame *frame,
+				       struct buffer *buf)
+{
+  /* struct buffer *buf = lread_get_buffer(frame); */
+  /* Switch to the buffer we are reading from.  */
+  record_unwind_protect_excursion ();
+  set_buffer_internal (buf);
+
+  /* Save point in it.  */
+  record_unwind_protect_excursion ();
+  /* Save ZV in it.  */
+  record_unwind_protect (save_restriction_restore, save_restriction_save ());
+  labeled_restrictions_remove_in_current_buffer ();
+  /* Those get unbound after we read one expression.  */
+
+  /* Set point and ZV around stuff to be read.  */
+  Fgoto_char (frame->start);
+  Fnarrow_to_region (make_fixnum (BEGV), frame->end);
+}
+
+/* READFUN, if non-nil, is used instead of `read'.
 
    START, END specify region to read in current buffer (from eval-region).
    If the input is not from a buffer, they must be nil.  */
 
-static void
-readevalloop (Lisp_Object readcharfun,
-	      struct infile *infile0,
-	      Lisp_Object sourcename,
-	      bool printflag,
-	      Lisp_Object unibyte, Lisp_Object readfun,
-	      Lisp_Object start, Lisp_Object end)
+static Lisp_Object
+nonstandard_read (Lisp_Object frameptr)
+{
+  register lread_frame *frame = xmint_pointer (frameptr);
+  Lisp_Object val;
+  Lisp_Object stream;
+  if (FROM_BUFFER_P (frame->intype))
+    stream = lread_get_buffer_obj (frame);
+  else
+    stream = Qreader_input_stream;
+  if (!NILP (frame->readfun))
+    {
+      val = calln (frame->readfun, stream);
+
+      /* If READCHARFUN has set point to ZV, we should
+	 stop reading, even if the form read sets point
+	 to a different value when evaluated.  */
+      if (FROM_BUFFER_P (frame->intype))
+	{
+	  struct buffer *buf = lread_get_buffer (frame);
+	  if (BUF_PT (buf) == BUF_ZV (buf))
+	    frame->read_eof = true;
+	}
+    }
+  else
+    {
+      /* ! NILP (Vload_read_function) */
+      val = calln (Vload_read_function, stream);
+    }
+  frame->read_expr = true;
+  return val;
+}
+
+INLINE void
+lread_skip_insignificant (register lread_frame *frame)
 {
   int c;
+  /* this is only correct if we know read0 is going
+     to be reading expressions from source.  Other
+     readers might do something with comments and
+     whitespace.  */
+  /* only benefit is to avoid condition-case for
+     catching end-of-file ? */
+ read_next:
+  c = READCHAR (frame);
+  if (c == ';')
+    {
+      while ((c = READCHAR (frame)) != '\n' && c != -1);
+      goto read_next;
+    }
+  if (c < 0)
+    {
+      frame->read_eof = true;
+    }
+
+  /* Ignore whitespace here, so we can detect eof.  */
+  if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r'
+      || c == NO_BREAK_SPACE)
+    goto read_next;
+  UNREAD (frame, c);
+}
+
+static Lisp_Object
+readevalloop (Lisp_Object frameptr)
+{
+  register lread_frame *frame = xmint_pointer (frameptr);
   Lisp_Object val;
-  specpdl_ref count = SPECPDL_INDEX ();
-  struct buffer *b = 0;
-  bool continue_reading_p;
+  struct buffer *b = lread_get_buffer (frame);
   Lisp_Object lex_bound;
   /* True if reading an entire buffer.  */
-  bool whole_buffer = 0;
-  /* True on the first time around.  */
-  bool first_sexp = 1;
   Lisp_Object macroexpand;
-
-  if (!NILP (sourcename))
-    CHECK_STRING (sourcename);
+  bool compiled = (STRINGP (frame->sourcename) && suffix_p (frame->sourcename, ".elc"));
+  bool ignore_readfun = NILP (frame->readfun);
+  bool use_read0 = compiled || will_dump_p()
+    || (ignore_readfun
+	&& (NILP (Vload_read_function)));
+	    /* || EQ (Vload_read_function, Qread))); */
+  Lisp_Object prev_Vload_read_function = Vload_read_function;
 
   macroexpand = Qinternal_macroexpand_for_load;
 
-  if (NILP (Ffboundp (macroexpand))
-      || (STRINGP (sourcename) && suffix_p (sourcename, ".elc")))
+  if (NILP (Ffboundp (macroexpand)) || compiled)
     /* Don't macroexpand before the corresponding function is defined
        and don't bother macroexpanding in .elc files, since it should have
        been done already.  */
     macroexpand = Qnil;
 
-  if (MARKERP (readcharfun))
-    {
-      if (NILP (start))
-	start = readcharfun;
-    }
-
-  if (BUFFERP (readcharfun))
-    b = XBUFFER (readcharfun);
-  else if (MARKERP (readcharfun))
-    b = XMARKER (readcharfun)->buffer;
-
   /* We assume START is nil when input is not from a buffer.  */
-  if (! NILP (start) && !b)
+  if (! NILP (frame->start) && !b)
     emacs_abort ();
 
-  specbind (Qstandard_input, readcharfun);
-  record_unwind_protect_int (readevalloop_1, load_convert_to_unibyte);
-  load_convert_to_unibyte = !NILP (unibyte);
+  /* edebug's instrumentation mechanism wraps load-read-function
+     and requires the stream argument to be the current-buffer.
+     Just using Qreader_input_stream breaks this undocumented
+     assumption about the argument to load-read-function. */
+  Lisp_Object stream = FROM_BUFFER_P (frame->intype) ?
+    lread_get_buffer_obj (frame) : Qreader_input_stream;
+  specbind (Qstandard_input, stream);
 
   /* If lexical binding is active (either because it was specified in
      the file's header, or via a buffer-local variable), create an empty
@@ -2456,139 +3773,199 @@ readevalloop (Lisp_Object readcharfun,
 	     ? Qnil : list1 (Qt)));
   specbind (Qmacroexp__dynvars, Vmacroexp__dynvars);
 
-  /* Ensure sourcename is absolute, except whilst preloading.  */
-  if (!will_dump_p ()
-      && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename)))
-    sourcename = Fexpand_file_name (sourcename, Qnil);
-
-  loadhist_initialize (sourcename);
+  loadhist_initialize (frame->sourcename);
+  if (b != NULL)
+    frame->whole_buffer =
+      setup_buffer_for_readevalloop (frame, frame->start, frame->end)
+      || frame->whole_buffer;
 
-  continue_reading_p = 1;
-  while (continue_reading_p)
+  /* the read dynamic frame must be initialized even in the stream is empty */
+  lread_init_dynamic_frame (frame);
+  while (!frame->read_eof)
     {
-      specpdl_ref count1 = SPECPDL_INDEX ();
 
-      if (b != 0 && !BUFFER_LIVE_P (b))
-	error ("Reading from killed buffer");
+      frame->objects_map = Fclrhash (frame->objects_map);
+      frame->objects_completed = Fclrhash (frame->objects_completed);
 
-      if (!NILP (start))
-	{
-	  /* Switch to the buffer we are reading from.  */
-	  record_unwind_protect_excursion ();
-	  set_buffer_internal (b);
-
-	  /* Save point in it.  */
-	  record_unwind_protect_excursion ();
-	  /* Save ZV in it.  */
-	  record_unwind_protect (save_restriction_restore, save_restriction_save ());
-	  labeled_restrictions_remove_in_current_buffer ();
-	  /* Those get unbound after we read one expression.  */
-
-	  /* Set point and ZV around stuff to be read.  */
-	  Fgoto_char (start);
-	  if (!NILP (end))
-	    Fnarrow_to_region (make_fixnum (BEGV), end);
-
-	  /* Just for cleanliness, convert END to a marker
-	     if it is an integer.  */
-	  if (FIXNUMP (end))
-	    end = Fpoint_max_marker ();
-	}
+      /* Check this whether the frame is integral or dynamic-wind */
+      check_live_input (frame, b);
 
-      /* On the first cycle, we can easily test here
-	 whether we are reading the whole buffer.  */
-      if (b && first_sexp)
-	whole_buffer = (BUF_PT (b) == BUF_BEG (b) && BUF_ZV (b) == BUF_Z (b));
+      if (b && frame->type == LREAD_FRAME_DYNAMIC_WIND)
+	prepare_buffer_for_interruptible_read (frame, b);
 
-      eassert (!infile0 || infile == infile0);
-    read_next:
-      c = READCHAR;
-      if (c == ';')
+      frame->read_expr = false;
+      /* Handle the most common case first */
+      /* not sure why the Vpurify_flag/will_dump_p case is special */
+      if (use_read0)
 	{
-	  while ((c = READCHAR) != '\n' && c != -1);
-	  goto read_next;
+	/* avoid condition case */
+	  lread_skip_insignificant (frame);
+	  if (frame->read_eof)
+	      break;
+	  val = read0 (frame);
+	  frame->nexprs++;
 	}
-      if (c < 0)
+      else
 	{
-	  unbind_to (count1, Qnil);
-	  break;
+	  /* read stops by signaling end-of-file
+	     Must not return a value and set read_eof!
+	   */
+	  val = internal_condition_case_1 (nonstandard_read,
+					   make_mint_ptr (frame),
+					   list1 (Qend_of_file),
+					   lread_set_read_eof);
+	  if (frame->read_eof && !frame->read_expr)
+	      break;
+	  frame->nexprs++;
 	}
 
-      /* Ignore whitespace here, so we can detect eof.  */
-      if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r'
-	  || c == NO_BREAK_SPACE)
-	goto read_next;
-      UNREAD (c);
-
-      if (! HASH_TABLE_P (read_objects_map)
-	  || XHASH_TABLE (read_objects_map)->count)
-	read_objects_map
-	  = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None);
-      if (! HASH_TABLE_P (read_objects_completed)
-	  || XHASH_TABLE (read_objects_completed)->count)
-	read_objects_completed
-	  = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None);
-      if (!NILP (Vpurify_flag) && c == '(')
-	val = read0 (readcharfun, false);
-      else
+
+      /* Restore saved point and BEGV.  */
+      eassert (!UNINIT_SPECPDL_REF (frame->dynamic_frame));
+      if (frame->type == LREAD_FRAME_DYNAMIC_WIND)
 	{
-	  if (!NILP (readfun))
+	  if (b && !frame->read_eof && frame->type == LREAD_FRAME_DYNAMIC_WIND)
 	    {
-	      val = calln (readfun, readcharfun);
-
-	      /* If READCHARFUN has set point to ZV, we should
-	         stop reading, even if the form read sets point
-		 to a different value when evaluated.  */
-	      if (BUFFERP (readcharfun))
-		{
-		  struct buffer *buf = XBUFFER (readcharfun);
-		  if (BUF_PT (buf) == BUF_ZV (buf))
-		    continue_reading_p = 0;
-		}
+	      frame->start = Fpoint_marker ();
+	      frame->char_offset = XMARKER (frame->start)->charpos;
+	      frame->byte_offset = XMARKER (frame->start)->bytepos;
 	    }
-	  else if (! NILP (Vload_read_function))
-	    val = calln (Vload_read_function, readcharfun);
-	  else
-	    val = read_internal_start (readcharfun, Qnil, Qnil, false);
+	  lread_unwind_for_eval (frame);
 	}
-      /* Empty hashes can be reused; otherwise, reset on next call.  */
-      if (HASH_TABLE_P (read_objects_map)
-	  && XHASH_TABLE (read_objects_map)->count > 0)
-	read_objects_map = Qnil;
-      if (HASH_TABLE_P (read_objects_completed)
-	  && XHASH_TABLE (read_objects_completed)->count > 0)
-	read_objects_completed = Qnil;
-
-      if (!NILP (start) && continue_reading_p)
-	start = Fpoint_marker ();
-
-      /* Restore saved point and BEGV.  */
-      unbind_to (count1, Qnil);
-
       /* Now eval what we just read.  */
       if (!NILP (macroexpand))
-        val = readevalloop_eager_expand_eval (val, macroexpand);
+	frame->value = readevalloop_eager_expand_eval (val, macroexpand);
       else
-        val = eval_sub (val);
+	frame->value = eval_sub (val);
+
+      /* check if the evaluation affected whether we can use the
+	 shortcut to read0 */
+      if (!EQ (Vload_read_function, prev_Vload_read_function))
+	{
+	  prev_Vload_read_function = Vload_read_function;
+	  use_read0 = compiled || will_dump_p ()
+	    || (ignore_readfun
+		&& (NILP (Vload_read_function)));
+		    /* || EQ (Vload_read_function, Qread))); */
+	}
 
-      if (printflag)
+      if (frame->printflag)
 	{
-	  Vvalues = Fcons (val, Vvalues);
+	  Vvalues = Fcons (frame->value, Vvalues);
 	  if (EQ (Vstandard_output, Qt))
-	    Fprin1 (val, Qnil, Qnil);
+	    Fprin1 (frame->value, Qnil, Qnil);
 	  else
-	    Fprint (val, Qnil);
+	    Fprint (frame->value, Qnil);
 	}
 
-      first_sexp = 0;
+      /* pop the read dynamic frame without actually unwinding */
+      frame->dynamic_frame = SPECPDL_REF_UNINIT;
+      lread_init_dynamic_frame (frame);
+
     }
+  if (frame->type == LREAD_FRAME_DYNAMIC_WIND)
+    lread_unwind_for_eval (frame);
+  return frame->value;
+}
 
-  build_load_history (sourcename,
-		      infile0 || whole_buffer);
 
-  unbind_to (count, Qnil);
+static Lisp_Object
+enter_stream_readevalloop (Lisp_Object stream)
+{
+  Lisp_Object val = Qnil;
+  lread_frame this_frame = INIT_LREAD_FRAME();
+  this_frame.loop_dynamic_frame = SPECPDL_INDEX ();
+
+  init_lread_input_from_stream (&this_frame,
+				stream,
+				Qnil, Qnil,
+				false, false, NULL, Qnil);
+  init_lread_eval_params(&this_frame, Qnil, Qnil,
+			 Qnil, false);
+  activate_lread_frame (&this_frame, LREAD_FRAME_INTEGRAL);
+  val = readevalloop_eof_trampoline (make_mint_ptr (&this_frame));
+  return unbind_to (this_frame.loop_dynamic_frame, val);
+}
+
+static Lisp_Object
+enter_buffer_readevalloop (Lisp_Object buffer,
+			   Lisp_Object printflag,
+			   Lisp_Object filename,
+			   Lisp_Object do_allow_print,
+			   Lisp_Object start,
+			   Lisp_Object end,
+			   Lisp_Object read_function,
+			   bool whole_buffer)
+{
+  Lisp_Object tem, buf, val = Qnil;
+  specpdl_ref count = SPECPDL_INDEX ();
+  lread_frame this_frame = INIT_LREAD_FRAME();
+  Lisp_Object full_name;
+  lread_frame_type eval_type = whole_buffer ?
+    LREAD_FRAME_INTEGRAL : LREAD_FRAME_DYNAMIC_WIND;
+  if (NILP (buffer))
+    buf = Fcurrent_buffer ();
+  else
+    buf = Fget_buffer (buffer);
+  if (NILP (buf))
+    error ("No such buffer");
+
+  if (NILP (printflag) && NILP (do_allow_print))
+    tem = Qsymbolp;
+  else
+    tem = printflag;
+  if (NILP (filename))
+    filename = BVAR (XBUFFER (buf), filename);
+  if (!NILP (filename) && NILP (Ffile_name_absolute_p (filename)))
+    full_name = Fexpand_file_name (filename, Qnil);
+  else
+    full_name = filename;
+  specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
+  specbind (Qstandard_output, tem);
+  this_frame.loop_dynamic_frame = SPECPDL_INDEX ();
+  init_lread_input_from_stream (&this_frame,
+				buf,
+				start, end,
+				false, true, NULL, Qnil);
+  init_lread_eval_params(&this_frame, full_name, filename,
+			 read_function, whole_buffer);
+  /* note at this stage, whole_buffer is determined by the caller
+     wants to set lexical scoping based on the buffer contents
+     readevalloop will set it for the sake of recording load history
+     based on the start and end, even if the caller does not
+     make it explicit.
+   */
+  /* frame->readonechar must be set to use READCHAR,
+     but activate_lread_frame alters the specpdl
+     may affects the order of the unwind-protects versus
+     pre-refactoring */
+  if (whole_buffer)
+    {
+      record_unwind_protect_excursion ();
+      BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
+      /* Don't emit a warning about 'lexical-binding' if it already has a
+	 local binding in the buffer.  */
+      if (NILP (Flocal_variable_p (Qlexical_binding, buf)))
+	specbind (Qlexical_binding, get_lexical_binding (&this_frame, buf));
+      BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
+    }
+  activate_lread_frame (&this_frame, eval_type);
+  val = readevalloop_eof_trampoline (make_mint_ptr (&this_frame));
+  return unbind_to (count, val);
+}
+
+DEFUN ("eval-stream", Feval_stream, Seval_stream, 1, 1, "",
+  doc: /* Execute the sequence of forms read from STREAM
+for any input stream argument.  */)
+  (Lisp_Object stream)
+{
+  return enter_stream_readevalloop (stream);
 }
 
+/* NB: the unibyte argument to eval-buffer used to set the load_convert_to_unibyte,
+   which has no apparent usages and has not since prior to 2011.
+   We stop pretending to care about it.  */
+
 DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
        doc: /* Execute the accessible portion of current buffer as Lisp code.
 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
@@ -2620,36 +3997,9 @@ DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
   (Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename,
    Lisp_Object unibyte, Lisp_Object do_allow_print)
 {
-  specpdl_ref count = SPECPDL_INDEX ();
-  Lisp_Object tem, buf;
-
-  if (NILP (buffer))
-    buf = Fcurrent_buffer ();
-  else
-    buf = Fget_buffer (buffer);
-  if (NILP (buf))
-    error ("No such buffer");
-
-  if (NILP (printflag) && NILP (do_allow_print))
-    tem = Qsymbolp;
-  else
-    tem = printflag;
-
-  if (NILP (filename))
-    filename = BVAR (XBUFFER (buf), filename);
-
-  specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
-  specbind (Qstandard_output, tem);
-  record_unwind_protect_excursion ();
-  BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
-  /* Don't emit a warning about 'lexical-binding' if it already has a
-     local binding in the buffer.  */
-  if (NILP (Flocal_variable_p (Qlexical_binding, buf)))
-    specbind (Qlexical_binding, get_lexical_binding (buf, buf));
-  BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
-  readevalloop (buf, 0, filename,
-		!NILP (printflag), unibyte, Qnil, Qnil, Qnil);
-  return unbind_to (count, Qnil);
+  return enter_buffer_readevalloop (buffer, printflag, filename,
+				    do_allow_print, Qnil,
+				    Qnil, Qnil, true);
 }
 
 DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r",
@@ -2665,30 +4015,41 @@ DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r",
 which is the input stream for reading characters.
 
 This function does not move point.  */)
-  (Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function)
+  (Lisp_Object start, Lisp_Object end, Lisp_Object printflag,
+   Lisp_Object read_function)
 {
-  /* FIXME: Do the eval-sexp-add-defvars dance!  */
-  specpdl_ref count = SPECPDL_INDEX ();
-  Lisp_Object tem, cbuf;
-
-  cbuf = Fcurrent_buffer ();
-
-  if (NILP (printflag))
-    tem = Qsymbolp;
-  else
-    tem = printflag;
-  specbind (Qstandard_output, tem);
-  specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
+  return enter_buffer_readevalloop (Qnil, printflag, Qnil,
+				    Qnil, start, end, read_function,
+				    false);
+}
 
-  /* `readevalloop' calls functions which check the type of start and end.  */
-  readevalloop (cbuf, 0, BVAR (XBUFFER (cbuf), filename),
-		!NILP (printflag), Qnil, read_function,
-		start, end);
 
-  return unbind_to (count, Qnil);
+
+static Lisp_Object
+enter_read (Lisp_Object stream, Lisp_Object start, Lisp_Object end,
+	    bool locate_syms, ptrdiff_t *char_offset)
+{
+  if (!handle_read_stream_defaults (&stream))
+    return stream;
+  lread_frame this_frame = INIT_LREAD_FRAME();
+  this_frame.loop_dynamic_frame = SPECPDL_INDEX ();
+  init_lread_input_from_stream (&this_frame,
+				stream,
+				start, end, locate_syms,
+				false,	NULL, Qnil);
+  activate_lread_frame (&this_frame, LREAD_FRAME_SINGLE);
+  lread_init_dynamic_frame (&this_frame);
+  if (char_offset)
+    *char_offset = this_frame.char_offset;
+  Lisp_Object data = Qnil;
+  /* Fread may be called while loading the dump file */
+  data = read0 ( &this_frame);
+  if (char_offset)
+    *char_offset = this_frame.char_offset;
+   unbind_to (this_frame.loop_dynamic_frame, Qnil);
+   return data;
 }
 
-
 DEFUN ("read", Fread, Sread, 0, 1, 0,
        doc: /* Read one Lisp expression as text from STREAM, return as Lisp object.
 If STREAM is nil, use the value of `standard-input' (which see).
@@ -2702,18 +4063,7 @@ DEFUN ("read", Fread, Sread, 0, 1, 0,
     standard input in batch mode).  */)
   (Lisp_Object stream)
 {
-  if (NILP (stream))
-    stream = Vstandard_input;
-  if (EQ (stream, Qt))
-    stream = Qread_char;
-  if (EQ (stream, Qread_char))
-    /* FIXME: ?! This is used when the reader is called from the
-       minibuffer without a stream, as in (read).  But is this feature
-       ever used, and if so, why?  IOW, will anything break if this
-       feature is removed !?  */
-    return calln (Qread_minibuffer, build_string ("Lisp expression: "));
-
-  return read_internal_start (stream, Qnil, Qnil, false);
+  return enter_read (stream, Qnil, Qnil, false, NULL);
 }
 
 DEFUN ("read-positioning-symbols", Fread_positioning_symbols,
@@ -2732,15 +4082,7 @@ DEFUN ("read-positioning-symbols", Fread_positioning_symbols,
     standard input in batch mode).  */)
   (Lisp_Object stream)
 {
-  if (NILP (stream))
-    stream = Vstandard_input;
-  if (EQ (stream, Qt))
-    stream = Qread_char;
-  if (EQ (stream, Qread_char))
-    /* FIXME: ?! When is this used !?  */
-    return calln (Qread_minibuffer, build_string ("Lisp expression: "));
-
-  return read_internal_start (stream, Qnil, Qnil, true);
+  return enter_read (stream, Qnil, Qnil, true, NULL);
 }
 
 DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
@@ -2754,92 +4096,221 @@ DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
   (Lisp_Object string, Lisp_Object start, Lisp_Object end)
 {
   Lisp_Object ret;
+  ptrdiff_t pos;
   CHECK_STRING (string);
-  /* `read_internal_start' sets `read_from_string_index'.  */
-  ret = read_internal_start (string, start, end, false);
-  return Fcons (ret, make_fixnum (read_from_string_index));
+  ret = enter_read (string, start, end, false, &pos);
+  return Fcons (ret, make_fixnum (pos));
 }
 
-/* Function to set up the global context we need in toplevel read
-   calls.  START and END only used when STREAM is a string.
-   LOCATE_SYMS true means read symbol occurrences as symbols with
-   position.  */
-static Lisp_Object
-read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end,
-                     bool locate_syms)
-{
-  Lisp_Object retval;
-
-  readchar_offset = BUFFERP (stream) ? XBUFFER (stream)->pt : 0;
-  /* We can get called from readevalloop which may have set these
-     already.  */
-  if (! HASH_TABLE_P (read_objects_map)
-      || XHASH_TABLE (read_objects_map)->count)
-    read_objects_map
-      = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None);
-  if (! HASH_TABLE_P (read_objects_completed)
-      || XHASH_TABLE (read_objects_completed)->count)
-    read_objects_completed
-      = make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None);
-
-  if (STRINGP (stream)
-      || ((CONSP (stream) && STRINGP (XCAR (stream)))))
-    {
-      ptrdiff_t startval, endval;
-      Lisp_Object string;
+bool
+handle_read_stream_defaults (Lisp_Object *stream)
+{
+  if (NILP (*stream))
+    *stream = Vstandard_input;
+  if (EQ (*stream, Qt))
+    *stream = Qread_char;
+  if (EQ (*stream, Qread_char))
+    {
+      /* FIXME: ?! This is used when the reader is called from the
+	 minibuffer without a stream, as in (read).  But is this feature
+	 ever used, and if so, why?  IOW, will anything break if this
+	 feature is removed !?	*/
+      if (!NILP (Ffboundp (Qread_minibuffer)))
+	*stream = calln (Qread_minibuffer,
+			 build_string ("Lisp expression: "));
+      else
+	/* From initial definition of read-minibuffer in subr.el */
+	*stream = Fread_from_minibuffer (build_string ("Lisp expression: "),
+					 Qnil, Vminibuffer_local_map, Qt,
+					 Qminibuffer_history, Qnil, Qnil);
+      return false;
+    }
+  return true;
+}
+
+/* Convert read argument into lread_input of appropriate type */
+void
+init_lread_input_from_stream (lread_frame *frame,
+			      Lisp_Object stream,
+			      Lisp_Object start,
+			      Lisp_Object end,
+			      bool locate_syms,
+			      bool seekable,
+			      FILE *stream_file,
+			      Lisp_Object coding)
+{
+  Lisp_Object full_name = Qnil;
+  Lisp_Object name = Qnil;
+  if (CODING_SYSTEM_P (coding))
+    {
+      ptrdiff_t id = CODING_SYSTEM_ID (coding);
+      frame->multibyte = NILP (CODING_ATTR_FOR_UNIBYTE (CODING_ID_ATTRS (id))) ?
+	LREAD_MULTIBYTE_TRUE : LREAD_MULTIBYTE_FALSE;
+    }
+  else
+    {
+      coding = Qnil;
+    }
 
-      if (STRINGP (stream))
-	string = stream;
+  if (CONSP (stream))
+    {
+      Lisp_Object base_stream = XCAR (stream);
+      if (CONSP (base_stream))
+	/* disallow nested cons to avoid infinite
+	   recursion on circular input */
+	xsignal1 (Qerror,
+		  CALLN (Fformat,
+			 build_string ("read: Nested cons: %S"),
+			 stream));
+      Lisp_Object item1 = XCDR (stream);
+      Lisp_Object item2 = Qnil;
+      if (CONSP (item1))
+      {
+	item2 = XCDR (item1);
+	item1 = XCAR(item1);
+      }
+      if (BUFFERP (base_stream) || MARKERP (base_stream)
+	  || STRINGP (base_stream))
+	{
+	  start = (NILP (start)) ? item1 : start;
+	  end = (NILP (end)) ? item2 : end;
+	}
+      else
+	{
+	  if (NILP (name))
+	    name = item1;
+	  if (NILP (full_name))
+	    full_name = NILP (item2) ? item1 : item2;
+	}
+	  stream = base_stream;
+    }
+  frame->start = start;
+  frame->end = end;
+  frame->full_name = full_name;
+  frame->name = name;
+  frame->locate_syms = locate_syms;
+  if (BUFFERP (stream))
+    {
+#if 0
+      if (current_frame)
+	{
+	  lread_frame *source = current_frame;
+	  if (source->intype == LREAD_INPUT_INDIRECT)
+	    source = source->input.frame.source;
+	  if (source->intype == LREAD_INPUT_BUFFER
+	      && EQ (source->input.b.buffer, stream))
+	    goto indirect_frame;
+	}
+#endif
+      frame->intype = LREAD_INPUT_BUFFER;
+      init_inbuffer (frame,stream);
+    }
+  else if (MARKERP (stream))
+    {
+      frame->intype = LREAD_INPUT_MARKER;
+      init_inmarker (frame,stream);
+    }
+  else if (STRINGP (stream))
+    {
+      frame->intype = LREAD_INPUT_STRING;
+      init_instring (frame, stream);
+    }
+  else if (EQ (stream, Qget_file_char))
+    {
+      /* abuse start and end arguments for full_name and file */
+      eassert (stream_file != NULL);
+      frame->intype = LREAD_INPUT_FILE;
+      init_infile (frame, stream_file, seekable, false, coding);
+      if (NILP (coding))
+	{
+	  /* the readchar function performs emacs-internal decoding */
+	  frame->multibyte = LREAD_MULTIBYTE_TRUE;
+	}
+    }
+  else if (EQ (stream, Qreader_input_stream))
+    {
+    indirect_frame:
+      frame->intype = LREAD_INPUT_INDIRECT;
+      lread_frame *source = current_frame;
+      while (source && source->intype == LREAD_INPUT_INDIRECT)
+	source = source->input.frame.source;
+      if (! source)
+	/* (reader-input-stream) when no read is active */
+	frame->intype = LREAD_INPUT_NULL;
       else
-	string = XCAR (stream);
-
-      validate_subarray (string, start, end, SCHARS (string),
-			 &startval, &endval);
-
-      read_from_string_index = startval;
-      read_from_string_index_byte = string_char_to_byte (string, startval);
-      read_from_string_limit = endval;
+	{
+	  frame->input.frame.source = source;
+	  frame->char_offset = source->char_offset;
+	  frame->byte_offset = source->byte_offset;
+	}
     }
-
-  retval = read0 (stream, locate_syms);
-  if (HASH_TABLE_P (read_objects_map)
-      && XHASH_TABLE (read_objects_map)->count > 0)
-    read_objects_map = Qnil;
-  if (HASH_TABLE_P (read_objects_completed)
-      && XHASH_TABLE (read_objects_completed)->count > 0)
-    read_objects_completed = Qnil;
-  return retval;
+  else if (EQ (stream, Qget_emacs_mule_file_char))
+    {
+      eassert (stream_file != NULL);
+      frame->intype = LREAD_INPUT_FILE_MULE;
+      init_infile (frame, stream_file, seekable, true, coding);
+    }
+  else if (NILP (stream))
+    {
+      frame->intype = LREAD_INPUT_NULL;
+      frame->char_offset = 0;
+      frame->byte_offset = 0;
+    }
+  else
+    {
+      /* Evidently this must be a function name or value */
+      frame->intype = LREAD_INPUT_PROCEDURE;
+      frame->input.p = (struct inproc) { .proc = Qnil };
+      frame->input.p.proc = stream;
+      frame->char_offset = 0;
+      frame->byte_offset = 0;
+    }
+  if (frame->intype != LREAD_INPUT_NULL)
+    {
+      /* start with defaults that aren't static (INIT_LREAD_FRAME())*/
+      frame->objects_map
+	= make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None);
+      frame->objects_completed
+	= make_hash_table (&hashtest_eq, DEFAULT_HASH_SIZE, Weak_None);
+    }
+  /* frame->multibyte must be initialized! */
+  if (frame->multibyte == LREAD_MULTIBYTE_INDETERMINATE)
+    frame->multibyte = LREAD_MULTIBYTE_TRUE;
+  initialize_readonechar (frame);
 }
-
-/* Grow a read buffer BUF that contains OFFSET useful bytes of data,
-   by at least MAX_MULTIBYTE_LENGTH bytes.  Update *BUF_ADDR and
-   *BUF_SIZE accordingly; 0 <= OFFSET <= *BUF_SIZE.  If *BUF_ADDR is
-   initially null, BUF is on the stack: copy its data to the new heap
-   buffer.  Otherwise, BUF must equal *BUF_ADDR and can simply be
-   reallocated.  Either way, remember the heap allocation (which is at
-   pdl slot COUNT) so that it can be freed when unwinding the stack.*/
 
-static char *
-grow_read_buffer (char *buf, ptrdiff_t offset,
-		  char **buf_addr, ptrdiff_t *buf_size, specpdl_ref count)
+void
+init_lread_eval_params (lread_frame *frame,
+			Lisp_Object full_name,
+			Lisp_Object name,
+			Lisp_Object readfun,
+			bool whole_buffer)
 {
-  char *p = xpalloc (*buf_addr, buf_size, MAX_MULTIBYTE_LENGTH, -1, 1);
-  if (!*buf_addr)
+  if (!NILP (full_name))
+    frame->full_name = full_name;
+  if (!NILP (name))
+    frame->name = name;
+  if (!NILP (frame->name) && NILP (frame->full_name))
     {
-      memcpy (p, buf, offset);
-      record_unwind_protect_ptr (xfree, p);
+      frame->full_name = Fexpand_file_name (frame->name, Qnil);
     }
-  else
-    set_unwind_protect_ptr (count, xfree, p);
-  *buf_addr = p;
-  return p;
+  if (!NILP (frame->full_name) && NILP (frame->name))
+    {
+      frame->name = Ffile_name_nondirectory (frame->full_name);
+    }
+  frame->sourcename = will_dump_p () ? frame->name : frame->full_name;
+  frame->readfun = readfun;
+  frame->whole_buffer = whole_buffer;
+
 }
 
+
+
+
 /* Return the scalar value that has the Unicode character name NAME.
    Raise 'invalid-read-syntax' if there is no such character.  */
-static int
-character_name_to_code (char const *name, ptrdiff_t name_len,
-			Lisp_Object readcharfun)
+int
+character_name_to_code (register lread_frame *frame, char const *name, ptrdiff_t name_len)
 {
   /* For "U+XXXX", pass the leading '+' to string_to_number to reject
      monstrosities like "U+-0000".  */
@@ -2855,7 +4326,7 @@ character_name_to_code (char const *name, ptrdiff_t name_len,
     {
       AUTO_STRING (format, "\\N{%s}");
       AUTO_STRING_WITH_LEN (namestr, name, name_len);
-      invalid_syntax_lisp (CALLN (Fformat, format, namestr), readcharfun);
+      invalid_syntax_lisp (frame, CALLN (Fformat, format, namestr));
     }
 
   return FIXNUMP (code) ? XFIXNUM (code) : -1;
@@ -2868,7 +4339,7 @@ character_name_to_code (char const *name, ptrdiff_t name_len,
 /* Read a character escape sequence, assuming we just read a backslash
    and one more character (next_char).  */
 static int
-read_char_escape (Lisp_Object readcharfun, int next_char)
+read_char_escape (register lread_frame *frame, int next_char)
 {
   int modifiers = 0;
   ptrdiff_t ncontrol = 0;
@@ -2882,7 +4353,7 @@ read_char_escape (Lisp_Object readcharfun, int next_char)
   switch (c)
     {
     case -1:
-      end_of_file_error ();
+      end_of_file_error (frame);
 
     case 'a': chr = '\a'; break;
     case 'b': chr = '\b'; break;
@@ -2908,13 +4379,13 @@ read_char_escape (Lisp_Object readcharfun, int next_char)
 
     mod_key:
       {
-	int c1 = READCHAR;
+	int c1 = READCHAR (frame);
 	if (c1 != '-')
 	  {
 	    if (c == 's')
 	      {
 		/* \s not followed by a hyphen is SPC.  */
-		UNREAD (c1);
+		UNREAD (frame, c1);
 		chr = ' ';
 		break;
 	      }
@@ -2923,10 +4394,10 @@ read_char_escape (Lisp_Object readcharfun, int next_char)
 	      error ("Invalid escape char syntax: \\%c not followed by -", c);
 	  }
 	modifiers |= mod;
-	c1 = READCHAR;
+	c1 = READCHAR (frame);
 	if (c1 == '\\')
 	  {
-	    next_char = READCHAR;
+	    next_char = READCHAR (frame);
 	    goto again;
 	  }
 	chr = c1;
@@ -2938,7 +4409,7 @@ read_char_escape (Lisp_Object readcharfun, int next_char)
        Keep a count of them and apply them separately.  */
     case 'C':
       {
-	int c1 = READCHAR;
+	int c1 = READCHAR (frame);
 	if (c1 != '-')
 	  error ("Invalid escape char syntax: \\%c not followed by -", c);
       }
@@ -2947,10 +4418,10 @@ read_char_escape (Lisp_Object readcharfun, int next_char)
     case '^':
       {
 	ncontrol++;
-	int c1 = READCHAR;
+	int c1 = READCHAR (frame);
 	if (c1 == '\\')
 	  {
-	    next_char = READCHAR;
+	    next_char = READCHAR (frame);
 	    goto again;
 	  }
 	chr = c1;
@@ -2965,10 +4436,10 @@ read_char_escape (Lisp_Object readcharfun, int next_char)
 	int count = 0;
 	while (count < 2)
 	  {
-	    int c = READCHAR;
+	    int c = READCHAR (frame);
 	    if (c < '0' || c > '7')
 	      {
-		UNREAD (c);
+		UNREAD (frame, c);
 		break;
 	      }
 	    i = (i << 3) + (c - '0');
@@ -2989,11 +4460,11 @@ read_char_escape (Lisp_Object readcharfun, int next_char)
 	int count = 0;
 	while (1)
 	  {
-	    int c = READCHAR;
+	    int c = READCHAR (frame);
 	    int digit = char_hexdigit (c);
 	    if (digit < 0)
 	      {
-		UNREAD (c);
+		UNREAD (frame, c);
 		break;
 	      }
 	    i = (i << 4) + digit;
@@ -3026,7 +4497,7 @@ read_char_escape (Lisp_Object readcharfun, int next_char)
 	unsigned int i = 0;
 	for (int count = 0; count < unicode_hex_count; count++)
 	  {
-	    int c = READCHAR;
+	    int c = READCHAR (frame);
 	    if (c < 0)
 	      error ("Malformed Unicode escape: \\%c%x",
 		     unicode_hex_count == 4 ? 'u' : 'U', i);
@@ -3045,26 +4516,25 @@ read_char_escape (Lisp_Object readcharfun, int next_char)
     /* Named character: \N{name} */
     case 'N':
       {
-        int c = READCHAR;
+	int c = READCHAR (frame);
         if (c != '{')
-          invalid_syntax ("Expected opening brace after \\N", readcharfun);
+	  invalid_syntax (frame, "Expected opening brace after \\N");
         char name[UNICODE_CHARACTER_NAME_LENGTH_BOUND + 1];
         bool whitespace = false;
         ptrdiff_t length = 0;
         while (true)
           {
-            int c = READCHAR;
+	    int c = READCHAR (frame);
             if (c < 0)
-              end_of_file_error ();
+	      end_of_file_error (frame);
             if (c == '}')
-              break;
+	      break;
             if (c >= 0x80)
               {
                 AUTO_STRING (format,
                              "Invalid character U+%04X in character name");
-		invalid_syntax_lisp (CALLN (Fformat, format,
-					    make_fixed_natnum (c)),
-				     readcharfun);
+		invalid_syntax_lisp (frame, CALLN (Fformat, format,
+						   make_fixed_natnum (c)));
               }
             /* Treat multiple adjacent whitespace characters as a
                single space character.  This makes it easier to use
@@ -3080,15 +4550,15 @@ read_char_escape (Lisp_Object readcharfun, int next_char)
               whitespace = false;
             name[length++] = c;
             if (length >= sizeof name)
-              invalid_syntax ("Character name too long", readcharfun);
-          }
-        if (length == 0)
-          invalid_syntax ("Empty character name", readcharfun);
+	      invalid_syntax (frame, "Character name too long");
+	  }
+	if (length == 0)
+	  invalid_syntax (frame, "Empty character name");
 	name[length] = '\0';
 
 	/* character_name_to_code can invoke read0, recursively.
 	   This is why read0 needs to be re-entrant.  */
-	chr = character_name_to_code (name, length, readcharfun);
+	chr = character_name_to_code (frame, name, length);
 	break;
       }
 
@@ -3098,7 +4568,7 @@ read_char_escape (Lisp_Object readcharfun, int next_char)
     }
   eassert (chr >= 0 && chr < (1 << CHARACTERBITS));
   if (chr < 0 || chr >= (1 << CHARACTERBITS))
-    invalid_syntax ("Invalid character", readcharfun);
+    invalid_syntax (frame, "Invalid character");
 
   /* Apply Control modifiers, using the rules:
      \C-X = ascii_ctrl(nomod(X)) | mods(X)  if nomod(X) is one of:
@@ -3146,13 +4616,13 @@ digit_to_number (int character, int base)
   return digit < base ? digit : -1;
 }
 
-static void
-invalid_radix_integer (EMACS_INT radix, Lisp_Object readcharfun)
+void
+invalid_radix_integer (register lread_frame *frame, EMACS_INT radix)
 {
   static char const format[] = "integer, radix %"pI"d";
   char buf[sizeof format - sizeof "%"pI"d" + INT_BUFSIZE_BOUND (radix)];
   sprintf (buf, format, radix);
-  invalid_syntax (buf, readcharfun);
+  invalid_syntax (frame, buf);
 }
 
 /* Read an integer in radix RADIX using READCHARFUN to read
@@ -3160,8 +4630,8 @@ invalid_radix_integer (EMACS_INT radix, Lisp_Object readcharfun)
    Value is the integer read.
    Signal an error if encountering invalid read syntax.  */
 
-static Lisp_Object
-read_integer (Lisp_Object readcharfun, int radix)
+Lisp_Object
+read_integer (register lread_frame *frame, int radix)
 {
   char stackbuf[20];
   char *read_buffer = stackbuf;
@@ -3171,11 +4641,11 @@ read_integer (Lisp_Object readcharfun, int radix)
   int valid = -1; /* 1 if valid, 0 if not, -1 if incomplete.  */
   specpdl_ref count = SPECPDL_INDEX ();
 
-  int c = READCHAR;
+  int c = READCHAR (frame);
   if (c == '-' || c == '+')
     {
       *p++ = c;
-      c = READCHAR;
+      c = READCHAR (frame);
     }
 
   if (c == '0')
@@ -3186,7 +4656,7 @@ read_integer (Lisp_Object readcharfun, int radix)
       /* Ignore redundant leading zeros, so the buffer doesn't
 	 fill up with them.  */
       do
-	c = READCHAR;
+	c = READCHAR (frame);
       while (c == '0');
     }
 
@@ -3206,13 +4676,13 @@ read_integer (Lisp_Object readcharfun, int radix)
 	  p = read_buffer + offset;
 	}
       *p++ = c;
-      c = READCHAR;
+      c = READCHAR (frame);
     }
 
-  UNREAD (c);
+  UNREAD (frame, c);
 
   if (valid != 1)
-    invalid_radix_integer (radix, readcharfun);
+    invalid_radix_integer (frame,radix);
 
   *p = '\0';
   return unbind_to (count, string_to_number (read_buffer, radix, NULL));
@@ -3220,12 +4690,12 @@ read_integer (Lisp_Object readcharfun, int radix)
 
 
 /* Read a character literal (preceded by `?').  */
-static Lisp_Object
-read_char_literal (Lisp_Object readcharfun)
+Lisp_Object
+read_char_literal (register lread_frame *frame)
 {
-  int ch = READCHAR;
+  int ch = READCHAR (frame);
   if (ch < 0)
-    end_of_file_error ();
+    end_of_file_error (frame);
 
   /* Accept `single space' syntax like (list ? x) where the
      whitespace character is SPC or TAB.
@@ -3234,7 +4704,7 @@ read_char_literal (Lisp_Object readcharfun)
   if (ch == ' ' || ch == '\t')
     return make_fixnum (ch);
 
-  if (   ch == '(' || ch == ')' || ch == '[' || ch == ']'
+  if (	 ch == '(' || ch == ')' || ch == '[' || ch == ']'
       || ch == '"' || ch == ';')
     {
       CHECK_LIST (Vlread_unescaped_character_literals);
@@ -3245,7 +4715,7 @@ read_char_literal (Lisp_Object readcharfun)
     }
 
   if (ch == '\\')
-    ch = read_char_escape (readcharfun, READCHAR);
+    ch = read_char_escape (frame, READCHAR (frame));
 
   int modifiers = ch & CHAR_MODIFIER_MASK;
   ch &= ~CHAR_MODIFIER_MASK;
@@ -3253,20 +4723,20 @@ read_char_literal (Lisp_Object readcharfun)
     ch = CHAR_TO_BYTE8 (ch);
   ch |= modifiers;
 
-  int nch = READCHAR;
-  UNREAD (nch);
+  int nch = READCHAR (frame);
+  UNREAD (frame, nch);
   if (nch <= 32
       || nch == '"' || nch == '\'' || nch == ';' || nch == '('
       || nch == ')' || nch == '['  || nch == ']' || nch == '#'
       || nch == '?' || nch == '`'  || nch == ',' || nch == '.')
     return make_fixnum (ch);
 
-  invalid_syntax ("?", readcharfun);
+  invalid_syntax (frame, "?");
 }
 
 /* Read a string literal (preceded by '"').  */
-static Lisp_Object
-read_string_literal (Lisp_Object readcharfun)
+Lisp_Object
+read_string_literal (register lread_frame *frame)
 {
   char stackbuf[1024];
   char *read_buffer = stackbuf;
@@ -3284,7 +4754,7 @@ read_string_literal (Lisp_Object readcharfun)
   ptrdiff_t nchars = 0;
 
   int ch;
-  while ((ch = READCHAR) >= 0 && ch != '\"')
+  while ((ch = READCHAR (frame)) >= 0 && ch != '\"')
     {
       if (end - p < MAX_MULTIBYTE_LENGTH)
 	{
@@ -3298,8 +4768,8 @@ read_string_literal (Lisp_Object readcharfun)
 
       if (ch == '\\')
 	{
-	  /* First apply string-specific escape rules:  */
-	  ch = READCHAR;
+	  /* First apply string-specific escape rules: */
+	  ch = READCHAR (frame);
 	  switch (ch)
 	    {
 	    case 's':
@@ -3311,7 +4781,7 @@ read_string_literal (Lisp_Object readcharfun)
 	      /* `\SPC' and `\LF' generate no characters at all.  */
 	      continue;
 	    default:
-	      ch = read_char_escape (readcharfun, ch);
+	      ch = read_char_escape (frame, ch);
 	      break;
 	    }
 
@@ -3356,7 +4826,7 @@ read_string_literal (Lisp_Object readcharfun)
 
 	  /* Any modifiers remaining are invalid.  */
 	  if (modifiers)
-	    invalid_syntax ("Invalid modifier in string", readcharfun);
+	    invalid_syntax (frame, "Invalid modifier in string");
 	  p += CHAR_STRING (ch, (unsigned char *) p);
 	}
       else
@@ -3371,7 +4841,7 @@ read_string_literal (Lisp_Object readcharfun)
     }
 
   if (ch < 0)
-    end_of_file_error ();
+    end_of_file_error (frame);
 
   if (!force_multibyte && force_singlebyte)
     {
@@ -3467,23 +4937,22 @@ vector_from_rev_list (Lisp_Object elems)
   return obj;
 }
 
-static Lisp_Object get_lazy_string (Lisp_Object val);
 
-static Lisp_Object
-bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
+Lisp_Object
+bytecode_from_rev_list (register lread_frame *frame, Lisp_Object elems)
 {
   Lisp_Object obj = vector_from_rev_list (elems);
   Lisp_Object *vec = XVECTOR (obj)->contents;
   ptrdiff_t size = ASIZE (obj);
 
-  if (infile && size >= CLOSURE_CONSTANTS)
+  if (frame->input.f.stream && size >= CLOSURE_CONSTANTS)
     {
       /* Always read 'lazily-loaded' bytecode (generated by the
          `byte-compile-dynamic' feature prior to Emacs 30) eagerly, to
          avoid code in the fast path during execution.  */
       if (CONSP (vec[CLOSURE_CODE])
           && FIXNUMP (XCDR (vec[CLOSURE_CODE])))
-        vec[CLOSURE_CODE] = get_lazy_string (vec[CLOSURE_CODE]);
+        vec[CLOSURE_CODE] = get_lazy_string (frame, vec[CLOSURE_CODE]);
 
       /* Lazily-loaded bytecode is represented by the constant slot being nil
          and the bytecode slot a (lazily loaded) string containing the
@@ -3494,13 +4963,13 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
 	  eassert (!STRING_MULTIBYTE (enc));
 	  /* The string (always unibyte) must be decoded to be parsed.  */
 	  enc = Fdecode_coding_string (enc,
-				       EQ (readcharfun,
-					   Qget_emacs_mule_file_char)
+				       (FROM_FILE_P (frame->intype)
+					&& frame->input.f.mule)
 				       ? Qemacs_mule : Qutf_8_emacs,
 				       Qt, Qnil);
 	  Lisp_Object pair = Fread (enc);
           if (!CONSP (pair))
-	    invalid_syntax ("Invalid byte-code object", readcharfun);
+	    invalid_syntax (frame, "Invalid byte-code object");
 
           vec[CLOSURE_CODE] = XCAR (pair);
           vec[CLOSURE_CONSTANTS] = XCDR (pair);
@@ -3518,7 +4987,7 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
 	    || (CONSP (vec[CLOSURE_CODE]) /* Interpreted function.  */
 	        && (CONSP (vec[CLOSURE_CONSTANTS])
 	            || NILP (vec[CLOSURE_CONSTANTS]))))))
-    invalid_syntax ("Invalid byte-code object", readcharfun);
+    invalid_syntax (frame, "Invalid byte-code object");
 
   if (STRINGP (vec[CLOSURE_CODE]))
     {
@@ -3538,19 +5007,19 @@ bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
   return obj;
 }
 
-static Lisp_Object
-char_table_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
+Lisp_Object
+char_table_from_rev_list (register lread_frame *frame, Lisp_Object elems)
 {
   Lisp_Object obj = vector_from_rev_list (elems);
   if (ASIZE (obj) < CHAR_TABLE_STANDARD_SLOTS)
-    invalid_syntax ("Invalid size char-table", readcharfun);
+    invalid_syntax (frame, "Invalid size char-table");
   XSETPVECTYPE (XVECTOR (obj), PVEC_CHAR_TABLE);
   return obj;
 
 }
 
-static Lisp_Object
-sub_char_table_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
+Lisp_Object
+sub_char_table_from_rev_list (register lread_frame *frame, Lisp_Object elems)
 {
   /* A sub-char-table can't be read as a regular vector because of two
      C integer fields.  */
@@ -3581,23 +5050,23 @@ sub_char_table_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
   return tbl;
 }
 
-static Lisp_Object
-string_props_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
+Lisp_Object
+string_props_from_rev_list (register lread_frame *frame, Lisp_Object elems)
 {
   elems = Fnreverse (elems);
   if (NILP (elems) || !STRINGP (XCAR (elems)))
-    invalid_syntax ("#", readcharfun);
+    invalid_syntax (frame, "#");
   Lisp_Object obj = XCAR (elems);
   for (Lisp_Object tl = XCDR (elems); !NILP (tl);)
     {
       Lisp_Object beg = XCAR (tl);
       tl = XCDR (tl);
       if (NILP (tl))
-	invalid_syntax ("Invalid string property list", readcharfun);
+	invalid_syntax (frame, "Invalid string property list");
       Lisp_Object end = XCAR (tl);
       tl = XCDR (tl);
       if (NILP (tl))
-	invalid_syntax ("Invalid string property list", readcharfun);
+	invalid_syntax (frame, "Invalid string property list");
       Lisp_Object plist = XCAR (tl);
       tl = XCDR (tl);
       Fset_text_properties (beg, end, plist, obj);
@@ -3606,35 +5075,35 @@ string_props_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
 }
 
 /* Read a bool vector (preceded by "#&").  */
-static Lisp_Object
-read_bool_vector (Lisp_Object readcharfun)
+Lisp_Object
+read_bool_vector (register lread_frame *frame)
 {
   EMACS_INT length = 0;
   for (;;)
     {
-      int c = READCHAR;
+      int c = READCHAR (frame);
       if (c < '0' || c > '9')
 	{
 	  if (c != '"')
-	    invalid_syntax ("#&", readcharfun);
+	    invalid_syntax (frame, "#&");
 	  break;
 	}
       if (ckd_mul (&length, length, 10)
 	  || ckd_add (&length, length, c - '0'))
-	invalid_syntax ("#&", readcharfun);
+	invalid_syntax (frame, "#&");
     }
   if (BOOL_VECTOR_LENGTH_MAX < length)
-    invalid_syntax ("#&", readcharfun);
+    invalid_syntax (frame, "#&");
 
   ptrdiff_t size_in_chars = bool_vector_bytes (length);
-  Lisp_Object str = read_string_literal (readcharfun);
+  Lisp_Object str = read_string_literal (frame);
   if (STRING_MULTIBYTE (str)
       || !(size_in_chars == SCHARS (str)
 	   /* We used to print 1 char too many when the number of bits
 	      was a multiple of 8.  Accept such input in case it came
 	      from an old version.  */
 	   || length == (SCHARS (str) - 1) * BOOL_VECTOR_BITS_PER_CHAR))
-    invalid_syntax ("#&...", readcharfun);
+    invalid_syntax (frame, "#&...");
 
   Lisp_Object obj = make_uninit_bool_vector (length);
   unsigned char *data = bool_vector_uchar_data (obj);
@@ -3648,14 +5117,14 @@ read_bool_vector (Lisp_Object readcharfun)
 /* Skip (and optionally remember) a lazily-loaded string
    preceded by "#@".  Return true if this was a normal skip,
    false if we read #@00 (which skips to EOB/EOF).  */
-static bool
-skip_lazy_string (Lisp_Object readcharfun)
+bool
+skip_lazy_string (register lread_frame *frame)
 {
   ptrdiff_t nskip = 0;
   ptrdiff_t digits = 0;
   for (;;)
     {
-      int c = READCHAR;
+      int c = READCHAR (frame);
       if (c < '0' || c > '9')
 	{
 	  if (nskip > 0)
@@ -3665,35 +5134,35 @@ skip_lazy_string (Lisp_Object readcharfun)
 	       a space.  */
 	    nskip--;
 	  else
-	    UNREAD (c);
+	    UNREAD (frame, c);
 	  break;
 	}
       if (ckd_mul (&nskip, nskip, 10)
 	  || ckd_add (&nskip, nskip, c - '0'))
-	invalid_syntax ("#@", readcharfun);
+	invalid_syntax (frame, "#@");
       digits++;
       if (digits == 2 && nskip == 0)
 	{
 	  /* #@00 means "read nil and skip to end" */
-	  skip_dyn_eof (readcharfun);
+	  skip_dyn_eof (frame);
 	  return false;
 	}
     }
 
-  if (load_force_doc_strings && FROM_FILE_P (readcharfun))
+  if (load_force_doc_strings && FROM_FILE_P (frame->intype))
     {
       /* If we are supposed to force doc strings into core right now,
 	 record the last string that we skipped,
 	 and record where in the file it comes from.  */
 
       /* First exchange the two saved_strings.  */
-      static_assert (ARRAYELTS (saved_strings) == 2);
-      struct saved_string t = saved_strings[0];
-      saved_strings[0] = saved_strings[1];
-      saved_strings[1] = t;
+      static_assert (ARRAYELTS (frame->saved_strings) == 2);
+      struct saved_string t = frame->saved_strings[0];
+      frame->saved_strings[0] = frame->saved_strings[1];
+      frame->saved_strings[1] = t;
 
       enum { extra = 100 };
-      struct saved_string *ss = &saved_strings[0];
+      struct saved_string *ss = &(frame->saved_strings[0]);
       if (ss->size == 0)
 	{
 	  ss->size = nskip + extra;
@@ -3705,14 +5174,14 @@ skip_lazy_string (Lisp_Object readcharfun)
 	  ss->string = xrealloc (ss->string, ss->size);
 	}
 
-      file_stream instream = infile->stream;
-      ss->position = (file_tell (instream) - infile->lookahead);
+      file_stream instream = frame->input.f.stream;
+      ss->position = (file_tell (instream) - frame->input.f.lookahead);
 
       /* Copy that many bytes into the saved string.  */
       ptrdiff_t i = 0;
       int c = 0;
-      for (int n = min (nskip, infile->lookahead); n > 0; n--)
-	ss->string[i++] = c = infile->buf[--infile->lookahead];
+      for (int n = min (nskip, frame->input.f.lookahead); n > 0; n--)
+	ss->string[i++] = c = frame->input.f.buf[--(frame->input.f.lookahead)];
       block_input ();
       for (; i < nskip && c >= 0; i++)
 	ss->string[i] = c = file_get_char (instream);
@@ -3722,15 +5191,15 @@ skip_lazy_string (Lisp_Object readcharfun)
     }
   else
     /* Skip that many bytes.  */
-    skip_dyn_bytes (readcharfun, nskip);
+    skip_dyn_bytes (frame, nskip);
 
   return true;
 }
 
 /* Given a lazy-loaded string designator VAL, return the actual string.
    VAL is (FILENAME . POS).  */
-static Lisp_Object
-get_lazy_string (Lisp_Object val)
+Lisp_Object
+get_lazy_string (register lread_frame *frame,Lisp_Object val)
 {
   /* Get a doc string from the file we are loading.
      If it's in a saved string, get it from there.
@@ -3744,8 +5213,8 @@ get_lazy_string (Lisp_Object val)
      strings started with an asterisk); take the absolute value for
      compatibility.  */
   EMACS_INT pos = eabs (XFIXNUM (XCDR (val)));
-  struct saved_string *ss = &saved_strings[0];
-  struct saved_string *ssend = ss + ARRAYELTS (saved_strings);
+  struct saved_string *ss = &(frame->saved_strings[0]);
+  struct saved_string *ssend = ss + ARRAYELTS (frame->saved_strings);
   while (ss < ssend
 	 && !(pos >= ss->position && pos < ss->position + ss->length))
     ss++;
@@ -3789,92 +5258,30 @@ symbol_char_span (const char *s)
   return p - s;
 }
 
-static void
-skip_space_and_comments (Lisp_Object readcharfun)
+void
+skip_space_and_comments (register lread_frame *frame)
 {
   int c;
   do
     {
-      c = READCHAR;
+      c = READCHAR (frame);
       if (c == ';')
 	do
-	  c = READCHAR;
+	  c = READCHAR (frame);
 	while (c >= 0 && c != '\n');
       if (c < 0)
-	end_of_file_error ();
+	end_of_file_error (frame);
     }
   while (c <= 32 || c == NO_BREAK_SPACE);
-  UNREAD (c);
+  UNREAD (frame, c);
 }
 
-/* When an object is read, the type of the top read stack entry indicates
-   the syntactic context.  */
-enum read_entry_type
-{
-				/* preceding syntactic context */
-  RE_list_start,		/* "(" */
-
-  RE_list,			/* "(" (+ OBJECT) */
-  RE_list_dot,			/* "(" (+ OBJECT) "." */
-
-  RE_vector,			/* "[" (* OBJECT) */
-  RE_record,			/* "#s(" (* OBJECT) */
-  RE_char_table,		/* "#^[" (* OBJECT) */
-  RE_sub_char_table,		/* "#^^[" (* OBJECT) */
-  RE_byte_code,			/* "#[" (* OBJECT) */
-  RE_string_props,		/* "#(" (* OBJECT) */
-
-  RE_special,			/* "'" | "#'" | "`" | "," | ",@" */
-
-  RE_numbered,			/* "#" (+ DIGIT) "=" */
-};
-
-struct read_stack_entry
-{
-  enum read_entry_type type;
-  union {
-    /* RE_list, RE_list_dot */
-    struct {
-      Lisp_Object head;		/* first cons of list */
-      Lisp_Object tail;		/* last cons of list */
-    } list;
-
-    /* RE_vector, RE_record, RE_char_table, RE_sub_char_table,
-       RE_byte_code, RE_string_props */
-    struct {
-      Lisp_Object elems;	/* list of elements in reverse order */
-      bool old_locate_syms;	/* old value of locate_syms */
-    } vector;
-
-    /* RE_special */
-    struct {
-      Lisp_Object symbol;	/* symbol from special syntax */
-    } special;
-
-    /* RE_numbered */
-    struct {
-      Lisp_Object number;	/* number as a fixnum */
-      Lisp_Object placeholder;	/* placeholder object */
-    } numbered;
-  } u;
-};
-
-struct read_stack
-{
-  struct read_stack_entry *stack;  /* base of stack */
-  ptrdiff_t size;		   /* allocated size in entries */
-  ptrdiff_t sp;			   /* current number of entries */
-};
-
-static struct read_stack rdstack = {NULL, 0, 0};
-
-void
-mark_lread (void)
+INLINE void
+mark_rdstack (struct read_stack *rdstack)
 {
-  /* Mark the read stack, which may contain data not otherwise traced */
-  for (ptrdiff_t i = 0; i < rdstack.sp; i++)
+  for (ptrdiff_t i = 0; i < rdstack->sp; i++)
     {
-      struct read_stack_entry *e = &rdstack.stack[i];
+      struct read_stack_entry *e = &(rdstack->stack[i]);
       switch (e->type)
 	{
 	case RE_list_start:
@@ -3903,77 +5310,144 @@ mark_lread (void)
     }
 }
 
+INLINE void
+mark_lread_input (lread_frame *frame)
+{
+  switch (frame->intype)
+    {
+    case LREAD_INPUT_FILE:
+    case LREAD_INPUT_FILE_MULE:
+      mark_object (frame->input.f.coding);
+      break;
+    case LREAD_INPUT_PROCEDURE:
+      mark_object (frame->input.p.proc);
+      break;
+    case LREAD_INPUT_MARKER:
+      mark_object (frame->input.m.marker);
+      mark_object (frame->input.m.b.buffer);
+      break;
+    case LREAD_INPUT_BUFFER:
+      mark_object (frame->input.b.buffer);
+      break;
+    case LREAD_INPUT_STRING:
+      mark_object (frame->input.s.string);
+      break;
+    case LREAD_INPUT_NULL:
+      break;
+    default:
+      /* do nothing */
+    }
+}
+void
+mark_lread (void)
+{
+  register lread_frame *frame = current_frame;
+  /* All the frame structures are allocated on the C stack somewhere
+     Not sure if this is redundant or required */
+  while (frame != NULL)
+    {
+      mark_lread_input (frame);
+      mark_rdstack (&(frame->rdstack));
+      mark_object (frame->loads_in_progress);
+      mark_object (frame->objects_map);
+      mark_object (frame->objects_completed);
+      mark_object (frame->start);
+      mark_object (frame->end);
+      mark_object (frame->full_name);
+      mark_object (frame->name);
+      mark_object (frame->sourcename);
+      mark_object (frame->readfun);
+      mark_object (frame->value);
+      mark_object (frame->error);
+      if (frame->mule_charset)
+	mark_object (frame->mule_charset->attributes);
+      frame = frame->prev;
+    }
+}
+
 static inline struct read_stack_entry *
-read_stack_top (void)
+read_stack_top (register lread_frame *frame)
 {
-  eassume (rdstack.sp > 0);
-  return &rdstack.stack[rdstack.sp - 1];
+  eassume (frame->rdstack.sp > 0);
+  return &(frame->rdstack.stack[frame->rdstack.sp - 1]);
 }
 
 static inline struct read_stack_entry *
-read_stack_pop (void)
+read_stack_pop (register lread_frame *frame)
 {
-  eassume (rdstack.sp > 0);
-  return &rdstack.stack[--rdstack.sp];
+
+
+
+  eassume (frame->rdstack.sp > 0);
+  return &(frame->rdstack.stack[--(frame->rdstack.sp)]);
 }
 
-static inline bool
-read_stack_empty_p (ptrdiff_t base_sp)
+INLINE bool
+read_stack_empty_p (register lread_frame *frame)
 {
-  return rdstack.sp <= base_sp;
+  eassert (frame->base_sp == 0);
+  return frame->rdstack.sp <= frame->base_sp;
 }
 
 NO_INLINE static void
-grow_read_stack (void)
+grow_read_stack (register lread_frame *frame)
 {
-  struct read_stack *rs = &rdstack;
+  struct read_stack *rs = &frame->rdstack;
   eassert (rs->sp == rs->size);
   rs->stack = xpalloc (rs->stack, &rs->size, 1, -1, sizeof *rs->stack);
   eassert (rs->sp < rs->size);
 }
 
-static inline void
-read_stack_push (struct read_stack_entry e)
+INLINE void
+read_stack_push (register lread_frame *frame,struct read_stack_entry e)
 {
-  if (rdstack.sp >= rdstack.size)
-    grow_read_stack ();
-  rdstack.stack[rdstack.sp++] = e;
+  if (frame->rdstack.sp >= frame->rdstack.size)
+    grow_read_stack (frame);
+  frame->rdstack.stack[frame->rdstack.sp++] = e;
 }
 
 static void
-read_stack_reset (intmax_t sp)
-{
-  eassert (sp <= rdstack.sp);
-  rdstack.sp = sp;
-}
-
-#define READ_AND_BUFFER(c)			\
-  c = READCHAR;					\
-  if (c < 0)					\
-    INVALID_SYNTAX_WITH_BUFFER ();		\
-  if (multibyte)				\
-    p += CHAR_STRING (c, (unsigned char *) p);	\
-  else						\
-    *p++ = c;					\
-  if (end - p < MAX_MULTIBYTE_LENGTH + 1)	\
-    {						\
-       offset = p - read_buffer;		\
-       read_buffer = grow_read_buffer (read_buffer, offset, \
-				       &heapbuf, &read_buffer_size, count); \
-       p = read_buffer + offset;					\
-       end = read_buffer + read_buffer_size;				\
-    }
-
-#define INVALID_SYNTAX_WITH_BUFFER()		\
+read_stack_reset (void *p)
+{
+  register lread_frame *frame = p;
+  /* note this base_sp seems to be from when read0 used C-level recursion,
+     so the base_sp pointed to the bottom of the read stack for the
+     particular read0 activation.  Now there is only one activation
+     of read0, so the base_sp is always 0.  This assert is just to verify
+     that before removing base_sp altogether.  */
+  eassert (frame->base_sp == 0);
+  eassert (frame->base_sp <= frame->rdstack.sp);
+  frame->rdstack.sp = frame->base_sp;
+}
+
+#define READ_AND_BUFFER(frame,c)					\
+  c = READCHAR (frame);							\
+  if (c < 0)								\
+    INVALID_SYNTAX_WITH_BUFFER (frame);					\
+  if (frame->multibyte)							\
+    p += CHAR_STRING (c, (unsigned char *) p);				\
+  else									\
+    *p++ = c;								\
+  if (end - p < MAX_MULTIBYTE_LENGTH + 1)				\
+    {									\
+      offset = p - read_buffer;						\
+      read_buffer = grow_read_buffer (read_buffer, offset,		\
+				      &heapbuf, &read_buffer_size,	\
+				      count);				\
+      p = read_buffer + offset;						\
+      end = read_buffer + read_buffer_size;				\
+    }
+
+#define INVALID_SYNTAX_WITH_BUFFER(frame)	\
   {						\
     *p = 0;					\
-    invalid_syntax (read_buffer, readcharfun);	\
+    invalid_syntax (frame, read_buffer);	\
   }
 
 /* Read a Lisp object.
    If LOCATE_SYMS is true, symbols are read with position.  */
-static Lisp_Object
-read0 (Lisp_Object readcharfun, bool locate_syms)
+Lisp_Object
+read0 (register lread_frame *frame)
 {
   char stackbuf[64];
   char *read_buffer = stackbuf;
@@ -3982,8 +5456,10 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
   char *heapbuf = NULL;
 
   specpdl_ref base_pdl = SPECPDL_INDEX ();
-  ptrdiff_t base_sp = rdstack.sp;
-  record_unwind_protect_intmax (read_stack_reset, base_sp);
+  /* This assignment of base_sp should always be 0.
+     Maybe it was useful when read0/read1 used recursive calls?*/
+  frame->base_sp = frame->rdstack.sp;
+  record_unwind_protect_ptr (read_stack_reset, frame);
 
   specpdl_ref count = SPECPDL_INDEX ();
 
@@ -3991,37 +5467,37 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
   bool skip_shorthand;
 
   /* Read an object into `obj'.  */
- read_obj: ;
+ read_obj:
   Lisp_Object obj;
-  bool multibyte;
-  int c = READCHAR_REPORT_MULTIBYTE (&multibyte);
+
+  int c = READCHAR (frame);
   if (c < 0)
-    end_of_file_error ();
+    end_of_file_error (frame);
 
   switch (c)
     {
     case '(':
-      read_stack_push ((struct read_stack_entry) {.type = RE_list_start});
+      read_stack_push (frame,(struct read_stack_entry) {.type = RE_list_start});
       goto read_obj;
 
     case ')':
-      if (read_stack_empty_p (base_sp))
-	invalid_syntax (")", readcharfun);
-      switch (read_stack_top ()->type)
+      if (read_stack_empty_p (frame))
+	invalid_syntax (frame, ")");
+      switch (read_stack_top (frame)->type)
 	{
 	case RE_list_start:
-	  read_stack_pop ();
+	  read_stack_pop (frame);
 	  obj = Qnil;
 	  break;
 	case RE_list:
-	  obj = read_stack_pop ()->u.list.head;
+	  obj = read_stack_pop (frame)->u.list.head;
 	  break;
 	case RE_record:
 	  {
-	    locate_syms = read_stack_top ()->u.vector.old_locate_syms;
-	    Lisp_Object elems = Fnreverse (read_stack_pop ()->u.vector.elems);
+	    frame->locate_syms = read_stack_top (frame)->u.vector.old_locate_syms;
+	    Lisp_Object elems = Fnreverse (read_stack_pop (frame)->u.vector.elems);
 	    if (NILP (elems))
-	      invalid_syntax ("#s", readcharfun);
+	      invalid_syntax (frame, "#s");
 
 	    if (BASE_EQ (XCAR (elems), Qhash_table))
 	      obj = hash_table_from_plist (XCDR (elems));
@@ -4030,50 +5506,46 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 	    break;
 	  }
 	case RE_string_props:
-	  locate_syms = read_stack_top ()->u.vector.old_locate_syms;
-	  obj = string_props_from_rev_list (read_stack_pop () ->u.vector.elems,
-					    readcharfun);
+	  frame->locate_syms = read_stack_top (frame)->u.vector.old_locate_syms;
+	  obj = string_props_from_rev_list (frame, read_stack_pop (frame) ->u.vector.elems);
 	  break;
 	default:
-	  invalid_syntax (")", readcharfun);
+	  invalid_syntax (frame, ")");
 	}
       break;
 
     case '[':
-      read_stack_push ((struct read_stack_entry) {
+      read_stack_push (frame, (struct read_stack_entry) {
 	  .type = RE_vector,
 	  .u.vector.elems = Qnil,
-	  .u.vector.old_locate_syms = locate_syms,
+	  .u.vector.old_locate_syms = frame->locate_syms,
 	});
-      /* FIXME: should vectors be read with locate_syms=false?  */
+      /* FIXME: should vectors be read with locate_syms=false?	*/
       goto read_obj;
 
     case ']':
-      if (read_stack_empty_p (base_sp))
-	invalid_syntax ("]", readcharfun);
-      switch (read_stack_top ()->type)
+      if (read_stack_empty_p (frame))
+	invalid_syntax (frame, "]");
+      switch (read_stack_top (frame)->type)
 	{
 	case RE_vector:
-	  locate_syms = read_stack_top ()->u.vector.old_locate_syms;
-	  obj = vector_from_rev_list (read_stack_pop ()->u.vector.elems);
+	  frame->locate_syms = read_stack_top (frame)->u.vector.old_locate_syms;
+	  obj = vector_from_rev_list (read_stack_pop (frame)->u.vector.elems);
 	  break;
 	case RE_byte_code:
-	  locate_syms = read_stack_top ()->u.vector.old_locate_syms;
-	  obj = bytecode_from_rev_list (read_stack_pop ()->u.vector.elems,
-					readcharfun);
+	  frame->locate_syms = read_stack_top (frame)->u.vector.old_locate_syms;
+	  obj = bytecode_from_rev_list (frame,read_stack_pop (frame)->u.vector.elems);
 	  break;
 	case RE_char_table:
-	  locate_syms = read_stack_top ()->u.vector.old_locate_syms;
-	  obj = char_table_from_rev_list (read_stack_pop ()->u.vector.elems,
-					  readcharfun);
+	  frame->locate_syms = read_stack_top (frame)->u.vector.old_locate_syms;
+	  obj = char_table_from_rev_list (frame, read_stack_pop (frame)->u.vector.elems);
 	  break;
 	case RE_sub_char_table:
-	  locate_syms = read_stack_top ()->u.vector.old_locate_syms;
-	  obj = sub_char_table_from_rev_list (read_stack_pop ()->u.vector.elems,
-					      readcharfun);
+	  frame->locate_syms = read_stack_top (frame)->u.vector.old_locate_syms;
+	  obj = sub_char_table_from_rev_list (frame, read_stack_pop (frame)->u.vector.elems);
 	  break;
 	default:
-	  invalid_syntax ("]", readcharfun);
+	  invalid_syntax (frame, "]");
 	  break;
 	}
       break;
@@ -4085,13 +5557,13 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 
 	*p++ = '#';
 	int ch;
-	READ_AND_BUFFER (ch);
+	READ_AND_BUFFER (frame,ch);
 
 	switch (ch)
 	  {
 	  case '\'':
 	    /* #'X -- special syntax for (function X) */
-	    read_stack_push ((struct read_stack_entry) {
+	    read_stack_push (frame, (struct read_stack_entry) {
 		.type = RE_special,
 		.u.special.symbol = Qfunction,
 	      });
@@ -4104,82 +5576,82 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 
 	  case 's':
 	    /* #s(...) -- a record or hash-table */
-	    READ_AND_BUFFER (ch);
+	    READ_AND_BUFFER (frame,ch);
 	    if (ch != '(')
 	      {
-		UNREAD (ch);
-		INVALID_SYNTAX_WITH_BUFFER ();
+		UNREAD (frame, ch);
+		INVALID_SYNTAX_WITH_BUFFER (frame);
 	      }
-	    read_stack_push ((struct read_stack_entry) {
+	    read_stack_push (frame, (struct read_stack_entry) {
 		.type = RE_record,
 		.u.vector.elems = Qnil,
-		.u.vector.old_locate_syms = locate_syms,
+		.u.vector.old_locate_syms = frame->locate_syms,
 	      });
-	    locate_syms = false;
+	    frame->locate_syms = false;
 	    goto read_obj;
 
 	  case '^':
 	    /* #^[...]  -- char-table
 	       #^^[...] -- sub-char-table */
-	    READ_AND_BUFFER (ch);
+	    READ_AND_BUFFER (frame,ch);
 	    if (ch == '^')
 	      {
-		ch = READCHAR;
+		ch = READCHAR (frame);
 		if (ch == '[')
 		  {
-		    read_stack_push ((struct read_stack_entry) {
+		    read_stack_push (frame, (struct read_stack_entry) {
 			.type = RE_sub_char_table,
 			.u.vector.elems = Qnil,
-			.u.vector.old_locate_syms = locate_syms,
+			.u.vector.old_locate_syms = frame->locate_syms,
 		      });
-		    locate_syms = false;
+		    frame->locate_syms = false;
 		    goto read_obj;
 		  }
 		else
 		  {
-		    UNREAD (ch);
-		    INVALID_SYNTAX_WITH_BUFFER ();
+		    UNREAD (frame, ch);
+		    INVALID_SYNTAX_WITH_BUFFER (frame);
 		  }
 	      }
 	    else if (ch == '[')
 	      {
-		read_stack_push ((struct read_stack_entry) {
+		read_stack_push (frame, (struct read_stack_entry) {
 		    .type = RE_char_table,
 		    .u.vector.elems = Qnil,
-		    .u.vector.old_locate_syms = locate_syms,
+		    .u.vector.old_locate_syms = frame->locate_syms,
 		  });
-		locate_syms = false;
+		frame->locate_syms = false;
 		goto read_obj;
 	      }
 	    else
 	      {
-		UNREAD (ch);
-		INVALID_SYNTAX_WITH_BUFFER ();
+		UNREAD (frame, ch);
+		INVALID_SYNTAX_WITH_BUFFER (frame);
 	      }
 
 	  case '(':
 	    /* #(...) -- string with properties */
-	    read_stack_push ((struct read_stack_entry) {
+	    read_stack_push (frame, (struct read_stack_entry) {
 		.type = RE_string_props,
 		.u.vector.elems = Qnil,
-		.u.vector.old_locate_syms = locate_syms,
+		.u.vector.old_locate_syms = frame->locate_syms,
 	      });
-	    locate_syms = false;
+	    frame->locate_syms = false;
 	    goto read_obj;
 
 	  case '[':
 	    /* #[...] -- byte-code */
-	    read_stack_push ((struct read_stack_entry) {
+	    read_stack_push (frame, (struct read_stack_entry) {
 		.type = RE_byte_code,
 		.u.vector.elems = Qnil,
-		.u.vector.old_locate_syms = locate_syms,
+		.u.vector.old_locate_syms = frame->locate_syms,
 	      });
-	    locate_syms = false;
+	    frame->locate_syms = false;
 	    goto read_obj;
 
 	  case '&':
 	    /* #&N"..." -- bool-vector */
-	    obj = read_bool_vector (readcharfun);
+	    obj = read_bool_vector (frame);
 	    break;
 
 	  case '!':
@@ -4188,31 +5660,31 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 	    {
 	      int c;
 	      do
-		c = READCHAR;
+		c = READCHAR (frame);
 	      while (c >= 0 && c != '\n');
 	      goto read_obj;
 	    }
 
 	  case 'x':
 	  case 'X':
-	    obj = read_integer (readcharfun, 16);
+	    obj = read_integer (frame, 16);
 	    break;
 
 	  case 'o':
 	  case 'O':
-	    obj = read_integer (readcharfun, 8);
+	    obj = read_integer (frame, 8);
 	    break;
 
 	  case 'b':
 	  case 'B':
-	    obj = read_integer (readcharfun, 2);
+	    obj = read_integer (frame, 2);
 	    break;
 
 	  case '@':
 	    /* #@NUMBER is used to skip NUMBER following bytes.
 	       That's used in .elc files to skip over doc strings
 	       and function definitions that can be loaded lazily.  */
-	    if (skip_lazy_string (readcharfun))
+	    if (skip_lazy_string (frame))
 	      goto read_obj;
 	    obj = Qnil;	      /* #@00 skips to EOB/EOF and yields nil.  */
 	    break;
@@ -4224,14 +5696,14 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 
 	  case ':':
 	    /* #:X -- uninterned symbol */
-	    c = READCHAR;
+	    c = READCHAR (frame);
 	    if (c <= 32 || c == NO_BREAK_SPACE
 		|| c == '"' || c == '\'' || c == ';' || c == '#'
 		|| c == '(' || c == ')'  || c == '[' || c == ']'
 		|| c == '`' || c == ',')
 	      {
 		/* No symbol character follows: this is the empty symbol.  */
-		UNREAD (c);
+		UNREAD (frame, c);
 		obj = Fmake_symbol (empty_unibyte_string);
 		break;
 	      }
@@ -4241,14 +5713,14 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 
 	  case '_':
 	    /* #_X -- symbol without shorthand */
-	    c = READCHAR;
+	    c = READCHAR (frame);
 	    if (c <= 32 || c == NO_BREAK_SPACE
 		|| c == '"' || c == '\'' || c == ';' || c == '#'
 		|| c == '(' || c == ')'  || c == '[' || c == ']'
 		|| c == '`' || c == ',')
 	      {
 		/* No symbol character follows: this is the empty symbol.  */
-		UNREAD (c);
+		UNREAD (frame, c);
 		obj = Fintern (empty_unibyte_string, Qnil);
 		break;
 	      }
@@ -4264,19 +5736,19 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 		int c;
 		for (;;)
 		  {
-		    READ_AND_BUFFER (c);
+		    READ_AND_BUFFER (frame,c);
 		    if (c < '0' || c > '9')
 		      break;
 		    if (ckd_mul (&n, n, 10)
 			|| ckd_add (&n, n, c - '0'))
-		      INVALID_SYNTAX_WITH_BUFFER ();
+		      INVALID_SYNTAX_WITH_BUFFER (frame);
 		  }
 		if (c == 'r' || c == 'R')
 		  {
 		    /* #NrDIGITS -- radix-N number */
 		    if (n < 2 || n > 36)
-		      invalid_radix_integer (n, readcharfun);
-		    obj = read_integer (readcharfun, n);
+		      invalid_radix_integer (frame,n);
+		    obj = read_integer (frame, n);
 		    break;
 		  }
 		else if (n <= MOST_POSITIVE_FIXNUM && !NILP (Vread_circle))
@@ -4287,7 +5759,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 			Lisp_Object placeholder = Fcons (Qnil, Qnil);
 
 			struct Lisp_Hash_Table *h
-			  = XHASH_TABLE (read_objects_map);
+			  = XHASH_TABLE (frame->objects_map);
 			Lisp_Object number = make_fixnum (n);
 			hash_hash_t hash;
 			ptrdiff_t i = hash_find_get_hash (h, number, &hash);
@@ -4296,7 +5768,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 			  set_hash_value_slot (h, i, placeholder);
 			else
 			  hash_put (h, number, placeholder, hash);
-			read_stack_push ((struct read_stack_entry) {
+			read_stack_push (frame, (struct read_stack_entry) {
 			    .type = RE_numbered,
 			    .u.numbered.number = number,
 			    .u.numbered.placeholder = placeholder,
@@ -4307,42 +5779,42 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 		      {
 			/* #N# -- reference to numbered object */
 			struct Lisp_Hash_Table *h
-			  = XHASH_TABLE (read_objects_map);
+			  = XHASH_TABLE (frame->objects_map);
 			ptrdiff_t i = hash_find (h, make_fixnum (n));
 			if (i < 0)
-			  INVALID_SYNTAX_WITH_BUFFER ();
+			  INVALID_SYNTAX_WITH_BUFFER (frame);
 			obj = HASH_VALUE (h, i);
 			break;
 		      }
 		    else
-		      INVALID_SYNTAX_WITH_BUFFER ();
+		      INVALID_SYNTAX_WITH_BUFFER (frame);
 		  }
 		else
-		  INVALID_SYNTAX_WITH_BUFFER ();
+		  INVALID_SYNTAX_WITH_BUFFER (frame);
 	      }
 	    else
-	      INVALID_SYNTAX_WITH_BUFFER ();
+	      INVALID_SYNTAX_WITH_BUFFER (frame);
 	  }
 	break;
       }
 
     case '?':
-      obj = read_char_literal (readcharfun);
+      obj = read_char_literal (frame);
       break;
 
     case '"':
-      obj = read_string_literal (readcharfun);
+      obj = read_string_literal (frame);
       break;
 
     case '\'':
-      read_stack_push ((struct read_stack_entry) {
+      read_stack_push (frame, (struct read_stack_entry) {
 	  .type = RE_special,
 	  .u.special.symbol = Qquote,
 	});
       goto read_obj;
 
     case '`':
-      read_stack_push ((struct read_stack_entry) {
+      read_stack_push (frame, (struct read_stack_entry) {
 	  .type = RE_special,
 	  .u.special.symbol = Qbackquote,
 	});
@@ -4350,17 +5822,17 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 
     case ',':
       {
-	int ch = READCHAR;
+	int ch = READCHAR (frame);
 	Lisp_Object sym;
 	if (ch == '@')
 	  sym = Qcomma_at;
 	else
 	  {
 	    if (ch >= 0)
-	      UNREAD (ch);
+	      UNREAD (frame, ch);
 	    sym = Qcomma;
 	  }
-	read_stack_push ((struct read_stack_entry) {
+	read_stack_push (frame, (struct read_stack_entry) {
 	    .type = RE_special,
 	    .u.special.symbol = sym,
 	  });
@@ -4371,27 +5843,27 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
       {
 	int c;
 	do
-	  c = READCHAR;
+	  c = READCHAR (frame);
 	while (c >= 0 && c != '\n');
 	goto read_obj;
       }
 
     case '.':
       {
-	int nch = READCHAR;
-	UNREAD (nch);
+	int nch = READCHAR (frame);
+	UNREAD (frame, nch);
 	if (nch <= 32 || nch == NO_BREAK_SPACE
 	    || nch == '"' || nch == '\'' || nch == ';'
 	    || nch == '(' || nch == '[' || nch == '#'
 	    || nch == '?' || nch == '`' || nch == ',')
 	  {
-	    if (!read_stack_empty_p (base_sp)
-		&& read_stack_top ()->type ==  RE_list)
+	    if (!read_stack_empty_p (frame)
+		&& read_stack_top (frame)->type ==  RE_list)
 	      {
-		read_stack_top ()->type = RE_list_dot;
+		read_stack_top (frame)->type = RE_list_dot;
 		goto read_obj;
 	      }
-	    invalid_syntax (".", readcharfun);
+	    invalid_syntax (frame, ".");
 	  }
       }
       /* may be a number or symbol starting with a dot */
@@ -4409,7 +5881,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 	char *p = read_buffer;
 	char *end = read_buffer + read_buffer_size;
 	bool quoted = false;
-	EMACS_INT start_position = readchar_offset - 1;
+	EMACS_INT start_position = frame->char_offset - 1;
 
 	do
 	  {
@@ -4425,17 +5897,17 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 
 	    if (c == '\\')
 	      {
-		c = READCHAR;
+		c = READCHAR (frame);
 		if (c < 0)
-		  end_of_file_error ();
+		  end_of_file_error (frame);
 		quoted = true;
 	      }
 
-	    if (multibyte)
+	    if (frame->multibyte)
 	      p += CHAR_STRING (c, (unsigned char *) p);
 	    else
 	      *p++ = c;
-	    c = READCHAR;
+	    c = READCHAR (frame);
 	  }
 	while (c > 32
 	       && c != NO_BREAK_SPACE
@@ -4446,7 +5918,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 
 	*p = 0;
 	ptrdiff_t nbytes = p - read_buffer;
-	UNREAD (c);
+	UNREAD (frame, c);
 
 	/* Only attempt to parse the token as a number if it starts as one.  */
 	char c0 = read_buffer[0];
@@ -4464,14 +5936,14 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 
 	/* symbol, possibly uninterned */
 	ptrdiff_t nchars
-	  = (multibyte
+	  = (frame->multibyte
 	     ? multibyte_chars_in_text ((unsigned char *)read_buffer, nbytes)
 	     : nbytes);
 	Lisp_Object result;
 	if (uninterned_symbol)
 	  {
 	    Lisp_Object name
-	      = make_specified_string (read_buffer, nchars, nbytes, multibyte);
+	      = make_specified_string (read_buffer, nchars, nbytes, frame->multibyte);
 	    result = Fmake_symbol (name);
 	  }
 	else
@@ -4507,18 +5979,18 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 		Lisp_Object name = make_specified_string (longhand,
 							  longhand_chars,
 							  longhand_bytes,
-							  multibyte);
+							  frame->multibyte);
 		xfree (longhand);
 		result = intern_driver (name, obarray, found);
 	      }
 	    else
 	      {
 		Lisp_Object name = make_specified_string (read_buffer, nchars,
-							  nbytes, multibyte);
+							  nbytes, frame->multibyte);
 		result = intern_driver (name, obarray, found);
 	      }
 	  }
-	if (locate_syms && !NILP (result))
+	if (frame->locate_syms && !NILP (result))
 	  result = build_symbol_with_pos (result,
 					  make_fixnum (start_position));
 
@@ -4529,9 +6001,9 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 
   /* We have read an object in `obj'.  Use the stack to decide what to
      do with it.  */
-  while (rdstack.sp > base_sp)
+  while (frame->rdstack.sp > frame->base_sp)
     {
-      struct read_stack_entry *e = read_stack_top ();
+      struct read_stack_entry *e = read_stack_top (frame);
       switch (e->type)
 	{
 	case RE_list_start:
@@ -4549,12 +6021,12 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 
 	case RE_list_dot:
 	  {
-	    skip_space_and_comments (readcharfun);
-	    int ch = READCHAR;
+	    skip_space_and_comments (frame);
+	    int ch = READCHAR (frame);
 	    if (ch != ')')
-	      invalid_syntax ("expected )", readcharfun);
+	      invalid_syntax (frame, "expected )");
 	    XSETCDR (e->u.list.tail, obj);
-	    read_stack_pop ();
+	    read_stack_pop (frame);
 	    obj = e->u.list.head;
 
 	    /* Hack: immediately convert (#$ . FIXNUM) to the corresponding
@@ -4563,7 +6035,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 		&& BASE_EQ (XCAR (obj), Vload_file_name)
 		&& !NILP (XCAR (obj))
 		&& FIXNUMP (XCDR (obj)))
-	      obj = get_lazy_string (obj);
+	      obj = get_lazy_string (frame, obj);
 
 	    break;
 	  }
@@ -4578,19 +6050,19 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 	  goto read_obj;
 
 	case RE_special:
-	  read_stack_pop ();
+	  read_stack_pop (frame);
 	  obj = list2 (e->u.special.symbol, obj);
 	  break;
 
 	case RE_numbered:
 	  {
-	    read_stack_pop ();
+	    read_stack_pop (frame);
 	    Lisp_Object placeholder = e->u.numbered.placeholder;
 	    if (CONSP (obj))
 	      {
 		if (BASE_EQ (obj, placeholder))
 		  /* Catch silly games like #1=#1# */
-		  invalid_syntax ("nonsensical self-reference", readcharfun);
+		  invalid_syntax (frame, "nonsensical self-reference");
 
 		/* Optimization: since the placeholder is already
 		   a cons, repurpose it as the actual value.
@@ -4601,7 +6073,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 		Fsetcdr (placeholder, XCDR (obj));
 
 		struct Lisp_Hash_Table *h2
-		  = XHASH_TABLE (read_objects_completed);
+		  = XHASH_TABLE (frame->objects_completed);
 		hash_hash_t hash;
 		ptrdiff_t i = hash_find_get_hash (h2, placeholder, &hash);
 		eassert (i < 0);
@@ -4616,7 +6088,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 		    && !(STRINGP (obj) && !string_intervals (obj)))
 		  {
 		    struct Lisp_Hash_Table *h2
-		      = XHASH_TABLE (read_objects_completed);
+		      = XHASH_TABLE (frame->objects_completed);
 		    hash_hash_t hash;
 		    ptrdiff_t i = hash_find_get_hash (h2, obj, &hash);
 		    eassert (i < 0);
@@ -4625,10 +6097,10 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 
 		/* Now put it everywhere the placeholder was...  */
 		Flread__substitute_object_in_subtree (obj, placeholder,
-						      read_objects_completed);
+						      frame->objects_completed);
 
 		/* ...and #n# will use the real value from now on.  */
-		struct Lisp_Hash_Table *h = XHASH_TABLE (read_objects_map);
+		struct Lisp_Hash_Table *h = XHASH_TABLE (frame->objects_map);
 		hash_hash_t hash;
 		ptrdiff_t i = hash_find_get_hash (h, e->u.numbered.number,
 						  &hash);
@@ -4639,7 +6111,8 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 	  }
 	}
     }
-
+  /* Attempt to flush any unread char and/or buffered bytes */
+  closing_unreadchar (frame);
   return unbind_to (base_pdl, obj);
 }
 
@@ -4900,14 +6373,6 @@ string_to_number (char const *string, int base, ptrdiff_t *plen)
 }
 
 
-static Lisp_Object initial_obarray;
-
-/* `oblookup' stores the bucket number here, for the sake of Funintern.  */
-
-static size_t oblookup_last_bucket_number;
-
-static Lisp_Object make_obarray (unsigned bits);
-
 /* Slow path obarray check: return the obarray to use or signal an error.  */
 Lisp_Object
 check_obarray_slow (Lisp_Object obarray)
@@ -5149,14 +6614,14 @@ DEFUN ("unintern", Funintern, Sunintern, 2, 2, 0,
 					SCHARS (string), SBYTES (string),
 					&longhand, &longhand_chars,
 					&longhand_bytes);
-  if (longhand)
-    xfree(longhand);
-
-  if (FIXNUMP (tem))
-    return Qnil;
+  if (FIXNUMP (tem)
   /* If arg was a symbol, don't delete anything but that symbol itself.  */
-  if (BARE_SYMBOL_P (name) && !BASE_EQ (name, tem))
-    return Qnil;
+      || (BARE_SYMBOL_P (name) && !BASE_EQ (name, tem)))
+    {
+      if (longhand)
+	xfree (longhand);
+      return Qnil;
+    }
 
   /* There are plenty of other symbols which will screw up the Emacs
      session if we unintern them, as well as even more ways to use
@@ -5168,7 +6633,24 @@ DEFUN ("unintern", Funintern, Sunintern, 2, 2, 0,
   struct Lisp_Symbol *sym = XBARE_SYMBOL (tem);
   sym->u.s.interned = SYMBOL_UNINTERNED;
 
-  ptrdiff_t idx = oblookup_last_bucket_number;
+  ptrdiff_t idx = -1;
+  {
+    /* Removed static variable oblookup_last_bucket_number micro-optimization
+       Don't use a static variable just to avoid this
+       - how frequently used is unintern that using a static variable
+       to optimize away this redundant index calculation would be
+       worth adding a second reference parameter? */
+    struct Lisp_Obarray *o = XOBARRAY (obarray);
+    if (longhand)
+      {
+	idx = obarray_index (o, longhand, longhand_bytes);
+	xfree (longhand);
+      }
+    else
+      {
+	idx = obarray_index (o,SSDATA (string), SBYTES (string));
+      }
+  }
   Lisp_Object *loc = &XOBARRAY (obarray)->buckets[idx];
 
   eassert (BARE_SYMBOL_P (*loc));
@@ -5194,7 +6676,7 @@ DEFUN ("unintern", Funintern, Sunintern, 2, 2, 0,
 
 
 /* Bucket index of the string STR of length SIZE_BYTE bytes in obarray OA.  */
-static ptrdiff_t
+ptrdiff_t
 obarray_index (struct Lisp_Obarray *oa, const char *str, ptrdiff_t size_byte)
 {
   EMACS_UINT hash = hash_char_array (str, size_byte);
@@ -5215,7 +6697,6 @@ oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff
   ptrdiff_t idx = obarray_index (o, ptr, size_byte);
   Lisp_Object bucket = o->buckets[idx];
 
-  oblookup_last_bucket_number = idx;
   if (!BASE_EQ (bucket, make_fixnum (0)))
     {
       Lisp_Object sym = bucket;
@@ -5801,7 +7282,15 @@ init_lread (void)
   Vload_file_name = Qnil;
   Vload_true_file_name = Qnil;
   Vstandard_input = Qt;
-  Vloads_in_progress = Qnil;
+
+  stdin_infile.s.stream = stdin;
+  stdin_infile.s.lookahead = 0;
+  memset (stdin_infile.s.buf, 0, sizeof(stdin_infile.s.buf));
+  /* We treat stdin as a fifo even if it really is a regular file */
+  stdin_infile.s.seekable = false;
+  stdin_infile.unread_char = -1;
+  stdin_infile.unread_bytes = 0;
+  stdin_infile.read_eof = false;
 }
 
 /* Print a warning that directory intended for use USE and with name
@@ -5838,6 +7327,185 @@ dir_warning (char const *use, Lisp_Object dirname)
     }
 }
 
+void
+activate_lread_frame (lread_frame *new_frame, lread_frame_type new_type)
+{
+  register lread_frame *frame = current_frame;
+  /* assume type, intype, input, and locate_syms
+     fields have been initialized by entry point */
+  eassert (new_frame->intype != LREAD_INPUT_UNINIT);
+  /* Update the stdin stream data as it may be used recursively */
+  if (frame && frame->intype == LREAD_INPUT_FILE
+      && (frame->input.f.stream == stdin))
+    {
+      stdin_infile.s.lookahead = frame->input.f.lookahead;
+      memcpy (stdin_infile.s.buf, frame->input.f.buf, sizeof(stdin_infile.s.buf));
+      stdin_infile.byte_offset = frame->byte_offset;
+      stdin_infile.char_offset = frame->char_offset;
+      stdin_infile.unread_char = frame->unread_char;
+      stdin_infile.unread_bytes = frame->unread_bytes;
+      stdin_infile.read_eof = frame->read_eof;
+    }
+  if (new_frame != frame)
+    /* Fload may reuse an activated dummy frame */
+    new_frame->prev = frame;
+  frame = new_frame;
+  frame->type = new_type;
+  if (current_frame && current_frame != frame)
+    frame->loads_in_progress = current_frame->loads_in_progress;
+
+  /* change the standard initialization as needed for different input types */
+  switch (frame->intype)
+    {
+    case LREAD_INPUT_FILE:
+    case LREAD_INPUT_FILE_MULE:
+      if (frame->input.f.stream == stdin)
+	{
+	  frame->unread_char = stdin_infile.unread_char;
+	  frame->read_eof = stdin_infile.read_eof;
+	  frame->char_offset = stdin_infile.char_offset;
+	  frame->byte_offset = stdin_infile.byte_offset;
+	}
+      else if (frame->input.f.seekable &&
+	       (ftello (frame->input.f.stream) != 0))
+	{
+	  fseeko (frame->input.f.stream, 0, SEEK_SET);
+	}
+      break;
+    case LREAD_INPUT_STRING:
+      {
+	frame->char_offset = frame->input.s.start;
+	frame->byte_offset
+	  = string_char_to_byte (frame->input.s.string,
+				 frame->input.s.start);
+	/* frame->multibyte = STRING_MULTIBYTE (frame->input.s.string); */
+      }
+      break;
+    case LREAD_INPUT_PROCEDURE:
+      frame->char_offset = 0;
+      frame->byte_offset = 0;
+      /* implicitly encoded as emacs-internal,
+	 as we only ever see the character values */
+      /* frame->multibyte = LREAD_MULTIBYTE_TRUE; */
+      break;
+    case LREAD_INPUT_BUFFER:
+      {
+	struct buffer *b = XBUFFER (frame->input.b.buffer);
+	frame->char_offset = BUF_PT (b);
+	frame->byte_offset = BUF_PT_BYTE (b);
+	/* frame->multibyte = ! NILP (BVAR (b, enable_multibyte_characters)); */
+      }
+      break;
+    case LREAD_INPUT_MARKER:
+      {
+	struct buffer *b = XBUFFER (frame->input.m.b.buffer);
+	frame->char_offset = BUF_PT (b);
+	frame->byte_offset = BUF_PT_BYTE (b);
+	/* frame->multibyte = ! NILP (BVAR (b, enable_multibyte_characters)); */
+      }
+      break;
+    case LREAD_INPUT_BINARY:
+    case LREAD_INPUT_NULL:
+      /* nothing to do */
+      break;
+    case LREAD_INPUT_INDIRECT:
+      {
+	lread_frame *source = frame->input.frame.source;
+	/* copy the items that reflect information for *reading*,
+	   not evaluating
+	   If reader-input-stream is called during an interrupt
+	   in the middle of a read, we ignore any interruption
+	   of object_map and objects_completed
+	*/
+	frame->unread_char = source->unread_char;
+	frame->unread_bytes = source->unread_bytes;
+	frame->read_eof = source->read_eof;
+	frame->char_offset = source->char_offset;
+	frame->byte_offset = source->byte_offset;
+	frame->saved_strings[0] = source->saved_strings[0];
+	frame->saved_strings[1] = source->saved_strings[1];
+	frame->multibyte = source->multibyte;
+	frame->start = source->start;
+	frame->end = source->end;
+	frame->full_name = source->full_name;
+	frame->name = source->name;
+	frame->sourcename = source->sourcename;
+	frame->mule_charset = source->mule_charset;
+      }
+      break;
+      UNRECOGNIZED_LREAD_INPUT_CASES("activate_lread_frame");
+    }
+  if (current_frame != frame)
+    {
+      /* don't pop twice */
+      frame->restore_frame_idx = SPECPDL_INDEX();
+      record_unwind_protect_ptr (restore_lread_frame, current_frame);
+      current_frame = frame;
+    }
+}
+
+void
+restore_lread_frame (void *p)
+{
+  register lread_frame *frame = current_frame;
+
+  /* Update the stdin stream data as it may be used recursively */
+  if (frame->intype == LREAD_INPUT_FILE
+      && frame->input.f.stream == stdin)
+    {
+      stdin_infile.s.lookahead = frame->input.f.lookahead;
+      memcpy (stdin_infile.s.buf, frame->input.f.buf, sizeof(stdin_infile.s.buf));
+      stdin_infile.unread_char = frame->unread_char;
+      stdin_infile.read_eof = frame->read_eof;
+      stdin_infile.char_offset = frame->char_offset;
+      stdin_infile.byte_offset = frame->byte_offset;
+    }
+  if (frame->intype == LREAD_INPUT_INDIRECT)
+    {
+      lread_frame *source = frame->input.frame.source;
+      source->start = frame->start;
+      source->end = frame->end;
+    }
+  frame = (lread_frame *) p;
+  /* change the standard initialization as needed for different input types */
+  if (frame)
+    {
+      switch (frame->intype)
+	{
+	case LREAD_INPUT_FILE:
+	case LREAD_INPUT_FILE_MULE:
+	  /* I'm not sure anything else has access to these stream objects,
+	     except maybe through "reader-input-stream",
+	     but just in case, ensure we are at the same offset
+	     Otherwise, ensure "seekable" flag is off */
+	  if (frame->input.f.seekable)
+	    {
+	      fseeko (frame->input.f.stream, (off_t) frame->byte_offset, SEEK_SET);
+	    }
+	  break;
+	case LREAD_INPUT_STRING:
+	case LREAD_INPUT_PROCEDURE:
+	  /* Mulitbyte cannot be changed here*/
+	  break;
+	case LREAD_INPUT_BUFFER:
+	case LREAD_INPUT_MARKER:
+	  /* Might have changed multibyte*/
+	  report_lread_multibyte (frame);
+	  initialize_readonechar (frame);
+	  break;
+	case LREAD_INPUT_BINARY:
+	case LREAD_INPUT_NULL:
+	  /* nothing to do */
+	  break;
+	case LREAD_INPUT_INDIRECT:
+	  /* nothing to do, maybe */
+	  break;
+	  UNRECOGNIZED_LREAD_INPUT_CASES("restore_lread_frame");
+	}
+    }
+  current_frame = frame;
+}
+
 void
 syms_of_lread (void)
 {
@@ -5850,6 +7518,7 @@ syms_of_lread (void)
   defsubr (&Sunintern);
   defsubr (&Sget_load_suffixes);
   defsubr (&Sload);
+  defsubr (&Seval_stream);
   defsubr (&Seval_buffer);
   defsubr (&Seval_region);
   defsubr (&Sread_char);
@@ -5862,6 +7531,7 @@ syms_of_lread (void)
   defsubr (&Sobarrayp);
   defsubr (&Sobarray_clear);
 
+
   DEFVAR_LISP ("obarray", Vobarray,
 	       doc: /* Symbol table for use by `intern' and `read'.
 It is a vector whose length ought to be prime for best results.
@@ -6146,11 +7816,22 @@ syms_of_lread (void)
   DEFSYM (Qstandard_input, "standard-input");
   DEFSYM (Qread_char, "read-char");
   DEFSYM (Qget_file_char, "get-file-char");
-
+  DEFSYM (Qreader_input_stream, "reader-input-stream");
+  defsubr (&Sreader_input_stream);
   /* Used instead of Qget_file_char while loading *.elc files compiled
      by Emacs 21 or older.  */
   DEFSYM (Qget_emacs_mule_file_char, "get-emacs-mule-file-char");
 
+  /* This is an internal signal for skipping handlers when an interrupt
+     produces an unhandled signal*/
+  DEFSYM (Qerror_during_interrupt,"error-during-interrupt");
+  /* This is used for skipping frames, so no other handlers are allowed to intercept*/
+  Fput (Qerror_during_interrupt, Qerror_conditions,
+	Qnil);
+  Fput (Qerror_during_interrupt, Qerror_message,
+	build_string ("Unhandled error-during-interrupt: internal error"));
+
+
   DEFSYM (Qload_force_doc_strings, "load-force-doc-strings");
 
   DEFSYM (Qbackquote, "`");
@@ -6175,13 +7856,6 @@ syms_of_lread (void)
   DEFSYM (Qdir_ok, "dir-ok");
   DEFSYM (Qdo_after_load_evaluation, "do-after-load-evaluation");
 
-  staticpro (&read_objects_map);
-  read_objects_map = Qnil;
-  staticpro (&read_objects_completed);
-  read_objects_completed = Qnil;
-
-  Vloads_in_progress = Qnil;
-  staticpro (&Vloads_in_progress);
 
   DEFSYM (Qhash_table, "hash-table");
   DEFSYM (Qdata, "data");
-- 
2.49.0

From 95d44b1f5fd0e43dbd9ae1c5d796135ab54584e6 Mon Sep 17 00:00:00 2001
From: Onnie Lynn Winebarger <[email-masked]>
Date: Mon, 7 Jul 2025 08:22:54 -0400
Subject: [PATCH 10/12] Base support for noneditor infrastructure in eval.c

---
 src/eval.c  | 84 +++++++++++++++++++++--------------------------------
 src/lisp.h  |  3 +-
 src/lread.c |  2 +-
 3 files changed, 36 insertions(+), 53 deletions(-)

diff --git a/src/eval.c b/src/eval.c
index 104953e8482..0ca0d94328d 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -347,29 +347,20 @@ do_debug_on_call (Lisp_Object code, specpdl_ref count)
    temacs executable without executing "loadup" and exit normally.
 */
 
-struct
-{
-  int nargs;
-  char **args;
-  int nexprs;
-  int arg_i;
-  Lisp_Object arg;
-  int err_kind;
-  Lisp_Object err;
-} noneditor;
+struct noneditor_state noneditor;
 
 typedef Lisp_Object (*noneditor_proc)(void);
 static Lisp_Object noneditor_eval_shim (void);
 static Lisp_Object noneditor_eval_args (void);
-static Lisp_Object noneditor_eval_stdin_thunk (void);
-static Lisp_Object noneditor_dispatch (void);
+static Lisp_Object noneditor_eval_stdin (void);
+static Lisp_Object noneditor_dispatch (void *);

 Lisp_Object
 noneditor_eval_shim (void)
 {
   Lisp_Object shim = build_string (exe_config->s.shim);
-  return noneditor_eval_stream (shim, &(noneditor.nexprs), &(noneditor.err));
+  return eval_stream (shim, &(noneditor.nexprs));
 }
 
 Lisp_Object
@@ -381,33 +372,32 @@ noneditor_eval_args (void)
 	noneditor.arg_i++)
     {
       noneditor.arg = build_string (noneditor.args[noneditor.arg_i]);
-      val = noneditor_eval_stream (noneditor.arg, &(noneditor.nexprs),
-				   &(noneditor.err));
+      val = eval_stream (noneditor.arg, &(noneditor.nexprs));
     }
   return val;
 }
 
 Lisp_Object
-noneditor_eval_stdin_thunk (void)
+noneditor_eval_stdin (void)
 {
-  return noneditor_eval_stream (Qstdin, &(noneditor.nexprs), &(noneditor.err));
+  return eval_stream (Qstdin, &(noneditor.nexprs));
 }
 
 Lisp_Object
-noneditor_dispatch (void)
+noneditor_dispatch (void *ignored)
 {
   if (EXE_CONFIGURED_EVAL_SHIM(exe_config))
     noneditor_eval_shim();
   else if (NILP (Vnoneditor))
     fatal ("noneditor must be non-nil when used as main process "
-	   "without a hard-coded lisp program.");
+	   "without a lisp program shim.");
 
   if (EQ (Vnoneditor,Qt))
     {
       Vcommand_line_args = Qnil;
       Lisp_Object val = noneditor_eval_args();
       if (noneditor.nexprs == 0)
-	val = noneditor_eval_stdin_thunk();
+	val = noneditor_eval_stdin();
       return val;
     }
 
@@ -419,8 +409,9 @@ noneditor_dispatch (void)

   if (EQ (Vnoneditor,Qstdin))
-      return noneditor_eval_stdin_thunk();
+      return noneditor_eval_stdin();
 
+  /* Otherwise, executing expression '(noneditor)' */
   noneditor.nexprs = 1;
   if (FUNCTIONP (Vnoneditor))
       return funcall_general (Vnoneditor, 0, NULL);
@@ -454,35 +445,27 @@ noneditor_catchall (enum nonlocal_exit exit_kind, Lisp_Object data)
 	return Qnil;
       }
     case NONLOCAL_EXIT_THROW:
+      {
+	Lisp_Object old_level, old_length;
+	fprintf(stderr,"Unhandled exception encountered in noneditor mode.\n");
+	/* Avoid unquittable loop if data contains a circular list.  */
+	old_level = Vprint_level;
+	old_length = Vprint_length;
+	XSETFASTINT (Vprint_level, 10);
+	XSETFASTINT (Vprint_length, 10);
+	print_error_message (data, Qexternal_debugging_output,"",
+			     Vsignaling_function);
+	Fterpri (Qexternal_debugging_output, Qnil);
+	Vprint_level = old_level;
+	Vprint_length = old_length;
+	return Qnil;
+      }
+    default:
+      fatal ("Unrecognized kind of nonlocal exit.");
     }
+  eassume (false);
 }
 
-/* Cut down version of cmd_error */
-static Lisp_Object
-noneditor_base_condition_handler (Lisp_Object data)
-{
-  Lisp_Object old_level, old_length;
-  fprintf(stderr,"Error encountered in bare eval.\n");
-  /* Avoid unquittable loop if data contains a circular list.  */
-  old_level = Vprint_level;
-  old_length = Vprint_length;
-  XSETFASTINT (Vprint_level, 10);
-  XSETFASTINT (Vprint_length, 10);
-  print_error_message (data, Qexternal_debugging_output,"", Vsignaling_function);
-  Fterpri (Qexternal_debugging_output, Qnil);
-  Vprint_level = old_level;
-  Vprint_length = old_length;
-  noneditor_eval_err = Qt;
-
-  return Qt;
-}
-
-static Lisp_Object
-noneditor_condition_trampoline (Lisp_Object ignored)
-{
-  return internal_condition_case (noneditor_dispatch, Qerror,
-				  noneditor_base_condition_handler);
-}
 
 /* Evaluate expressions in either a bare or non-standard
    dump implementing a stand-alone noneditor program.
@@ -504,14 +487,13 @@ noneditor_main (int nargs, char **args)
   Fset (Qstandard_output, Qexternal_standard_output);
   Fset (Qstandard_input, Qexternal_standard_input);
   /* Fset (Qstandard_input,Qget_file_char); */
-  Lisp_Object val = internal_catch (Qtop_level,
-				    noneditor_condition_trampoline,
-				    Qnil);
+  internal_catch_all (noneditor_dispatch, NULL,
+		      noneditor_catchall);
   /* if (noneditor.nexprs == 0) */
   /*   fatal ("Bare evaluation mode found no expressions to evaluate"); */
 
   shut_down_emacs (0,Qnil);
-  int exit_code = EQ (noneditor_eval_err, Qnil) ? 0 : 1;
+  int exit_code = EQ (noneditor.err, Qnil) ? 0 : 1;
   exit(exit_code);
 }
 
diff --git a/src/lisp.h b/src/lisp.h
index 7fb7705dbf4..41b443fae5a 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -4955,13 +4955,14 @@ CHECK_KEYWORD_ARGS (ptrdiff_t nargs)
 
 extern void noneditor_main (int nargs, char **args);
 extern Lisp_Object noneditor_catchall (enum nonlocal_exit,Lisp_Object);
-extern struct
+extern struct noneditor_state
 {
   int nargs;
   char **args;
   int nexprs;
   int arg_i;
   Lisp_Object  arg;
+  int err_kind;
   Lisp_Object err;
 } noneditor;
 
diff --git a/src/lread.c b/src/lread.c
index 24d74e16ee5..9456ce412f4 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3909,7 +3909,7 @@ save_frame_nexprs (void *p)
   if (current_frame && p)
     {
       int *nexprs = p;
-      *nexprs = current_frame->nexprs;
+      *nexprs += current_frame->nexprs;
     }
 }
 
-- 
2.49.0

From e880b019633ded05a775d940a3e35236a9032246 Mon Sep 17 00:00:00 2001
From: Onnie Lynn Winebarger <[email-masked]>
Date: Mon, 7 Jul 2025 20:31:50 -0400
Subject: [PATCH 12/12] Cleanup remaining compiler warnings from new code

---
 src/emacs.c | 8 --------
 src/eval.c  | 3 ---
 2 files changed, 11 deletions(-)

diff --git a/src/emacs.c b/src/emacs.c
index c9e740d50db..2b593cee7f9 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -4003,11 +4003,7 @@ DEFUN ("get-emacs-executable-fingerprint-data",
     }
   record_unwind_protect_ptr(release_fingerprint_buffer, (void *) fb);
   uint64_t ec_size = fb->hdr->size;
-  exe_config_header *ech = (exe_config_header *) fb->hdr->data;
-  uint64_t flags0 = ech->flags;
-  char *argv0_base0 = ech->argv0_base;
   uint64_t ec_shim_sz = ec_size - offsetof (exe_config_header, shim);
-  char *shim0 = ech->shim;
 
   if (NILP (max_shim_size))
     max_shim_size = make_fixnum (ec_shim_sz-1);
@@ -4146,8 +4142,6 @@ DEFUN ("make-custom-emacs-executable",
 		       build_string ("Invalid hash option: %S"),
 		       hash));
     }
-  bool keep_basename = EQ (basename, Qoriginal) || EQ (basename, Qnil);
-  bool clear_basename = (EQ (basename, Qreset) || EQ (basename, Qclear));
   bool keep_shim = EQ (shim, Qoriginal);
   bool clear_shim = (EQ (shim, Qreset) || EQ (shim, Qclear));
   char *filename;
@@ -4227,7 +4221,6 @@ DEFUN ("make-custom-emacs-executable",
   uint64_t flags0 = ech->flags;
   char *argv0_base0 = ech->argv0_base;
   uint64_t ec_shim_sz = ec_size - offsetof (exe_config_header, shim);
-  char *shim0 = ech->shim;
 
   uint64_t flags = process_custom_executable_flags (flags0, flag_ls);
 
@@ -4235,7 +4228,6 @@ DEFUN ("make-custom-emacs-executable",
   ptrdiff_t basename_size = 0;
   if (NILP (basename))
     {
-      keep_basename = true;
       basename_bytes = argv0_base0;
       basename_size = ECFG_ARGV0_BASE_SIZE;
     }
diff --git a/src/eval.c b/src/eval.c
index 0ca0d94328d..98876ac8283 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -486,11 +486,8 @@ noneditor_main (int nargs, char **args)
   Fset (Qstandard_error, Qexternal_debugging_output);
   Fset (Qstandard_output, Qexternal_standard_output);
   Fset (Qstandard_input, Qexternal_standard_input);
-  /* Fset (Qstandard_input,Qget_file_char); */
   internal_catch_all (noneditor_dispatch, NULL,
 		      noneditor_catchall);
-  /* if (noneditor.nexprs == 0) */
-  /*   fatal ("Bare evaluation mode found no expressions to evaluate"); */
 
   shut_down_emacs (0,Qnil);
   int exit_code = EQ (noneditor.err, Qnil) ? 0 : 1;
-- 
2.49.0

From c68a82dcc54a43244295e67fe4bf878741918f26 Mon Sep 17 00:00:00 2001
From: Onnie Lynn Winebarger <[email-masked]>
Date: Mon, 7 Jul 2025 20:21:47 -0400
Subject: [PATCH 11/12] Make the shim run in editor mode if configured.

* Use eval_stream to run the shim code before invoking recursive-edit.
* Remove final remnant of the use of the start parameter to readevalloop
  to indicate when DYNAMIC_WIND behavior is required for eval-region.
* When running uninstalled, the default load path for uninitialized
  emacs in noneditor mode should be the the same as if dumping.
---
 src/emacs.c | 38 +++++++++++++++++++++++---------------
 src/lread.c |  8 +++-----
 2 files changed, 26 insertions(+), 20 deletions(-)

diff --git a/src/emacs.c b/src/emacs.c
index 7c38ec0bbc5..c9e740d50db 100644
--- a/src/emacs.c
+++ b/src/emacs.c
@@ -1304,6 +1304,14 @@ maybe_load_seccomp (int argc, char **argv)
 #endif  /* SECCOMP_USABLE */
 static char *temacs = NULL;
 
+/* for protected evaluation of hard-coded shim in editor mode */
+static Lisp_Object
+eval_shim (void *ignored)
+{
+  Lisp_Object shim = build_string (exe_config->s.shim);
+  return eval_stream (shim, &(noneditor.nexprs));
+}
+
 #if !defined HAVE_ANDROID || defined ANDROID_STUBIFY
 int
 main (int argc, char **argv)
@@ -2597,7 +2605,7 @@ android_emacs_init (int argc, char **argv, char *dump_file)
   init_sfntfont_android ();
 #endif
 
-  if (!initialized && !NILP (Vnoneditor))
+  if (!initialized && NILP (Vnoneditor))
     {
       char *file;
       /* Handle -l loadup, args passed by Makefile.  */
@@ -2679,20 +2687,20 @@ android_emacs_init (int argc, char **argv, char *dump_file)
   if (EXE_CONFIGURED_EVAL_SHIM (exe_config)
       && *(exe_config->s.shim))
     {
-      Lisp_Object x = CALLN (Fconcat,
-			     build_string ("(progn "),
-			     build_string (exe_config->s.shim),
-			     build_string (" )"));
-      x = list2 (Qeval, list2 (Qread, x));
-
-      /* evaluate the shim program then usual top-level
-	 ensure top-level is set back to the usual value
-	 so the shim is only evaluated once (by this mechanism, at least)
-	 but give the shim a chance to modify it */
-      Vtop_level = list4 (Qprogn,
-			  list3 (Qsetq, Qtop_level, Vtop_level),
-			  x,
-			  list2 (Qeval, Vtop_level));
+      specpdl_ref count = SPECPDL_INDEX ();
+      /* Set up just for evaluating the shim*/
+      noneditor.nargs = 0;
+      noneditor.args = NULL;
+      noneditor.nexprs = 0;
+      noneditor.arg_i = 0;
+      noneditor.arg = Qnil;
+
+      specbind (Qlexical_binding, Qt);
+      specbind (Qstandard_error, Qexternal_debugging_output);
+      specbind (Qstandard_output, Qexternal_standard_output);
+      specbind (Qstandard_input, Qexternal_standard_input);
+      internal_catch_all (eval_shim, NULL, noneditor_catchall);
+      unbind_to (count, Qnil);
     }
 
   /* Enter editor command loop.  This never returns.  */
diff --git a/src/lread.c b/src/lread.c
index 9456ce412f4..2a23cd215b5 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -3787,10 +3787,6 @@ readevalloop (Lisp_Object frameptr)
        been done already.  */
     macroexpand = Qnil;
 
-  /* We assume START is nil when input is not from a buffer.  */
-  if (! NILP (frame->start) && !b)
-    emacs_abort ();
-
   /* edebug's instrumentation mechanism wraps load-read-function
      and requires the stream argument to be the current-buffer.
      Just using Qreader_input_stream breaks this undocumented
@@ -7160,7 +7156,9 @@ load_path_check (Lisp_Object lpath)
 static Lisp_Object
 load_path_default (void)
 {
-  if (will_dump_p ())
+  /* Use PATH_DUMPLOADSEARCH if running in bare environment
+     from the build directory.  */
+  if (will_dump_p () || (!initialized && ! NILP (Vinstallation_directory)))
     /* PATH_DUMPLOADSEARCH is the lisp dir in the source directory.
        We used to add ../lisp (ie the lisp dir in the build
        directory) at the front here, but that should not be
-- 
2.49.0