Subject: Re: bug#78898: Make read/readevalloop reentrant

From: Lynn Winebarger <[email-masked]>
Date: Tue, 1 Jul 2025 02:43:04 -0400

Hi, Stefan,
I've attached an updated patch that removes (I think) the
modifications that aren't actually for re-entrancy of
read/readevalloop.
I think I got all of the unintentional whitespace changes backed out as well.
I also applied one of Pip's changes, and the fix that lets it compile
and start without a hitch, setting file streams to load as multibyte,
since the utf-8-emacs decoding was always in the readchar function.
I ran "make check", and attached a short elisp file I used to load the
ones with failures as well as the results of "M-x ert t".
It looks like eval-buffer doesn't restore the buffer state correctly
at least some of the time.

Also, the rx-tests fail because (load "<...>/rx-tests.elc") has a
failure in read0 - something is screwy that seems to be related to the
#@10 near the beginning, since readevalloop successfully evaluates the
first exec-byte-code form (the whole thing is available as "val" in
the frame when I look through the backtrace), but read0 starts the
next expression 10 characters back at a "]".  Which, I don't know how
it goes back by 10 characters when it's just reading a stdio stream
one character at a time.  I'll have to investigate further.

On Sun, Jun 29, 2025 at 11:55 PM Stefan Monnier
<[email-masked]> wrote:
>
> >>     temacs ... '(progn (blabla))'
> >>
> >> I still can't see why you'd need a reentrant `read` for that.
> >
> > Basically the latter, because I was looking at using it Makefiles and
> > didn't want to deal with generating little files to load.  If I was
> > willing to limit the strings to single expressions, you'd be right,
> > but why should the form a program is input (string, file, buffer,
> > whatever) determine what's allowed?
>
> I don't understand the connection.
> Hmm... oh, is it because when you use `read` on a string it can read
> only the first sexp?  If so, I kinda see your point, but since you know
> you're starting from a string, you can use `read-from-string` which
> returns the info needed for the loop that reads all the sexps.
>
> > I did try to get by with just save/restore on the string variables,
> > but it failed when evaluating '(load "loadup.el") (print "Finished")".
>
> I still can't imagine what that "just save/restore on the string
> variables" looked like.
>
> > The failure certainly seems like an issue caused by some subtlety in
> > the way recursive use of readevalloop is implemented, but I can't
>
> From which I gather the above "just save/restore on the string
> variables" somehow involved `readevalloop`, but I don't know how.
>
> > bring myself to try and figure out a workaround for the specific
> > brokenness when I could just rework it to be sure its reentrant, then
> > see if that fixes the issue.
>
> 🙂
> Seems like a big hammer for that little problem.
> But if it can get you to improve our code, who are we to judge, eh?
>
> > Or maybe the problem I'm solving is my ignorance of how the Emacs
> > runtime works in practice?  A lack of amusing pasttimes?  A stubborn
> > refusal to accept things that do not make sense to me?
>
> You're at the right place.

Also, this kind of exercise is just table stakes if I ever want to try
my hand at some of the ideas I've been bouncing around emacs-devel for
years now.  Like encapsulating the lisp machine so a single process
can have multiple lisps running, then work out distributed data
structures, etc.  Having a gc that supports concurrency will remove
the biggest blocker for that.
>
> >> Any hope you can give us an actual concrete scenario?
> > I keep giving you one, you just consider it unnecessary.
>
> No, I just can't imagine how you get from the problem you describe to an
> attempted solution that uses `readevalloop` (from there I see how you
> got to the re-entrancy thingy).
>
Maybe it will make more sense once I submit the crazy feature I've
implemented that this started with.  I needed a basic trampoline in
place of command-loop, since Frecursive_edit requires things that
aren't available without loadup.el loaded.

> >> >> How/when&why do you expect/want `read` to be called recursively?
> >> > It can definitely be entered multiple times if a stream being read
> >> > blocks and the command loop executes another function that calls read.
> >> > That can clearly happen when reading from user-supplied procedures or
> >> > a raw stdio stream (i.e. from "load").
> >>
> >> A concrete scenario would help, here as well.
> >
> > Ok, there are calls to maybe quit in readbyte_from_stdio where the
> > file returns EOF due to an interrupt.  So, if one function is reading
> > a lisp expression when this occurs, then the user type "M-: (read
> > <something>)", you will have a recursive re-entry to read.
>
> Hmm... IIRC `maybe_quit` is not supposed to run ELisp code.
> The more likely path to the problem would seem to be via a stream
> that's a function.
>
> In any case, if you don't know of a recipe to reproduce the problem,
> don't bother looking for one, I was asking because I thought you had
> bumped into one, so you could just exhibit it, I didn't mean to ask you
> to reverse-engineer it from the code.
>
> [ FWIW, I definitely believe you that it's possible.  But I expect we
>   have *many* potential problems like these in our code base, so unless
>   we have a clear way to solve a whole class of them I'd rather focus on
>   the ones that are known to occur in existing code.  ]
>
> > It's not really intended to be a procedure, just a static initializer.
>
> I understand, but functions are just so much better behaved than macros
> that it's worth avoiding macros when a function can be used just as well.
>
> > I haven't regularly programmed in C since the decade I learned the
> > language from the recently published K&R 2nd edition, so my style
> > discipline is pretty low.
>
> That was my assumption.  Since then, compilers have gotten much better
> at inlining functions, so you can do
>
>     init_inbuffer (&x);
>
> and they'll generate the same code as it does with your
>
>     struct inbuffer x = INIT_INBUFFER ();
>
> [ Well, admittedly, not with `-O0`.  ]
>
> Note also that
>
>     struct inbuffer x = { .buffer = buf };
>
> should work just as well, so maybe "nothing" is an even better option
> than either.

I noticed that, now, I was only using those macros in one place each,
so I've just done away with the macros and written them out (in the
attached patch).

>
> > It took me forever to work out a "missing braces" message was
> > referring to a specpdl_ref initializer in the INIT_LREAD_FRAME.
>
> 🙂
>
> >> Also, why do you need the "uninit" case?
> > That's my unfamiliarity with C99 and zero-initializing a union
> > and being certain it zeros the entire thing and not just the
> > first alternative.
>
> Ah I see.  AFAIK `memset` is the standard solution.
> `grep` shows it's used extensively in our code for that very purpose.
> [ Current C compilers routinely replace calls to `memset` and `memcpy`
>   with open-coded machine code when the size is known at compile-time.  ]

I don't have a style discipline (at least not once GNU's style is
chosen - my preferences run to more compact presentations).  But I do
have a kind of aesthetic preference for writing constant values as
literals (compound literals in this case).  I mean, that is definitely
a LISP heritage that's shown up in C and other imperative languages.

I may follow up on some of the other points later, but maybe I should
give you a chance to look at the cleaned up patch.

Lynn
From d9e8b81a455875111c73bf701e72bebfa7c86b25 Mon Sep 17 00:00:00 2001
From: Onnie Lynn Winebarger <[email-masked]>
Date: Tue, 1 Jul 2025 01:52:14 -0400
Subject: [PATCH] Changes to make entry to read0 and readevalloop recursively
 reentrant.

Fixed issues with indirect lread_frames

Try explicit use of emacs-internal coding in load_source_file

Revert irrelevant changes (whitespace or not related to re-entrancy)

Do not rely on whitespace-cleanupgit add -A!

Undo more whitespace-cleanup damage

No idea what is going on.

Very confused

Still working on ws mess

Still working on ws mess 2

Still working on ws mess 3

Still working on ws mess 4

Fixed typos

Fixed missing LREAD_INPUT_BINARY activation
---
 src/lread.c | 3880 +++++++++++++++++++++++++++++++++++++--------------
 1 file changed, 2817 insertions(+), 1063 deletions(-)

diff --git a/src/lread.c b/src/lread.c
index 40eb6ad7875..57ca1732983 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,250 @@ #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,
+  /* some form of readevalloop call*/
+  LREAD_FRAME_MULTIPLE
+} 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 +425,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,356 +442,657 @@ #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;
-
-/* File and lookahead for get-file-char and get-emacs-mule-file-char
-   to read from.  Used by Fload.  */
-static 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[MAX_MULTIBYTE_LENGTH - 1];
-} *infile;
-
-/* 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;
-
-/* 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 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;
 };
 
-/* The last two strings skipped with #@ (most recent first).  */
-static struct saved_string saved_strings[2];
+#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
 
-/* A list of file names for files being loaded in Fload.  Used to
-   check for recursive loads.  */
+#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,							\
+      .mule_charset = NULL						\
+    }
 
-static Lisp_Object Vloads_in_progress;
+/* 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 Lisp_Object call_read0 (Lisp_Object frameptr)
+{
+  register lread_frame *frame = xmint_pointer (frameptr);
+  return read0 (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 int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
-                                 Lisp_Object);
 
-static void readevalloop (Lisp_Object, struct infile *, Lisp_Object, bool,
-                          Lisp_Object, Lisp_Object,
-                          Lisp_Object, Lisp_Object);
+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);
+static Lisp_Object interrupt_error_handler (Lisp_Object data);
+static Lisp_Object base_interrupt_error_handler (Lisp_Object data);
+static Lisp_Object readevalloop_eof_trampoline (Lisp_Object frameptr);
 
-static void build_load_history (Lisp_Object, bool);
+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 *);
 
-
-/* Function that reads one byte from the current source READCHARFUN
-   or unreads one byte.  If the integer argument C is -1, it returns
-   one read byte, or -1 when there's no more byte in the source.  If C
-   is 0 or positive, it unreads C, and the return value is not
-   interesting.  */
-
-static int readbyte_from_file (int, Lisp_Object);
-
-/* Handle unreading and rereading of characters.
-   Write READCHAR to read a character,
-   UNREAD(c) to unread c to be read again.
-
-   These macros correctly read/unread multibyte characters.  */
-
-#define READCHAR readchar (readcharfun, NULL)
-#define UNREAD(c) unreadchar (readcharfun, c)
-
-/* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source.  */
-#define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
-
-/* 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;
+/* 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 int
-readchar (Lisp_Object readcharfun, bool *multibyte)
+static char *
+grow_read_buffer (char *buf, ptrdiff_t offset,
+		  char **buf_addr, ptrdiff_t *buf_size, specpdl_ref count)
 {
-  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;
-
-  if (multibyte)
-    *multibyte = 0;
-
-  readchar_offset++;
-
-  if (BUFFERP (readcharfun))
+  char *p = xpalloc (*buf_addr, buf_size, MAX_MULTIBYTE_LENGTH, -1, 1);
+  if (!*buf_addr)
     {
-      register struct buffer *inbuffer = XBUFFER (readcharfun);
+      memcpy (p, buf, offset);
+      record_unwind_protect_ptr (xfree, p);
+    }
+  else
+    set_unwind_protect_ptr (count, xfree, p);
+  *buf_addr = p;
+  return p;
+}
 
-      ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
+/* 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;
+}
 
-      if (! BUFFER_LIVE_P (inbuffer))
-	return -1;
+INLINE void
+lread_unwind_for_eval (register lread_frame *frame)
+{
+  /* if (UNINIT_SPECPDL_REF(frame->dynamic_frame)) */
+  /*   return; */
+  eassert (!UNINIT_SPECPDL_REF(frame->dynamic_frame));
+  unbind_to (frame->dynamic_frame, Qnil);
+}
 
-      if (pt_byte >= BUF_ZV_BYTE (inbuffer))
-	return -1;
+INLINE void
+lread_init_dynamic_frame (register lread_frame *frame)
+{
+  /* if (!UNINIT_SPECPDL_REF(frame->dynamic_frame)) */
+  /*   unbind_to (frame->dynamic_frame, Qnil); */
+  eassert (UNINIT_SPECPDL_REF(frame->dynamic_frame));
+  frame->dynamic_frame = SPECPDL_INDEX ();
+}
 
-      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);
 
-      return c;
-    }
-  if (MARKERP (readcharfun))
-    {
-      register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
+Lisp_Object
+lread_set_read_eof (Lisp_Object data)
+{
+  current_frame->read_eof = true;
+  return Qnil;
+}
 
-      ptrdiff_t bytepos = marker_byte_position (readcharfun);
+Lisp_Object
+readevalloop_eof_handler (Lisp_Object ignored)
+{
+  register lread_frame *frame = current_frame;
+  frame->read_eof = true;
+  return frame->value;
+}
 
-      if (bytepos >= BUF_ZV_BYTE (inbuffer))
-	return -1;
 
-      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;
-	}
-      else
-	{
-	  c = BUF_FETCH_BYTE (inbuffer, bytepos);
-	  if (! ASCII_CHAR_P (c))
-	    c = BYTE8_TO_CHAR (c);
-	  bytepos++;
-	}
+#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)));
 
-      XMARKER (readcharfun)->bytepos = bytepos;
-      XMARKER (readcharfun)->charpos++;
 
-      return c;
+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");
     }
+}
 
-  if (EQ (readcharfun, Qget_file_char))
+static void
+lread_rewind_input (register lread_frame *frame, int lookahead, int *buf)
+{
+  switch (frame->intype)
     {
-      eassert (infile);
-      readbyte = readbyte_from_file;
-      goto read_multibyte;
+    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;
+}
 
-  if (STRINGP (readcharfun))
+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))
     {
-      if (read_from_string_index >= read_from_string_limit)
-	c = -1;
-      else if (STRING_MULTIBYTE (readcharfun))
-	{
-	  if (multibyte)
-	    *multibyte = 1;
-	  c = (fetch_string_char_advance_no_check
-	       (readcharfun,
-		&read_from_string_index,
-		&read_from_string_index_byte));
-	}
-      else
-	{
-	  c = SREF (readcharfun, read_from_string_index_byte);
-	  read_from_string_index++;
-	  read_from_string_index_byte++;
-	}
-      return c;
+      fseeko (frame->input.f.stream, 0, SEEK_SET);
     }
-
-  if (EQ (readcharfun, Qget_emacs_mule_file_char))
+  if (NILP (coding))
+    coding = Qno_conversion;
+  frame->input.f.coding = coding;
+  if (!VALID_MULTIBYTE (frame->multibyte))
     {
-      readbyte = readbyte_from_file;
-      eassert (infile);
-      emacs_mule_encoding = 1;
-      goto read_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;
     }
+}
 
-  tem = call0 (readcharfun);
+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);
+}
 
-  if (!FIXNUMP (tem))
-    return -1;
-  return XFIXNUM (tem);
+static void
+init_inbuffer (register lread_frame *frame,
+	       Lisp_Object buffer)
+{
+  struct buffer *buf = XBUFFER (buffer);
+  frame->input.b = (struct inbuffer) { .buffer = Qnil };
 
- read_multibyte:
-  if (unread_char >= 0)
+  if (NILP (frame->full_name))
     {
-      c = unread_char;
-      unread_char = -1;
-      return c;
+      frame->full_name =  BVAR (buf, filename);
     }
-  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)
+  if (!NILP (frame->name) && NILP (frame->full_name))
     {
-      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]);
-	}
+      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;
     }
-  return STRING_CHAR (buf);
+  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));
 }
 
-#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)
+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;
+}
+
+/* Determine multibyte */
+INLINE void
+report_lread_multibyte (register lread_frame *frame)
 {
-  if (FROM_FILE_P (readcharfun))
+  /* 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)
     {
-      block_input ();		/* FIXME: Not sure if it's needed.  */
-      file_seek (infile->stream, n - infile->lookahead, SEEK_CUR);
-      unblock_input ();
-      infile->lookahead = 0;
-    }
-  else
-    { /* We're not reading directly from a file.  In that case, it's difficult
-	 to reliably count bytes, since these are usually meant for the file's
-	 encoding, whereas we're now typically in the internal encoding.
-	 But luckily, skip_dyn_bytes is used to skip over a single
-	 dynamic-docstring (or dynamic byte-code) which is always quoted such
-	 that \037 is the final char.  */
-      int c;
-      do {
-	c = READCHAR;
-      } while (c >= 0 && c != '\037');
+    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 void
-skip_dyn_eof (Lisp_Object readcharfun)
+
+/* Function that reads one byte from the current source READCHARFUN
+   or unreads one byte.  If the integer argument C is -1, it returns
+   one read byte, or -1 when there's no more byte in the source.  If C
+   is 0 or positive, it unreads C, and the return value is not
+   interesting.  */
+
+
+static int readbyte_from_file (register lread_frame *frame);
+
+
+static bool
+cleanup_after_interrupt_p (register lread_frame *frame)
 {
-  if (FROM_FILE_P (readcharfun))
+  switch (frame->intype)
     {
-      block_input ();		/* FIXME: Not sure if it's needed.  */
-      file_seek (infile->stream, 0, SEEK_END);
-      unblock_input ();
-      infile->lookahead = 0;
+    case LREAD_INPUT_PROCEDURE:
+    case LREAD_INPUT_STRING:
+    case LREAD_INPUT_BINARY:
+    case LREAD_INPUT_NULL:
+    case LREAD_INPUT_FILE:
+    case LREAD_INPUT_FILE_MULE:
+      return false;
+      break;
+    case LREAD_INPUT_BUFFER:
+    case LREAD_INPUT_MARKER:
+      return (frame->type == LREAD_FRAME_MULTIPLE);
+      break;
+    case LREAD_INPUT_INDIRECT:
+      return cleanup_after_interrupt_p (frame->input.frame.source);
+      UNRECOGNIZED_LREAD_INPUT_CASES("cleanup_after_interrupt_p");
     }
-  else
-    while (READCHAR >= 0);
+  eassert (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)
+lread_continue_frame_after_interrupt (register lread_frame *frame)
 {
-  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))
+  /* If we are unwinding due to a non-local exit during an
+     interrupt, do nothing*/
+  if (frame->interrupted)
+    return;
+  unbind_to (frame->dynamic_frame, Qnil);
+  /* need to ensure buffers are still safe */
+  switch (frame->intype)
     {
-      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);
+    case LREAD_INPUT_PROCEDURE:
+    case LREAD_INPUT_STRING:
+    case LREAD_INPUT_BINARY:
+    case LREAD_INPUT_NULL:
+    case LREAD_INPUT_FILE:
+    case LREAD_INPUT_FILE_MULE:
+      break;
+    case LREAD_INPUT_BUFFER:
+    case LREAD_INPUT_MARKER:
+      if (frame->type == LREAD_FRAME_MULTIPLE)
+	prepare_buffer_for_interruptible_read (frame);
+      break;
+    case LREAD_INPUT_INDIRECT:
+      lread_continue_frame_after_interrupt (frame->input.frame.source);
+      break;
+      UNRECOGNIZED_LREAD_INPUT_CASES("continue_frame_after_interrupt");
     }
-  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))
+static Lisp_Object
+call_maybe_quit (void)
+{
+  maybe_quit();
+  return Qnil;
+}
+static void
+lread_maybe_quit (register lread_frame *frame)
+{
+  bool need_cleanup = cleanup_after_interrupt_p (frame);
+  /* ensure frame is properly restored if
+     some code affects a lisp object we are
+     working with */
+  if (need_cleanup)
     {
-      read_from_string_index--;
-      read_from_string_index_byte
-	= string_char_to_byte (readcharfun, read_from_string_index);
+      /* this should leave the binding to restore the previous
+	 frame in place */
+      lread_unwind_for_eval (frame);
     }
-  else if (FROM_FILE_P (readcharfun))
+  specpdl_ref count = SPECPDL_INDEX();
+  /* any errors thrown during an interrupt handler will be ignored in the
+     dynamic extent of this frame, i.e.  spurious end-of-file signals */
+  /* should also deal with throws, but we don't install any catch handlers */
+  /* of course, this does not deal with all the other places interrupts
+     could be processed during a read or readevalloop....  */
+  frame->interrupted = true;
+  internal_condition_case (call_maybe_quit, Qt, interrupt_error_handler);
+  frame->interrupted = false;
+  if (need_cleanup)
     {
-      unread_char = c;
+      eassert (!specpdl_ref_lt (count, frame->dynamic_frame));
+      unbind_to (count, Qnil);
+      lread_continue_frame_after_interrupt (frame);
     }
-  else
-    calln (readcharfun, make_fixnum (c));
 }
 
 static int
-readbyte_from_stdio (void)
+readbyte_from_stdio (register lread_frame *frame)
 {
-  if (infile->lookahead)
-    return infile->buf[--infile->lookahead];
+  if (frame->input.f.lookahead)
+    {
+      return (frame->input.f.buf[--(frame->input.f.lookahead)]);
+    }
 
   int c;
-  file_stream instream = infile->stream;
 
   block_input ();
 
 #if !defined USE_ANDROID_ASSETS
 
   /* Interrupted reads have been observed while reading over the network.  */
-  while ((c = getc (instream)) == EOF && errno == EINTR && ferror (instream))
+  while ((c = getc (frame->input.f.stream)) == EOF && errno == EINTR
+	 && ferror (frame->input.f.stream))
     {
       unblock_input ();
-      maybe_quit ();
+      lread_maybe_quit (frame);
       block_input ();
-      clearerr (instream);
+      clearerr (frame->input.f.stream);
     }
 
 #else
@@ -556,7 +1102,7 @@ readbyte_from_stdio (void)
     ssize_t rc;
 
   retry:
-    rc = android_asset_read (instream, &byte, 1);
+    rc = android_asset_read (frame->input.f.stream, &byte, 1);
 
     if (rc == 0)
       c = EOF;
@@ -565,7 +1111,7 @@ readbyte_from_stdio (void)
 	if (errno == EINTR)
 	  {
 	    unblock_input ();
-	    maybe_quit ();
+	    lread_maybe_quit (frame);
 	    block_input ();
 	    goto retry;
 	  }
@@ -579,86 +1125,156 @@ readbyte_from_stdio (void)
 #endif
 
   unblock_input ();
-
-  return (c == EOF ? -1 : c);
+  if (c == EOF)
+    {
+      frame->read_eof = true;
+      c = -1;
+    }
+  return c;
 }
 
 static int
-readbyte_from_file (int c, Lisp_Object readcharfun)
+readbyte_from_file (register lread_frame *frame)
 {
-  eassert (infile);
-  if (c >= 0)
-    {
-      eassert (infile->lookahead < sizeof infile->buf);
-      infile->buf[infile->lookahead++] = c;
-      return 0;
-    }
+  eassert (FROM_FILE_P (frame->intype) && (frame->input.f.stream));
 
-  return readbyte_from_stdio ();
+  return readbyte_from_stdio (frame);
 }
 
-/* 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)
+/* Handle unreading and rereading of characters.
+   Write READCHAR to read a character,
+   UNREAD(c) to unread c to be read again.
+
+   These macros correctly read/unread multibyte characters.  */
+
+#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)
 {
-  if (BUFFERP (readcharfun))
+  int dimension = CHARSET_DIMENSION (cs);
+  unsigned code = ENCODE_CHAR (cs, c);
+  int sz;
+  for (sz = 0; dimension > 0 && (code & 0xFF); dimension--)
     {
-      ptrdiff_t line, column;
+      sz++;
+      code >>= 8;
+    }
+  return sz;
+}
 
-      /* Get the line/column in the readcharfun buffer.  */
-      {
-	specpdl_ref count = SPECPDL_INDEX ();
 
-	record_unwind_protect_excursion ();
-	set_buffer_internal (XBUFFER (readcharfun));
-	line = count_lines (BEGV_BYTE, PT_BYTE) + 1;
-	column = current_column ();
-	unbind_to (count, Qnil);
-      }
+#define READCHAR_BEGIN(frame) \
+  int c; \
+  do \
+    { \
+      if (frame->unread_char >= 0) \
+	{ \
+	  c = frame->unread_char; \
+	  frame->unread_char = -1; \
+	  frame->char_offset++; \
+	  frame->byte_offset += frame->unread_bytes; \
+	  frame->unread_bytes = 0; \
+	  return c; \
+	} \
+    } \
+  while (0)
+
+#define READCHAR_FROM_FILE_BEGIN(frame) \
+  unsigned char buf[4]; \
+  READCHAR_BEGIN(frame); \
+  c = readbyte_from_file (frame); \
+  if (c < 0) \
+    { \
+      frame->read_eof = true; \
+      return c; \
+    } \
+  do \
+    { \
+      if (ASCII_CHAR_P (c)) \
+	{ \
+	  frame->char_offset++; \
+	  frame->byte_offset++; \
+	  return c; \
+       } \
+  } while (0)
 
-      xsignal (Qinvalid_read_syntax,
-	       list3 (s, make_fixnum (line), make_fixnum (column)));
-    }
-  else
-    xsignal1 (Qinvalid_read_syntax, s);
+/* internal form of /dev/null */
+static int
+readchar_from_null (register lread_frame *frame)
+{
+  frame->read_eof = true;
+  return -1;
 }
 
-static AVOID
-invalid_syntax (const char *s, Lisp_Object readcharfun)
+/* Handle emacs-internal coding */
+static int
+readchar_from_multibyte_file (register lread_frame *frame)
 {
-  invalid_syntax_lisp (build_string (s), readcharfun);
+  READCHAR_FROM_FILE_BEGIN(frame);
+  int i = 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++] = c;
+	  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)
+{
+  READCHAR_BEGIN(frame);
+  c = readbyte_from_file (frame);
+  if (c < 0)
+    {
+      frame->read_eof = true;
+      return c;
+    }
+  frame->char_offset++;
+  frame->byte_offset++;
+  return 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
-read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun)
+readchar_from_mule_file (register lread_frame *frame)
 {
+  READCHAR_FROM_FILE_BEGIN(frame);
   /* 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;
+  int i = 0;
   buf[i++] = c;
   while (i < len)
     {
-      buf[i++] = c = (*readbyte) (-1, readcharfun);
+      buf[i++] = c = readbyte_from_file (frame);
       if (c < 0xA0)
 	{
 	  for (i -= c < 0; 0 < --i; )
-	    (*readbyte) (buf[i], readcharfun);
+	    frame->input.f.buf[frame->input.f.lookahead++] = c;
 	  return BYTE8_TO_CHAR (buf[0]);
 	}
     }
@@ -687,12 +1303,520 @@ read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object rea
       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 ("invalid multibyte form", readcharfun);
+    invalid_syntax (frame, "invalid multibyte form");
+  return c;
+}
+
+#define READCHAR_STRING_BEGIN(frame) \
+  register int c; \
+  do \
+    { \
+      if (frame->char_offset >= frame->input.s.limit) \
+	{ \
+	  c = -1; \
+	  frame->read_eof = true; \
+	  return c; \
+	} \
+    } \
+  while (0);
+
+
+static int
+readchar_from_multibyte_string (register lread_frame *frame)
+{
+  READCHAR_STRING_BEGIN (frame);
+  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)
+{
+  READCHAR_STRING_BEGIN (frame);
+  c = SREF (frame->input.s.string, frame->byte_offset);
+  frame->char_offset++;
+  frame->byte_offset++;
+  return c;
+}
+
+
+#define READCHAR_BUFFER_SETUP(frame,src,pos)	\
+  int c;					\
+  struct buffer *inbuffer = XBUFFER ( (src) );	\
+  if (! BUFFER_LIVE_P (inbuffer))		\
+    return -1;					\
+  ptrdiff_t bytepos = ( pos );			\
+  do						\
+    {						\
+      if (bytepos >= BUF_ZV_BYTE (inbuffer))	\
+	{					\
+	  frame->read_eof = true;		\
+	  return -1;				\
+	}					\
+    } while (0)
+
+#define READCHAR_BUFFER_BEGIN(frame,src)			\
+  READCHAR_BUFFER_SETUP (frame, src, BUF_PT_BYTE (inbuffer))
+
+#define READCHAR_BUFFER_FETCH_MULTIBYTE(frame) \
+  /* 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
+
+#define READCHAR_BUFFER_FETCH_UNIBYTE(frame) \
+  c = BUF_FETCH_BYTE (inbuffer, bytepos); \
+  c = UNIBYTE_TO_CHAR (c); \
+  bytepos++
+
+#define READCHAR_BUFFER_END(frame) \
+  SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, bytepos); \
+  frame->char_offset = BUF_PT(inbuffer); \
+  frame->byte_offset = bytepos
+
+#define READCHAR_MARKER_BEGIN(frame) \
+  READCHAR_BUFFER_SETUP (frame, frame->input.m.b.buffer, \
+			 marker_byte_position (frame->input.m.marker))
+
+#define READCHAR_MARKER_END(frame) \
+  frame->byte_offset = XMARKER (frame->input.m.marker)->bytepos = bytepos; \
+  frame->char_offset = ++(XMARKER (frame->input.m.marker)->charpos)
+
+static int
+readchar_from_multibyte_buffer (register lread_frame *frame)
+{
+  READCHAR_BUFFER_BEGIN (frame, frame->input.b.buffer);
+  READCHAR_BUFFER_FETCH_MULTIBYTE(frame);
+  READCHAR_BUFFER_END(frame);
+  return c;
+}
+
+static int
+readchar_from_unibyte_buffer (register lread_frame *frame)
+{
+  READCHAR_BUFFER_BEGIN (frame,frame->input.b.buffer);
+  READCHAR_BUFFER_FETCH_UNIBYTE (frame);
+  READCHAR_BUFFER_END (frame);
+  return c;
+}
+
+static int
+readchar_from_multibyte_marker (register lread_frame *frame)
+{
+  READCHAR_MARKER_BEGIN (frame);
+  READCHAR_BUFFER_FETCH_MULTIBYTE (frame);
+  READCHAR_MARKER_END (frame);
+  return c;
+}
+
+static int
+readchar_from_unibyte_marker (register lread_frame *frame)
+{
+  READCHAR_MARKER_BEGIN (frame);
+  READCHAR_BUFFER_FETCH_UNIBYTE (frame);
+  READCHAR_MARKER_END (frame);
+  return c;
+}
+
+static int
+readchar_from_multibyte_procedure (register lread_frame *frame)
+{
+  READCHAR_BEGIN(frame);
+  Lisp_Object tem = call0 (frame->input.p.proc);
+  c = (!FIXNUMP (tem)) ? -1 : XFIXNUM(tem);
+  if (c == -1)
+      frame->read_eof = true;
   return c;
 }
 
+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;
+}
+
+/* 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
+};
+
+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
+  };
+
+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
+	xsignal1 (Qerror,
+		  CALLN (Fformat,
+			 build_string ("Invalid input type for read(-*): %S"),
+			 make_fixnum(frame->intype)));
+    }
+  else
+    {
+      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)));
+}
+
+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 (c >= 0)
+	{
+	  UNREAD (frame, c);
+	}
+      else
+	c = READCHAR (frame);
+    }
+  else
+    {
+      xsignal1 (Qerror,
+		build_string ("reader-input-stream: reader not active"));
+    }
+  return (make_fixnum (c));
+}
+
+static void
+skip_dyn_bytes (register lread_frame *frame, ptrdiff_t n)
+{
+  if (FROM_FILE_P (frame->intype) && !frame->multibyte)
+    {
+      block_input ();		/* FIXME: Not sure if it's needed.  */
+      file_seek (frame->input.f.stream, n - frame->input.f.lookahead, SEEK_CUR);
+      frame->char_offset += n;
+      frame->byte_offset += n;
+      unblock_input ();
+      frame->input.f.lookahead = 0;
+    }
+  else
+    { /* We're not reading directly from a file.  In that case, it's difficult
+	 to reliably count bytes, since these are usually meant for the file's
+	 encoding, whereas we're now typically in the internal encoding.
+	 But luckily, skip_dyn_bytes is used to skip over a single
+	 dynamic-docstring (or dynamic byte-code) which is always quoted such
+	 that \037 is the final char.  */
+      int c;
+      do {
+	c = READCHAR (frame);
+      } while (c >= 0 && c != '\037');
+    }
+}
+
+static void
+skip_dyn_eof (register lread_frame *frame)
+{
+  if (FROM_FILE_P (frame->intype) && !frame->multibyte)
+    {
+      block_input ();		/* FIXME: Not sure if it's needed.  */
+      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 ();
+      frame->input.f.lookahead = 0;
+      frame->read_eof = true;
+    }
+  else
+    while (READCHAR (frame) >= 0);
+}
+
+void
+unreadchar (register lread_frame *frame,int c)
+{
+  if (c < 0)
+    return;
+  switch (frame->intype)
+    {
+    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")
+    }
+}
+
+/* Make sure the file stream eats the final unreadchar
+   after a read operation that won't be continued,
+   i.e.  in a single operation */
+
+static void
+closing_unreadchar (register lread_frame *frame)
+{
+  switch (frame->intype)
+    {
+    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 (frame->type == LREAD_FRAME_SINGLE)
+	{
+	  /* 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--)
+	    {
+	      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);
+		}
+	    }
+	}
+      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;
+
+      UNRECOGNIZED_LREAD_INPUT_CASES("closing_unreadchar");
+    }
+}
+/* Signal Qinvalid_read_syntax error.
+   S is error string of length N (if > 0)  */
+
+AVOID
+invalid_syntax_lisp (register lread_frame *frame, Lisp_Object s)
+{
+ retry:
+  if (HAS_BUFFER_P (frame->intype))
+    {
+      ptrdiff_t line, column;
+
+      /* Get the line/column in the readcharfun buffer.  */
+      {
+	specpdl_ref count = SPECPDL_INDEX ();
+
+	record_unwind_protect_excursion ();
+	set_buffer_internal (lread_get_buffer(frame));
+	line = count_lines (BEGV_BYTE, PT_BYTE) + 1;
+	column = current_column ();
+	unbind_to (count, Qnil);
+      }
+
+      xsignal (Qinvalid_read_syntax,
+	       list3 (s, make_fixnum (line), make_fixnum (column)));
+    }
+  else if (frame->intype == LREAD_INPUT_INDIRECT
+      && frame->input.frame.source && frame != frame->input.frame.source)
+    {
+      /* Shut up infinite recursion warning */
+      frame = frame->input.frame.source;
+      goto retry;
+    }
+  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 +1832,37 @@ 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 *);
 
+/* if an error was thrown during an interrupt and not caught, it shouldn't be handled
+   by this frame, but continue unwinding
+ */
+Lisp_Object
+interrupt_error_handler (Lisp_Object data)
+{
+  /* data should always be a cons*/
+  eassert (CONSP (data));
+  if (EQ (XCAR (data), Qerror_during_interrupt))
+    Fsignal (XCAR (data),XCDR (data));
+  else
+    Fsignal (Qerror_during_interrupt, data);
+  eassume (false);
+}
+
+Lisp_Object
+base_interrupt_error_handler (Lisp_Object data)
+{
+  /* data should always be a cons*/
+  eassert (CONSP (data));
+  if (EQ (XCAR (data), Qerror_during_interrupt))
+    data = XCDR (data);
+  /* we have skipped all lread frames now */
+  eassert (CONSP (data));
+  Fsignal (XCAR (data), XCDR (data));
+  eassume (false);
+}
+
 
 /* Get a character from the tty.  */
 
@@ -988,42 +2136,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 +2213,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 +2223,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 +2238,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 +2252,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 +2266,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 +2279,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 +2347,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 +2387,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 +2406,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 +2453,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 +2467,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 +2636,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 +2665,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_MULTIPLE);
+  lread_init_dynamic_frame (&load_frame);
 
 #if !defined USE_ANDROID_ASSETS
   if (0 <= fd)
@@ -1541,14 +2720,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 +2822,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 +2833,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 +2854,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 +2872,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 +2887,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 +2935,10 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
   if (is_module)
     {
 #ifdef HAVE_MODULES
+      activate_lread_frame (&this_frame, LREAD_FRAME_MULTIPLE);
       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 +2947,10 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
   else if (is_native_elisp)
     {
 #ifdef HAVE_NATIVE_COMP
+      activate_lread_frame (&this_frame, LREAD_FRAME_MULTIPLE);
       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 +2959,15 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
     }
   else
     {
+      activate_lread_frame (&this_frame, LREAD_FRAME_MULTIPLE);
+      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);
-        }
+      internal_condition_case_1 (readevalloop_eof_trampoline,
+				 make_mint_ptr(&this_frame),
+				 list1 (Qerror_during_interrupt),
+				 base_interrupt_error_handler);
     }
   unbind_to (count, Qnil);
 
@@ -1774,11 +2975,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 +3489,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,14 +3527,14 @@ build_load_history (Lisp_Object filename, bool entire)
 
 		  if (NILP (Fmember (newelt, tem)))
 		    Fsetcar (tail, Fcons (XCAR (tem),
-		     			  Fcons (newelt, XCDR (tem))));
-		  maybe_quit ();
+					  Fcons (newelt, XCDR (tem))));
+		  lread_maybe_quit (frame);
 		}
 	    }
 	}
       else
 	prev = tail;
-      maybe_quit ();
+      lread_maybe_quit (frame);
     }
 
   /* If we're loading an entire file, cons the new assoc onto the
@@ -2349,19 +3550,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 +3599,256 @@ 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)))
+    {
+      Lisp_Object tmp = Fmake_marker();
+      return Fset_marker (tmp, make_fixnum (buf->pt), buffer);
+    }
+  /* 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 (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);
+	}
+    }
+  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);
+	}
+    }
+  /* 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;
+}
+
+/* This procedure performs 2 functions:
+   Arrange for lisp-visible state of buffer at entry to read function to be
+       reinstated when the dynamic frame associated with the read/readevalloop
+       is unwound.
+   Set buffer state for use by read.
+   For recursively-reentrant read/eval, this has to be called at any (re)entry
+   to read, and unwound to perform any intervening eval as well as after
+   read0 has completed.
+ */
+void
+prepare_buffer_for_interruptible_read (register lread_frame *frame)
+{
+  /* Lisp_Object buffer = lread_get_buffer_obj(frame); */
+  struct buffer *buf = lread_get_buffer(frame);
+  if (buf != 0 && !BUFFER_LIVE_P (buf))
+    error ("Reading from killed buffer");
+  /* 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;
+  if (!NILP (frame->readfun))
+    {
+      val = calln (frame->readfun, Qreader_input_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)
+	 || !EQ (Vload_read_function, Qread) */
+      val = calln (Vload_read_function, Qreader_input_stream);
+    }
+  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);
+  specbind (Qstandard_input, Qreader_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 +3859,197 @@ 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 (frame->sourcename);
+  if (b != NULL)
+    frame->whole_buffer =
+      setup_buffer_for_readevalloop (frame, frame->start, frame->end)
+      || frame->whole_buffer;
 
-  loadhist_initialize (sourcename);
+  lread_init_dynamic_frame (frame);
 
-  continue_reading_p = 1;
-  while (continue_reading_p)
+  while (!frame->read_eof)
     {
-      specpdl_ref count1 = SPECPDL_INDEX ();
-
-      if (b != 0 && !BUFFER_LIVE_P (b))
-	error ("Reading from killed buffer");
-
-      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 ();
-	}
+      frame->objects_map = Fclrhash (frame->objects_map);
+      frame->objects_completed = Fclrhash (frame->objects_completed);
 
-      /* 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)
+	prepare_buffer_for_interruptible_read (frame);
 
-      eassert (!infile0 || infile == infile0);
-    read_next:
-      c = READCHAR;
-      if (c == ';')
-	{
-	  while ((c = READCHAR) != '\n' && c != -1);
-	  goto read_next;
-	}
-      if (c < 0)
+      /* Handle the most common case first */
+      /* not sure why the Vpurify_flag/will_dump_p case is special */
+      if (use_read0)
 	{
-	  unbind_to (count1, Qnil);
-	  break;
+	/* avoid condition case */
+	  lread_skip_insignificant (frame);
+	  if (frame->read_eof)
+	    {
+	      lread_unwind_for_eval (frame);
+	      break;
+	    }
+	  val = read0 (frame);
+	  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
 	{
-	  if (!NILP (readfun))
+	  /* 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)
 	    {
-	      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;
-		}
+	      eassert (!UNINIT_SPECPDL_REF (frame->dynamic_frame));
+	      lread_unwind_for_eval (frame);
+	      break;
 	    }
-	  else if (! NILP (Vload_read_function))
-	    val = calln (Vload_read_function, readcharfun);
-	  else
-	    val = read_internal_start (readcharfun, Qnil, Qnil, false);
+	  frame->nexprs++;
 	}
-      /* 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 ();
+
+      if (b && !frame->read_eof)
+	{
+	  frame->start = Fpoint_marker ();
+	  frame->char_offset = XMARKER (frame->start)->charpos;
+	  frame->byte_offset = XMARKER (frame->start)->bytepos;
+	}
 
       /* Restore saved point and BEGV.  */
-      unbind_to (count1, Qnil);
+      eassert (!UNINIT_SPECPDL_REF (frame->dynamic_frame));
+      lread_unwind_for_eval (frame);
 
       /* 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);
+
+      lread_unwind_for_eval (frame);
+
+      /* 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;
     }
+  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_MULTIPLE);
+  val = internal_condition_case_1 (readevalloop_eof_trampoline,
+				   make_mint_ptr (&this_frame),
+				   list1 (Qt),
+				   base_interrupt_error_handler);
+  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;
+  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)));
+      specbind (Qlexical_binding, get_lexical_binding (&this_frame, buf));
+      BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
+    }
+  activate_lread_frame (&this_frame, LREAD_FRAME_MULTIPLE);
+  val = internal_condition_case_1 (readevalloop_eof_trampoline,
+				   make_mint_ptr (&this_frame),
+				   list1 (Qt),
+				   base_interrupt_error_handler);
+  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 +4081,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",
@@ -2667,28 +4101,48 @@ DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r",
 This function does not move point.  */)
   (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;
+  return enter_buffer_readevalloop (Qnil, printflag, Qnil,
+				    Qnil, start, end, read_function,
+				    false);
+}
 
-  cbuf = Fcurrent_buffer ();
 
-  if (NILP (printflag))
-    tem = Qsymbolp;
+
+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 */
+  if (initialized || will_dump_p())
+    {
+      data = internal_condition_case_1 (call_read0,
+					make_mint_ptr (&this_frame),
+					Qerror_during_interrupt,
+					base_interrupt_error_handler);
+    }
   else
-    tem = printflag;
-  specbind (Qstandard_output, tem);
-  specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
-
-  /* `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);
+    {
+      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 +4156,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 +4175,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 +4189,208 @@ 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
-	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;
+	{
+	  if (NILP (name))
+	    name = item1;
+	  if (NILP (full_name))
+	    full_name = NILP (item2) ? item1 : item2;
+	}
+	  stream = base_stream;
     }
-
-  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;
+  frame->start = start;
+  frame->end = end;
+  frame->full_name = full_name;
+  frame->name = name;
+  frame->locate_syms = locate_syms;
+  if (BUFFERP (stream))
+    {
+      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))
+    {
+      frame->intype = LREAD_INPUT_INDIRECT;
+      lread_frame *source = current_frame;
+      while (source && source->intype == LREAD_INPUT_INDIRECT)
+	source = source->input.frame.source;
+      if (! source)
+	frame->intype = LREAD_INPUT_NULL;
+      else
+	{
+	  frame->input.frame.source = source;
+	  frame->char_offset = source->char_offset;
+	  frame->byte_offset = source->byte_offset;
+	}
+    }
+  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 +4406,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 +4419,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 +4433,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 +4459,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 +4474,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 +4489,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 +4498,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 +4516,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 +4540,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 +4577,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 +4596,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 +4630,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 +4648,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 +4696,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 +4710,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 +4721,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 +4736,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 +4756,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 +4770,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 +4784,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 +4795,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 +4803,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 +4834,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 +4848,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 +4861,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 +4906,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 +4921,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 +5017,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 +5043,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 +5067,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 +5087,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 +5130,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 +5155,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 +5197,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 +5214,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 +5254,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 +5271,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 +5293,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 +5338,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 +5390,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)
+read_stack_reset (void *p)
 {
-  eassert (sp <= rdstack.sp);
-  rdstack.sp = sp;
+  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(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 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()		\
+#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 +5536,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 +5547,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 +5586,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 +5637,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 +5656,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 +5740,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 +5776,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 +5793,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 +5816,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 +5839,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 +5848,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 +5859,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 +5902,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 +5923,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 +5961,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 +5977,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 +5998,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 +6016,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 +6059,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 +6081,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 +6101,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 +6115,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 +6130,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 +6153,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 +6168,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 +6177,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 +6191,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 +6453,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 +6694,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 +6713,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 +6756,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 +6777,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 +7362,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 +7407,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 +7598,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 +7611,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 +7896,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 +7936,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