Subject: bug#78898: Make read/readevalloop reentrant

From: Lynn Winebarger <[email-masked]>
Date: Wed, 25 Jun 2025 17:59:53 -0400

In the recursive sense, not the "safe for concurrency" sense.

I want to use readevalloop to process command-line arguments, and my
initial attempts failed to handle '"(load "loadup.el") (princ
"Done")'.  So I took a stab at making all the entry points synchronize
with an explicit stack of continuation frames shared between read0 and
readevalloop.

The attached diff is against master from a couple of days ago.  For
me, a configure/build (from scratch) completes *almost* everything
(including the standard AOT native-compiled bits) - it chokes on
lisp/leim/ja-dic.el due to a failure in a compiled function in
bytecomp.elc.  There are clearly still some issues where the new code
is not dealing with unibyte/multibyte correctly.  For example, running
emacs -Q shows the initial scratch buffer contents as:

;; This buffer is for text that is not saved, and for Lisp evaluation.
;; To create a file, visit it with â€˜C-x C-fâ€™ and enter text in its buffer.

This is definitely not ready for committing, but I'm hoping someone
else finds this of interest and maybe can spot where I'm going wrong
with the unibyte/multibyte handling.  Or what is going on with
ja-dic.el.  The error I'm seeing there is in the execution of some
byte-code, where some bit-wise operator gets a non-numeric argument.
My only idea at present is to diff the byte-compiled libraries and see
what's going on there - theoretically, there shouldn't be any change
in the results of the byte-compiler.

Thanks,
Lynn
diff --git a/src/coding.c b/src/coding.c
index a923b6bd82d..b73ad38cc0a 100644
--- a/src/coding.c
+++ b/src/coding.c
@@ -12304,6 +12304,29 @@ system (e.g. `iso-2022-7bit').
   for (int i = 0; i < coding_category_max; i++)
     Fset (AREF (Vcoding_category_table, i), Qno_conversion);
 
+  plist[1] = args[coding_arg_name] = Qraw_text;
+  plist[3] = args[coding_arg_mnemonic] = make_fixnum ('t');
+  plist[5] = args[coding_arg_coding_type] = Qraw_text;
+  /* This is already set.
+     plist[7] = args[coding_arg_ascii_compatible_p] = Qt; */
+  plist[8] = intern_c_string (":charset-list");
+  plist[9] = args[coding_arg_charset_list] = Qnil;
+  plist[11] = args[coding_arg_for_unibyte] = Qt;
+#define RAW_TEXT_DESCRIPTION                                            \
+  "Raw text, which means text contains random 8-bit codes.\n"           \
+    "Encoding text with this coding system produces the actual byte\n"  \
+    "sequence of the text in buffers and strings.  An exception is made for\n" \
+    "characters from the `eight-bit' character set.  Each of them is encoded\n" \
+    "into a single byte.\n"                                             \
+    "\n"                                                                \
+    "When you visit a file with this coding, the file is read into a\n" \
+    "unibyte buffer as is (except for EOL format), thus each byte of a file\n" \
+    "is treated as a character."
+  plist[13] = build_string (RAW_TEXT_DESCRIPTION);
+  plist[15] = args[coding_arg_eol_type] = Qnil;
+  args[coding_arg_plist] = CALLMANY (Flist, plist);
+  Fdefine_coding_system_internal (coding_arg_max, args);
+
   pdumper_do_now_and_after_load (reset_coding_after_pdumper_load);
 
   DEFSYM (QUnknown_error, "Unknown error");
diff --git a/src/lread.c b/src/lread.c
index 40eb6ad7875..bdfe5c35500 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,40 +169,17 @@ #define USE_ANDROID_ASSETS
 # endif
 #endif
 
-/* The objects or placeholders read with the #n=object form.
-
-   A hash table maps a number to either a placeholder (while the
-   object is still being parsed, in case it's referenced within its
-   own definition) or to the completed object.  With small integers
-   for keys, it's effectively little more than a vector, but it'll
-   manage any needed resizing for us.
-
-   The variable must be reset to an empty 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_map;
-
-/* The recursive objects read with the #n=object form.
-
-   Objects that might have circular references are stored here, so
-   that recursive substitution knows not to keep processing them
-   multiple times.
-
-   Only objects that are completely processed, including substituting
-   references to themselves (but not necessarily replacing
-   placeholders for other objects still being read), are stored.
 
-   A hash table is used for efficient lookups of keys.  We don't care
-   what the value slots hold.  The variable must be set to an empty
-   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.  */
+#if 0
 static Lisp_Object read_objects_completed;
+#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.  */
-static struct infile
+struct infile
 {
   /* The input stream.  */
   file_stream stream;
@@ -211,16 +189,123 @@ #define USE_ANDROID_ASSETS
 
   /* 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;
+  unsigned char buf[INFILE_BUFFER_SIZE];
+  /* is this seekable? */
+  bool seekable;
+  bool mule;
+  Lisp_Object coding;
+};
+
+#define INIT_INFILE()                                   \
+  ((struct infile)                                      \
+   {                                                    \
+     .stream = 0,                                       \
+     .lookahead = 0,                                    \
+     .buf =  { 0 },                                     \
+     .seekable = false,                                 \
+     .mule = false                                      \
+   } )
+
+struct instring
+{
+  Lisp_Object string;
+  ptrdiff_t start;
+  ptrdiff_t limit;
+};
+#define INIT_INSTRING()                                 \
+  ((struct instring)                                    \
+   {                                                    \
+     .string = Qnil,                                    \
+     .start = 0,                                        \
+     .limit = 0                                         \
+   } )
+
+
+struct inbuffer
+{
+  Lisp_Object buffer;
+};
+#define INIT_INBUFFER()                                 \
+  ((struct inbuffer)                                    \
+   {                                                    \
+     .buffer = Qnil                                     \
+   } )
+
+struct inmarker
+{
+  struct inbuffer b;
+  Lisp_Object marker;
+};
+#define INIT_INMARKER()                                 \
+  ((struct inmarker)                                    \
+   {                                                    \
+     .b = INIT_INBUFFER(),                              \
+     .marker = Qnil                                     \
+   } )
+
+struct inproc
+{
+  Lisp_Object proc;
+};
+struct inindirect
+{
+  struct lread_frame *source;
+};
+#define INIT_INPROC()                                   \
+  ((struct inproc)                                      \
+   {                                                    \
+     .proc = Qnil                                       \
+   } )
+
+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)))
+#if 0
+#define FROM_PROC_P(arg) ((arg) == LREAD_INPUT_PROCEDURE)
+#define FROM_STRING_P(arg) ((arg) == LREAD_INPUT_STRING)
+#endif
+
+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;
 
-/* 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;
+#define INIT_LREAD_INPUT (lread_input) { .uninit  =  { 0 } }
 
-/* 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 */
@@ -228,225 +313,1298 @@ #define USE_ANDROID_ASSETS
   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 })
 
+#if 0
 /* The last two strings skipped with #@ (most recent first).  */
 static struct saved_string saved_strings[2];
+#endif
 
-/* A list of file names for files being loaded in Fload.  Used to
-   check for recursive loads.  */
+typedef enum lread_multibyte
+{
+  LREAD_MULTIBYTE_INDETERMINATE = -1, /* For resetting  */
+  LREAD_MULTIBYTE_FALSE  = 0,
+  LREAD_MULTIBYTE_TRUE  = 1
+} lread_multibyte;
 
-static Lisp_Object Vloads_in_progress;
 
-static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
-                                 Lisp_Object);
+#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 void readevalloop (Lisp_Object, struct infile *, Lisp_Object, bool,
-                          Lisp_Object, Lisp_Object,
-                          Lisp_Object, Lisp_Object);
+static Lisp_Object make_obarray (unsigned bits);
 
-static void build_load_history (Lisp_Object, bool);
+/* 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,                /* "(" */
 
-static Lisp_Object oblookup_considering_shorthand (Lisp_Object, const char *,
-						   ptrdiff_t, ptrdiff_t,
-						   char **, ptrdiff_t *,
-						   ptrdiff_t *);
+  RE_list,                      /* "(" (+ OBJECT) */
+  RE_list_dot,                  /* "(" (+ OBJECT) "." */
 
-
-/* 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.  */
+  RE_vector,                    /* "[" (* OBJECT) */
+  RE_record,                    /* "#s(" (* OBJECT) */
+  RE_char_table,                /* "#^[" (* OBJECT) */
+  RE_sub_char_table,            /* "#^^[" (* OBJECT) */
+  RE_byte_code,                 /* "#[" (* OBJECT) */
+  RE_string_props,              /* "#(" (* OBJECT) */
 
-static int readbyte_from_file (int, Lisp_Object);
+  RE_special,                   /* "'" | "#'" | "`" | "," | ",@" */
 
-/* Handle unreading and rereading of characters.
-   Write READCHAR to read a character,
-   UNREAD(c) to unread c to be read again.
+  RE_numbered,                  /* "#" (+ DIGIT) "=" */
+};
 
-   These macros correctly read/unread multibyte characters.  */
+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 READCHAR readchar (readcharfun, NULL)
-#define UNREAD(c) unreadchar (readcharfun, c)
+#define INIT_READ_STACK {NULL, 0, 0}
+#if 0
+static struct read_stack rdstack = {NULL, 0, 0};
+#endif
+
+/* 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;
 
-/* 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,
+/* 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.  */
-static int unread_char = -1;
+  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.
 
-static int
-readchar (Lisp_Object readcharfun, bool *multibyte)
-{
-  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;
+   A hash table maps a number to either a placeholder (while the
+   object is still being parsed, in case it's referenced within its
+   own definition) or to the completed object.  With small integers
+   for keys, it's effectively little more than a vector, but it'll
+   manage any needed resizing for us.
 
-  if (multibyte)
-    *multibyte = 0;
+   The variable must be reset to an empty 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.  */
+  Lisp_Object objects_map;
 
-  readchar_offset++;
+/* The recursive objects read with the #n=object form.
 
-  if (BUFFERP (readcharfun))
-    {
-      register struct buffer *inbuffer = XBUFFER (readcharfun);
+   Objects that might have circular references are stored here, so
+   that recursive substitution knows not to keep processing them
+   multiple times.
 
-      ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
+   Only objects that are completely processed, including substituting
+   references to themselves (but not necessarily replacing
+   placeholders for other objects still being read), are stored.
 
-      if (! BUFFER_LIVE_P (inbuffer))
-	return -1;
+   A hash table is used for efficient lookups of keys.  We don't care
+   what the value slots hold.  The variable must be set to an empty
+   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.  */
+  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;
+};
 
-      if (pt_byte >= BUF_ZV_BYTE (inbuffer))
-	return -1;
+#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
 
-      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);
+#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                                              \
+    }
+
+/* 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);
 
-      return c;
-    }
-  if (MARKERP (readcharfun))
-    {
-      register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
 
-      ptrdiff_t bytepos = marker_byte_position (readcharfun);
+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);
 
-      if (bytepos >= BUF_ZV_BYTE (inbuffer))
-	return -1;
+static void build_load_history (register lread_frame *frame, Lisp_Object, bool);
+
+static ptrdiff_t obarray_index (struct Lisp_Obarray *oa, const char *str,
+                                ptrdiff_t size_byte);
+static Lisp_Object oblookup_considering_shorthand (Lisp_Object, const char *,
+                                                   ptrdiff_t, ptrdiff_t,
+                                                   char **, ptrdiff_t *,
+                                                   ptrdiff_t *);
+
+/* Grow a read buffer BUF that contains OFFSET useful bytes of data,
+   by at least MAX_MULTIBYTE_LENGTH bytes.  Update *BUF_ADDR and
+   *BUF_SIZE accordingly; 0 <= OFFSET <= *BUF_SIZE.  If *BUF_ADDR is
+   initially null, BUF is on the stack: copy its data to the new heap
+   buffer.  Otherwise, BUF must equal *BUF_ADDR and can simply be
+   reallocated.  Either way, remember the heap allocation (which is at
+   pdl slot COUNT) so that it can be freed when unwinding the stack.*/
 
-      if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
+static char *
+grow_read_buffer (char *buf, ptrdiff_t offset,
+                  char **buf_addr, ptrdiff_t *buf_size, specpdl_ref count)
+{
+  char *p = xpalloc (*buf_addr, buf_size, MAX_MULTIBYTE_LENGTH, -1, 1);
+  if (!*buf_addr)
     {
-	  /* 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;
+      memcpy (p, buf, offset);
+      record_unwind_protect_ptr (xfree, p);
     }
   else
+    set_unwind_protect_ptr (count, xfree, p);
+  *buf_addr = p;
+  return p;
+}
+
+/* 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)
     {
-	  c = BUF_FETCH_BYTE (inbuffer, bytepos);
-	  if (! ASCII_CHAR_P (c))
-	    c = BYTE8_TO_CHAR (c);
-	  bytepos++;
+      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;
+}
+
+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);
+}
 
-      XMARKER (readcharfun)->bytepos = bytepos;
-      XMARKER (readcharfun)->charpos++;
+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 ();
+}
 
-      return c;
-    }
 
-  if (EQ (readcharfun, Qget_file_char))
+Lisp_Object
+lread_set_read_eof (Lisp_Object data)
+{
+  current_frame->read_eof = true;
+  return Qnil;
+}
+
+Lisp_Object
+readevalloop_eof_handler (Lisp_Object ignored)
+{
+  register lread_frame *frame = current_frame;
+  frame->read_eof = true;
+  return frame->value;
+}
+
+
+#define UNRECOGNIZED_LREAD_INPUT_CASES(src)     \
+    case LREAD_INPUT_UNINIT:\
+      xsignal1 (Qerror,\
+                CALLN (Fformat,\
+                       build_string ("Internal error: " src \
+                                     ": type of input to "          \
+                                     "read(-*) uninitialized: %s"), \
+                       make_fixnum((EMACS_INT) frame->intype)));   \
+      break;\
+    default:\
+      xsignal1 (Qerror,\
+                CALLN (Fformat,\
+                       build_string ("Internal error:: " src \
+                                     ": type of input to "              \
+                                     "read(-*) unrecognized: %s"),      \
+                       make_fixnum((EMACS_INT) frame->intype)));
+
+
+static bool
+lread_frame_requires_rewind_buffer (register lread_frame *frame)
+{
+  switch (frame->intype)
     {
-      eassert (infile);
-      readbyte = readbyte_from_file;
-      goto read_multibyte;
+    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 (STRINGP (readcharfun))
+static void
+lread_rewind_input (register lread_frame *frame, int lookahead, int *buf)
+{
+  switch (frame->intype)
     {
-      if (read_from_string_index >= read_from_string_limit)
-	c = -1;
-      else if (STRING_MULTIBYTE (readcharfun))
+    case LREAD_INPUT_FILE:
+    case LREAD_INPUT_FILE_MULE:
+      {
+        if (frame->input.f.seekable)
           {
-	  if (multibyte)
-	    *multibyte = 1;
-	  c = (fetch_string_char_advance_no_check
-	       (readcharfun,
-		&read_from_string_index,
-		&read_from_string_index_byte));
+            rewind (frame->input.f.stream);
           }
-      else
+        else if (buf)
+          {
+            /* At least try ungetc */
+            unsigned char charbuf[MAX_MULTIBYTE_LENGTH] = {0};
+            int len = 0;
+            if (frame->multibyte)
               {
-	  c = SREF (readcharfun, read_from_string_index_byte);
-	  read_from_string_index++;
-	  read_from_string_index_byte++;
+                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);
                       }
-      return c;
                   }
-
-  if (EQ (readcharfun, Qget_emacs_mule_file_char))
+              }
+            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:
+      {
+        Fgoto_char (make_fixnum (0));
+      }
+      break;
+    case LREAD_INPUT_INDIRECT:
+      return lread_rewind_input (frame->input.frame.source, lookahead, buf);
+    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;
+}
+
+static void
+init_infile (register lread_frame *frame,
+             file_stream stream, bool seekable, bool mule,
+             Lisp_Object coding)
+{
+  frame->input.f = INIT_INFILE ();
+  frame->input.f.stream = stream;
+  frame->input.f.seekable = seekable;
+  frame->input.f.mule = mule;
+  if (frame->input.f.seekable &&
+      (ftello (frame->input.f.stream) != 0))
+    {
+      fseeko (frame->input.f.stream, 0, SEEK_SET);
+    }
+  if (NILP (coding))
+    coding = Qno_conversion;
+  frame->input.f.coding = coding;
+  if (!VALID_MULTIBYTE (frame->multibyte))
+    {
+      CHECK_CODING_SYSTEM (frame->input.f.coding);
+      ptrdiff_t id = CODING_SYSTEM_ID (frame->input.f.coding);
+      frame->multibyte = NILP (CODING_ATTR_FOR_UNIBYTE (CODING_ID_ATTRS (id))) ?
+        LREAD_MULTIBYTE_TRUE : LREAD_MULTIBYTE_FALSE;
+    }
+}
+
+static void
+init_instring (register lread_frame *frame,
+               Lisp_Object string)
+{
+  ptrdiff_t startval, endval;
+  frame->input.s = INIT_INSTRING();
+
+  if (NILP (frame->start))
+    frame->start  = make_fixnum(0);
+  if (NILP (frame->end))
+    frame->end = make_fixnum (SCHARS (string));
+
+  CHECK_FIXNUM (frame->start);
+  CHECK_FIXNUM (frame->end);
+  frame->input.s.string = string;
+
+  validate_subarray (string, frame->start, frame->end, SCHARS (string),
+                     &startval, &endval);
+  frame->input.s.start = startval;
+  frame->input.s.limit = endval;
+  frame->char_offset = frame->input.s.start;
+  frame->byte_offset
+    = string_char_to_byte (frame->input.s.string,
+                           frame->input.s.start);
+  if (!VALID_MULTIBYTE (frame->multibyte))
+    frame->multibyte = STRING_MULTIBYTE (frame->input.s.string);
+}
+
+static void
+init_inbuffer (register lread_frame *frame,
+               Lisp_Object buffer)
+{
+  frame->input.b = INIT_INBUFFER ();
+  struct buffer *buf = XBUFFER (buffer);
+
+  if (NILP (frame->full_name))
+    {
+      frame->full_name =  BVAR (buf, filename);
+    }
+  if (!NILP (frame->name) && NILP (frame->full_name))
+    {
+      if (NILP (Ffile_name_absolute_p (frame->name)))
+        frame->full_name = Fexpand_file_name (frame->name, BVAR (buf, directory));
+      else
+        frame->full_name = frame->name;
+    }
+  if (NILP (frame->name) && !NILP (frame->full_name))
+    {
+      frame->name = Ffile_name_nondirectory (frame->full_name);
+    }
+  frame->input.b.buffer = buffer;
+  frame->char_offset = BUF_PT (buf);
+  frame->byte_offset = BUF_PT_BYTE (buf);
+  if (!VALID_MULTIBYTE (frame->multibyte))
+    frame->multibyte = ! NILP (BVAR (buf, enable_multibyte_characters));
+}
+
+static void
+init_inmarker (register lread_frame *frame,
+               Lisp_Object marker)
+{
+  frame->input.m = INIT_INMARKER();
+  frame->input.m.marker = marker;
+  if (NILP (frame->start))
+    frame->start = marker;
+  init_inbuffer (frame, Fmarker_buffer(marker));
+}
+
+/* Determine multibyte */
+INLINE void
+report_lread_multibyte (register lread_frame *frame)
+{
+  /* Expect any interruption of read that might cause
+     a change in the coding to set the interrupted frame's
+     multibyte status to indeterminate.  Otherwise,
+     the coding of an input is required to remain constant
+     for the duration of a single call to read */
+  if (frame->multibyte != LREAD_MULTIBYTE_INDETERMINATE)
+    return;
+  switch (frame->intype)
+    {
+    case LREAD_INPUT_FILE:
+      {
+        frame->multibyte = LREAD_MULTIBYTE_TRUE;
+      }
+      break;
+    case LREAD_INPUT_FILE_MULE:
+      frame->multibyte = LREAD_MULTIBYTE_TRUE;
+      break;
+    case LREAD_INPUT_STRING:
+      {
+        frame->multibyte
+          = (STRING_MULTIBYTE (frame->input.s.string))
+          ? LREAD_MULTIBYTE_TRUE
+          : LREAD_MULTIBYTE_FALSE;
+      }
+      break;
+    case LREAD_INPUT_PROCEDURE:
+      frame->multibyte = LREAD_MULTIBYTE_TRUE;
+      break;
+    case LREAD_INPUT_BUFFER:
+      {
+        struct buffer *inbuffer = XBUFFER (frame->input.b.buffer);
+        frame->multibyte
+          = (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
+          ? LREAD_MULTIBYTE_TRUE
+          : LREAD_MULTIBYTE_FALSE;
+      }
+      break;
+    case LREAD_INPUT_MARKER:
+      {
+        struct buffer *inbuffer = XBUFFER (frame->input.m.b.buffer);
+        frame->multibyte
+          = (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
+          ? LREAD_MULTIBYTE_TRUE
+          : LREAD_MULTIBYTE_FALSE;
+      }
+      break;
+    case LREAD_INPUT_INDIRECT:
+      report_lread_multibyte (frame->input.frame.source);
+      frame->multibyte = frame->input.frame.source->multibyte;
+      break;
+    case LREAD_INPUT_BINARY:
+        frame->multibyte = LREAD_MULTIBYTE_FALSE;
+        break;
+    case LREAD_INPUT_NULL:
+      {
+        /* Completely meaningless */
+        frame->multibyte = LREAD_MULTIBYTE_TRUE;
+      }
+      break;
+      UNRECOGNIZED_LREAD_INPUT_CASES("report_multibyte");
+    }
+
+}
+
+
+/* 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)
+{
+  switch (frame->intype)
+    {
+    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");
+    }
+  eassert (0);
+}
+
+static void
+lread_continue_frame_after_interrupt (register lread_frame *frame)
+{
+  /* 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)
+    {
+    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");
+    }
+}
+
+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)
+    {
+      /* this should leave the binding to restore the previous
+         frame in place */
+      lread_unwind_for_eval (frame);
+    }
+  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)
+    {
+      eassert (!specpdl_ref_lt (count, frame->dynamic_frame));
+      unbind_to (count, Qnil);
+      lread_continue_frame_after_interrupt (frame);
+    }
+}
+
+static int
+readbyte_from_stdio (register lread_frame *frame)
+{
+  if (frame->input.f.lookahead)
+    {
+      return (frame->input.f.buf[--(frame->input.f.lookahead)]);
+    }
+
+  int c;
+
+  block_input ();
+
+#if !defined USE_ANDROID_ASSETS
+
+  /* Interrupted reads have been observed while reading over the network.  */
+  while ((c = getc (frame->input.f.stream)) == EOF && errno == EINTR
+         && ferror (frame->input.f.stream))
+    {
+      unblock_input ();
+      lread_maybe_quit (frame);
+      block_input ();
+      clearerr (frame->input.f.stream);
+    }
+
+#else
+
+  {
+    char byte;
+    ssize_t rc;
+
+  retry:
+    rc = android_asset_read (frame->input.f.stream, &byte, 1);
+
+    if (rc == 0)
+      c = EOF;
+    else if (rc == -1)
+      {
+        if (errno == EINTR)
+          {
+            unblock_input ();
+            lread_maybe_quit (frame);
+            block_input ();
+            goto retry;
+          }
+        else
+          c = EOF;
+      }
+    else
+      c = (unsigned char) byte;
+  }
+
+#endif
+
+  unblock_input ();
+  if (c == EOF)
     {
-      readbyte = readbyte_from_file;
-      eassert (infile);
-      emacs_mule_encoding = 1;
-      goto read_multibyte;
+      frame->read_eof = true;
+      c = -1;
     }
+  return c;
+}
 
-  tem = call0 (readcharfun);
+static int
+readbyte_from_file (register lread_frame *frame)
+{
+  eassert (FROM_FILE_P (frame->intype) && (frame->input.f.stream));
+
+  return readbyte_from_stdio (frame);
+}
 
-  if (!FIXNUMP (tem))
+
+/* 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)
+{
+  int dimension = CHARSET_DIMENSION (cs);
+  unsigned code = ENCODE_CHAR (cs, c);
+  int sz;
+  for (sz = 0; dimension > 0 && (code & 0xFF); dimension--)
+    {
+      sz++;
+      code >>= 8;
+    }
+  return sz;
+}
+
+
+#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)
+
+/* internal form of /dev/null */
+static int
+readchar_from_null (register lread_frame *frame)
+{
+  frame->read_eof = true;
   return -1;
-  return XFIXNUM (tem);
+}
 
- read_multibyte:
-  if (unread_char >= 0)
+/* Handle emacs-internal coding */
+static int
+readchar_from_multibyte_file (register lread_frame *frame)
+{
+  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)
     {
-      c = unread_char;
-      unread_char = -1;
+      frame->read_eof = true;
       return c;
     }
-  c = (*readbyte) (-1, readcharfun);
-  if (c < 0)
-    return c;
-  if (multibyte)
-    *multibyte = 1;
-  if (ASCII_CHAR_P (c))
-    return c;
-  if (emacs_mule_encoding)
-    return read_emacs_mule_char (c, readbyte, readcharfun);
-  i = 0;
-  buf[i++] = c;
-  len = BYTES_BY_CHAR_HEAD (c);
-  while (i < len)
+  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
+readchar_from_mule_file (register lread_frame *frame)
+{
+  READCHAR_FROM_FILE_BEGIN(frame);
+  /* Emacs-mule coding uses at most 4-byte for one character.  */
+  int len = emacs_mule_bytes[c];
+  struct charset *charset;
+  unsigned code;
+
+  if (len == 1)
+    /* C is not a valid leading-code of `emacs-mule'.  */
+    return BYTE8_TO_CHAR (c);
+
+  int i = 0;
+  buf[i++] = c;
+  while (i < len)
+    {
+      buf[i++] = c = readbyte_from_file (frame);
+      if (c < 0xA0)
+        {
+          for (i -= c < 0; 0 < --i; )
+            frame->input.f.buf[frame->input.f.lookahead++] = c;
+          return BYTE8_TO_CHAR (buf[0]);
+        }
+    }
+
+  if (len == 2)
+    {
+      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
+      code = buf[1] & 0x7F;
+    }
+  else if (len == 3)
+    {
+      if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
+          || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
+        {
+          charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
+          code = buf[2] & 0x7F;
+        }
+      else
+        {
+          charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
+          code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
+        }
+    }
+  else
+    {
+      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
+      code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
+    }
+  frame->mule_charset = charset;
+  c = DECODE_CHAR (charset, code);
+  if (c < 0)
+    invalid_syntax (frame, "invalid multibyte form");
+  return c;
+}
+
+#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;
+  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_NULL] = readchar_from_indirect,
+    [MULTIBYTE_NULL] = readchar_from_indirect,
+    [UNIBYTE_NULL] = readchar_from_null,
+    [MULTIBYTE_NULL] = readchar_from_null
+  };
+
+#if 0
+static readonechar_func readonechar = NULL;
+#endif
+
+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)
     {
-      buf[i++] = c = (*readbyte) (-1, readcharfun);
-      if (c < 0 || ! TRAILING_CODE_P (c))
+      if (c >= 0)
         {
-	  for (i -= c < 0; 0 < --i; )
-	    (*readbyte) (buf[i], readcharfun);
-	  return BYTE8_TO_CHAR (buf[0]);
+          UNREAD (frame, c);
+        }
+      else
+        c = READCHAR (frame);
     }
+  else
+    {
+      xsignal1 (Qerror,
+                build_string ("reader-input-stream: reader not active"));
     }
-  return STRING_CHAR (buf);
+  return (make_fixnum (c));
 }
 
-#define FROM_FILE_P(readcharfun)			\
-  (EQ (readcharfun, Qget_file_char)			\
-   || EQ (readcharfun, Qget_emacs_mule_file_char))
-
 static void
-skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
+skip_dyn_bytes (register lread_frame *frame, ptrdiff_t n)
 {
-  if (FROM_FILE_P (readcharfun))
+  if (FROM_FILE_P (frame->intype) && !frame->multibyte)
     {
       block_input ();           /* FIXME: Not sure if it's needed.  */
-      file_seek (infile->stream, n - infile->lookahead, SEEK_CUR);
+      file_seek (frame->input.f.stream, n - frame->input.f.lookahead, SEEK_CUR);
+      frame->char_offset += n;
+      frame->byte_offset += n;
       unblock_input ();
-      infile->lookahead = 0;
+      frame->input.f.lookahead = 0;
     }
   else
     { /* We're not reading directly from a file.  In that case, it's difficult
@@ -457,153 +1615,194 @@ skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
          that \037 is the final char.  */
       int c;
       do {
-	c = READCHAR;
+        c = READCHAR (frame);
       } while (c >= 0 && c != '\037');
     }
 }
 
 static void
-skip_dyn_eof (Lisp_Object readcharfun)
+skip_dyn_eof (register lread_frame *frame)
 {
-  if (FROM_FILE_P (readcharfun))
+  if (FROM_FILE_P (frame->intype) && !frame->multibyte)
     {
       block_input ();           /* FIXME: Not sure if it's needed.  */
-      file_seek (infile->stream, 0, SEEK_END);
+      ptrdiff_t n = file_tell (frame->input.f.stream);
+      file_seek (frame->input.f.stream, 0, SEEK_END);
+      n = file_tell (frame->input.f.stream) - n;
+      frame->char_offset += n;
+      frame->byte_offset += n;
       unblock_input ();
-      infile->lookahead = 0;
+      frame->input.f.lookahead = 0;
+      frame->read_eof = true;
     }
   else
-    while (READCHAR >= 0);
+    while (READCHAR (frame) >= 0);
 }
 
-/* Unread the character C in the way appropriate for the stream READCHARFUN.
-   If the stream is a user function, call it with the char as argument.  */
-
-static void
-unreadchar (Lisp_Object readcharfun, int c)
+void
+unreadchar (register lread_frame *frame,int c)
 {
-  readchar_offset--;
-  if (c == -1)
-    /* Don't back up the pointer if we're unreading the end-of-input mark,
-       since readchar didn't advance it when we read it.  */
-    ;
-  else if (BUFFERP (readcharfun))
+  if (c < 0)
+    return;
+  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);
+    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
-	bytepos--;
-
-      SET_BUF_PT_BOTH (b, charpos - 1, bytepos);
+          {
+            frame->unread_bytes = 1;
+            frame->byte_offset--;
+          }
       }
-  else if (MARKERP (readcharfun))
+      break;
+    case LREAD_INPUT_FILE_MULE:
       {
-      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;
+        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;
       }
-  else if (STRINGP (readcharfun))
+      break;
+    case LREAD_INPUT_STRING:
       {
-      read_from_string_index--;
-      read_from_string_index_byte
-	= string_char_to_byte (readcharfun, read_from_string_index);
+        frame->char_offset--;
+        frame->byte_offset -= frame->multibyte ? CHAR_BYTES (c) : 1;
       }
-  else if (FROM_FILE_P (readcharfun))
+      break;
+    case LREAD_INPUT_PROCEDURE:
       {
-      unread_char = c;
+        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
-    calln (readcharfun, make_fixnum (c));
-}
-
-static int
-readbyte_from_stdio (void)
-{
-  if (infile->lookahead)
-    return infile->buf[--infile->lookahead];
-
-  int c;
-  file_stream instream = infile->stream;
-
-  block_input ();
-
-#if !defined USE_ANDROID_ASSETS
-
-  /* Interrupted reads have been observed while reading over the network.  */
-  while ((c = getc (instream)) == EOF && errno == EINTR && ferror (instream))
+          frame->byte_offset--;
+        frame->char_offset--;
+        SET_BUF_PT_BOTH (b, frame->char_offset, frame->byte_offset);
+      }
+      break;
+    case LREAD_INPUT_MARKER:
       {
-      unblock_input ();
-      maybe_quit ();
-      block_input ();
-      clearerr (instream);
+        struct buffer *b = XMARKER (frame->input.m.marker)->buffer;
+        frame->byte_offset = XMARKER (frame->input.m.marker)->bytepos;
+        frame->char_offset = --(XMARKER (frame->input.m.marker)->charpos);
+        if (frame->multibyte)
+          frame->byte_offset -= buf_prev_char_len (b, frame->byte_offset);
+        else
+          frame->byte_offset--;
+        XMARKER (frame->input.m.marker)->bytepos = frame->byte_offset;
+      }
+      break;
+    case LREAD_INPUT_BINARY:
+    case LREAD_INPUT_NULL:
+      break;
+    case LREAD_INPUT_INDIRECT:
+      unreadchar (frame->input.frame.source, c);
+      break;
+      UNRECOGNIZED_LREAD_INPUT_CASES("unreadchar")
     }
+}
 
-#else
+/* 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)
         {
-    char byte;
-    ssize_t rc;
-
-  retry:
-    rc = android_asset_read (instream, &byte, 1);
-
-    if (rc == 0)
-      c = EOF;
-    else if (rc == -1)
+          /* 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--)
             {
-	if (errno == EINTR)
+              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)
             {
-	    unblock_input ();
-	    maybe_quit ();
-	    block_input ();
-	    goto retry;
+              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.
+                     Byte-compiled files are either in
+                     no-conversion unibyte or emacs-mule
+                  */
+                  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
-	  c = EOF;
+              else if (!frame->multibyte)
+                {
+                  /* unibyte */
                 }
               else
-      c = (unsigned char) byte;
-  }
-
-#endif
-
-  unblock_input ();
-
-  return (c == EOF ? -1 : c);
-}
-
-static int
-readbyte_from_file (int c, Lisp_Object readcharfun)
-{
-  eassert (infile);
-  if (c >= 0)
                 {
-      eassert (infile->lookahead < sizeof infile->buf);
-      infile->buf[infile->lookahead++] = c;
-      return 0;
+                  /* 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;
+      UNRECOGNIZED_LREAD_INPUT_CASES("closing_unreadchar");
     }
-
-  return readbyte_from_stdio ();
 }
-
 /* Signal Qinvalid_read_syntax error.
    S is error string of length N (if > 0)  */
 
-static AVOID
-invalid_syntax_lisp (Lisp_Object s, Lisp_Object readcharfun)
+AVOID
+invalid_syntax_lisp (register lread_frame *frame, Lisp_Object s)
 {
-  if (BUFFERP (readcharfun))
+  if (HAS_BUFFER_P (frame->intype))
     {
       ptrdiff_t line, column;
 
@@ -612,7 +1811,7 @@ invalid_syntax_lisp (Lisp_Object s, Lisp_Object readcharfun)
         specpdl_ref count = SPECPDL_INDEX ();
 
         record_unwind_protect_excursion ();
-	set_buffer_internal (XBUFFER (readcharfun));
+        set_buffer_internal (lread_get_buffer(frame));
         line = count_lines (BEGV_BYTE, PT_BYTE) + 1;
         column = current_column ();
         unbind_to (count, Qnil);
@@ -625,73 +1824,13 @@ invalid_syntax_lisp (Lisp_Object s, Lisp_Object readcharfun)
     xsignal1 (Qinvalid_read_syntax, s);
 }
 
-static AVOID
-invalid_syntax (const char *s, Lisp_Object readcharfun)
+AVOID
+invalid_syntax (register lread_frame *frame, const char *s)
 {
-  invalid_syntax_lisp (build_string (s), readcharfun);
+  invalid_syntax_lisp (frame, build_string (s));
 }

-/* Read one non-ASCII character from INFILE.  The character is
-   encoded in `emacs-mule' and the first byte is already read in
-   C.  */
-
-static int
-read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun)
-{
-  /* Emacs-mule coding uses at most 4-byte for one character.  */
-  unsigned char buf[4];
-  int len = emacs_mule_bytes[c];
-  struct charset *charset;
-  int i;
-  unsigned code;
-
-  if (len == 1)
-    /* C is not a valid leading-code of `emacs-mule'.  */
-    return BYTE8_TO_CHAR (c);
-
-  i = 0;
-  buf[i++] = c;
-  while (i < len)
-    {
-      buf[i++] = c = (*readbyte) (-1, readcharfun);
-      if (c < 0xA0)
-	{
-	  for (i -= c < 0; 0 < --i; )
-	    (*readbyte) (buf[i], readcharfun);
-	  return BYTE8_TO_CHAR (buf[0]);
-	}
-    }
-
-  if (len == 2)
-    {
-      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
-      code = buf[1] & 0x7F;
-    }
-  else if (len == 3)
-    {
-      if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
-	  || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
-	{
-	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
-	  code = buf[2] & 0x7F;
-	}
-      else
-	{
-	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
-	  code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
-	}
-    }
-  else
-    {
-      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
-      code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
-    }
-  c = DECODE_CHAR (charset, code);
-  if (c < 0)
-    invalid_syntax ("invalid multibyte form", readcharfun);
-  return c;
-}

 /* An in-progress substitution of OBJECT for PLACEHOLDER.  */
@@ -708,13 +1847,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 +2151,62 @@ 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 != '!')
+        goto not_found;
+      while (ch != '\n' && ch != EOF)
         {
-          UNREAD (ch);
-          UNREAD ('#');
-          return Cookie_None;
+          COOKIE_READ_AND_BUFFER (ch);
         }
-      while (ch != '\n' && ch != EOF)
-        ch = READCHAR;
-      if (ch == '\n') ch = READCHAR;
+      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
+  while (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 +2227,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 +2237,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 +2252,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 +2266,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 +2280,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 +2293,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 +2361,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 +2401,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 +2420,14 @@ suffix_p (Lisp_Object string, const char *suffix)
 static void
 close_infile_unwind (void *arg)
 {
-  struct infile *prev_infile = 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 +2472,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 +2486,82 @@ get_lexical_binding (Lisp_Object stream, Lisp_Object from)
                           from)))));
 }
 
+static void
+load_source_file_kill_buffer (Lisp_Object buffer)
+{
+  specpdl_ref count = SPECPDL_INDEX ();
+  specbind (Qkill_buffer_hook, Qnil);
+  specbind (Qkill_buffer_query_functions, Qnil);
+  unbind_to (count, Fkill_buffer (buffer));
+}
+
+/* Primitive version of load-with-code-conversion */
+static Lisp_Object
+load_source_file (Lisp_Object fullname, Lisp_Object file,
+                  Lisp_Object noerror, Lisp_Object nomessage)
+{
+  if (NILP (Ffile_readable_p (fullname)))
+    {
+      if (NILP (noerror))
+        {
+          xsignal2 (Qfile_error,
+                    build_string ("Cannot open load file"),
+                    file);
+        }
+      return (Qnil);
+    }
+  Lisp_Object sourcename = will_dump_p () ? file : fullname;
+  Lisp_Object buffer_name
+    = Fgenerate_new_buffer_name (build_string (" *load*"), Qnil);
+  Lisp_Object buffer = Fget_buffer_create (buffer_name, Qnil);
+  specpdl_ref count = SPECPDL_INDEX ();
+  /* this is only called for source files */
+  /* load-with-code-conversion binds load-in-progress in an outer
+     scope, where Fload binds it with load-file-name, etc, below */
+  specbind (Qload_in_progress, Qt);
+  if (NILP (nomessage))
+    message_with_string ("Loading %s (source)...", file, 1);
+  if (!NILP (Vpurify_flag))
+    {
+      Vpreloaded_file_list = Fcons (file, Vpreloaded_file_list);
+    }
+  {
+    specpdl_ref count1 = SPECPDL_INDEX ();
+
+    record_unwind_protect (load_source_file_kill_buffer, buffer);
+    /* load-with-code-conversion sets load-file-name to fullname, but
+       load sets it to file ? */
+    specbind (Qload_file_name, file);
+    specbind (Qload_true_file_name, fullname);
+    specbind (Qinhibit_file_name_operation, Qnil);
+    /* If auto-coding was implemented, load would have called
+       load-with-code-conversion instead of this, so don't bother */
+    record_unwind_current_buffer ();
+    Fset_buffer (buffer);
+    Fset_buffer_multibyte (Qt);
+    {
+      specpdl_ref count2 = SPECPDL_INDEX ();
+      specbind (Qdeactivate_mark, Qnil);
+      unbind_to (count2,
+                 Finsert_file_contents (fullname, Qnil, Qnil, Qnil, Qnil));
+    }
+    /* don't worry about shorthands in temacs sans loadup*/
+    /* CAVEAT EMPTOR: require emacs lisp source files read by temacs sans
+       loadup are in encoding compatible with emacs-internal */
+    /* instead of Fset_buffer_modified_p, avoid bothering with
+       the mode-line */
+    Frestore_buffer_modified_p (Qnil);
+    unbind_to (count1,
+               Feval_buffer (buffer, Qnil, sourcename, Qnil, Qt));
+  }
+  if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
+    calln (Qdo_after_load_evaluation, file);
+  if (NILP (nomessage))
+    message_with_string ("Loading %s (source)...done", file, 1);
+  return unbind_to (count, Qt);
+}
+
+
 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
@@ -1438,16 +2699,12 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
             suffixes = CALLN (Fappend, suffixes, Vload_file_rep_suffixes);
         }
 
-      Lisp_Object load_path = Vload_path;
-      if (FUNCTIONP (Vload_path_filter_function))
-	load_path = calln (Vload_path_filter_function, load_path, file, suffixes);
-
 #if !defined USE_ANDROID_ASSETS
-      fd = openp (load_path, file, suffixes, &found, Qnil,
+      fd = openp (Vload_path, file, suffixes, &found, Qnil,
                   load_prefer_newer, no_native, NULL);
 #else
       asset = NULL;
-      rc = openp (load_path, file, suffixes, &found, Qnil,
+      rc = openp (Vload_path, file, suffixes, &found, Qnil,
                   load_prefer_newer, no_native, &asset);
       fd.fd = rc;
       fd.asset = asset;
@@ -1497,6 +2754,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)
@@ -1534,21 +2802,26 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
   /* Check if we're stuck in a recursive load cycle.
 
      2000-09-21: It's not possible to just check for the file loaded
-     being a member of Vloads_in_progress.  This fails because of the
+     being a member of frame->loads_in_progress.  This fails because of the
      way the byte compiler currently works; `provide's are not
      evaluated, see font-lock.el/jit-lock.el as an example.  This
      leads to a certain amount of ``normal'' recursion.
 
      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
@@ -1636,8 +2909,6 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
   else if (!is_module && !is_native_elisp)
     {
       /* We are loading a source file (*.el).  */
-      if (!NILP (Vload_source_file_function))
-	{
       Lisp_Object val;
 
       if (lread_fd_p)
@@ -1645,13 +2916,23 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
           lread_close (fd);
           clear_unwind_protect (fd_index);
         }
+      nomessage = (NILP (nomessage) || force_load_messages) ? Qnil : Qt;
+      if (!NILP (Vload_source_file_function))
         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);
-	}
+                     nomessage);
+      else
+      /* Perform basic emacs-internal only buffer evaluation
+         Anyone loading lisp source files in an incompatible
+         coding is responsible for loading mule.el beforehand. */
+        val = load_source_file (found, hist_file_name,
+                                NILP (noerror) ? Qnil : Qt,
+                                nomessage);
+      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 +2949,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
@@ -1679,11 +2966,10 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
 #endif
 #endif
     }
-
-  /* Declare here rather than inside the else-part because the storage
-     might be accessed by the unbind_to call below.  */
-  struct infile input;
-
+  /* we may or may not need this */
+  lread_frame this_frame = INIT_LREAD_FRAME ();
+  Lisp_Object coding = Qno_conversion;
+  this_frame.loop_dynamic_frame = SPECPDL_INDEX();
   if (is_module || is_native_elisp)
     {
       /* `module-load' uses the file name, so we can close the stream
@@ -1693,17 +2979,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);
@@ -1733,7 +3029,7 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
 #ifdef HAVE_MODULES
       loadhist_initialize (found);
       Fmodule_load (found);
-      build_load_history (found, true);
+      build_load_history (&this_frame,found, true);
 #else
       /* This cannot happen.  */
       emacs_abort ();
@@ -1744,7 +3040,7 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
 #ifdef HAVE_NATIVE_COMP
       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 +3049,16 @@ DEFUN ("load", Fload, Sload, 1, 5, 0,
     }
   else
     {
-      Fset (Qlexical_binding,
-	    get_lexical_binding (Qget_file_char, compiled ? Qnil : file));
+      /* Use internal function to evaluate source files
+         from buffers, so always compiled and lexical-binding = t*/
+      eassert (compiled == 1);
 
-      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);
-        }
+      activate_lread_frame (&this_frame, LREAD_FRAME_MULTIPLE);
+      set_unwind_protect_ptr (fd_index, close_infile_unwind, &this_frame);
+      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 +3066,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 +3580,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;
@@ -2327,13 +3619,13 @@ build_load_history (Lisp_Object filename, bool entire)
                   if (NILP (Fmember (newelt, tem)))
                     Fsetcar (tail, Fcons (XCAR (tem),
                                           Fcons (newelt, XCDR (tem))));
-		  maybe_quit ();
+                  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 +3641,29 @@ 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,93 +3691,145 @@ 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;
+    default:
+    /* skip */
+    }
+  return Qnil;
+}
 
-   START, END specify region to read in current buffer (from eval-region).
-   If the input is not from a buffer, they must be nil.  */
+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;
+    default:
+    /* skip */
+    }
+  return NULL;
+}
 
-static void
-readevalloop (Lisp_Object readcharfun,
-	      struct infile *infile0,
-	      Lisp_Object sourcename,
-	      bool printflag,
-	      Lisp_Object unibyte, Lisp_Object readfun,
+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)
 {
-  int c;
-  Lisp_Object val;
   specpdl_ref count = SPECPDL_INDEX ();
-  struct buffer *b = 0;
-  bool continue_reading_p;
-  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);
-
-  macroexpand = Qinternal_macroexpand_for_load;
-
-  if (NILP (Ffboundp (macroexpand))
-      || (STRINGP (sourcename) && suffix_p (sourcename, ".elc")))
-    /* 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))
+  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))
-	start = readcharfun;
+    {
+      frame->start = buffer_point_marker (buffer);
     }
-
-  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)
-    emacs_abort ();
-
-  specbind (Qstandard_input, readcharfun);
-  record_unwind_protect_int (readevalloop_1, load_convert_to_unibyte);
-  load_convert_to_unibyte = !NILP (unibyte);
-
-  /* If lexical binding is active (either because it was specified in
-     the file's header, or via a buffer-local variable), create an empty
-     lexical environment, otherwise, turn off lexical binding.  */
-  lex_bound = find_symbol_value (Qlexical_binding);
-  specbind (Qinternal_interpreter_environment,
-	    (NILP (lex_bound) || BASE_EQ (lex_bound, Qunbound)
-	     ? Qnil : list1 (Qt)));
-  specbind (Qmacroexp__dynvars, Vmacroexp__dynvars);
-
-  /* Ensure sourcename is absolute, except whilst preloading.  */
-  if (!will_dump_p ()
-      && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename)))
-    sourcename = Fexpand_file_name (sourcename, Qnil);
-
-  loadhist_initialize (sourcename);
-
-  continue_reading_p = 1;
-  while (continue_reading_p)
+  else if (FIXNUMP (start))
     {
-      specpdl_ref count1 = SPECPDL_INDEX ();
+      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;
+}
 
-      if (b != 0 && !BUFFER_LIVE_P (b))
+/* 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");
-
-      if (!NILP (start))
-	{
   /* Switch to the buffer we are reading from.  */
   record_unwind_protect_excursion ();
-	  set_buffer_internal (b);
+  set_buffer_internal (buf);
 
   /* Save point in it.  */
   record_unwind_protect_excursion ();
@@ -2485,108 +3839,268 @@ readevalloop (Lisp_Object readcharfun,
   /* 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);
+  Fgoto_char (frame->start);
+  Fnarrow_to_region (make_fixnum (BEGV), frame->end);
+}
 
-	  /* Just for cleanliness, convert END to a marker
-	     if it is an integer.  */
-	  if (FIXNUMP (end))
-	    end = Fpoint_max_marker ();
-	}
+/* 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 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);
 
-      /* 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 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;
+}
 
-      eassert (!infile0 || infile == infile0);
+INLINE void
+lread_skip_whitespace (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;
+  c = READCHAR (frame);
   if (c == ';')
     {
-	  while ((c = READCHAR) != '\n' && c != -1);
+      while ((c = READCHAR (frame)) != '\n' && c != -1);
       goto read_next;
     }
   if (c < 0)
     {
-	  unbind_to (count1, Qnil);
-	  break;
+      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 (c);
+  UNREAD (frame, 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))
+static Lisp_Object
+readevalloop (Lisp_Object frameptr)
+{
+  register lread_frame *frame = xmint_pointer (frameptr);
+  Lisp_Object val;
+  struct buffer *b = lread_get_buffer (frame);
+  Lisp_Object lex_bound;
+  /* True if reading an entire buffer.  */
+  Lisp_Object macroexpand;
+  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)) || 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;
+
+  /* We assume START is nil when input is not from a buffer.  */
+  if (! NILP (frame->start) && !b)
+    emacs_abort ();
+
+  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
+     lexical environment, otherwise, turn off lexical binding.  */
+  lex_bound = find_symbol_value (Qlexical_binding);
+  specbind (Qinternal_interpreter_environment,
+            (NILP (lex_bound) || BASE_EQ (lex_bound, Qunbound)
+             ? Qnil : list1 (Qt)));
+  specbind (Qmacroexp__dynvars, Vmacroexp__dynvars);
+
+  loadhist_initialize (frame->sourcename);
+  if (b != NULL)
+    frame->whole_buffer =
+      setup_buffer_for_readevalloop (frame, frame->start, frame->end)
+      || frame->whole_buffer;
+
+  lread_init_dynamic_frame (frame);
+
+  while (!frame->read_eof)
     {
-	      val = calln (readfun, readcharfun);
+      frame->objects_map = Fclrhash (frame->objects_map);
+      frame->objects_completed = Fclrhash (frame->objects_completed);
 
-	      /* 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))
+      if (b)
+        prepare_buffer_for_interruptible_read (frame);
+
+      /* Handle the most common case first */
+      /* not sure why the Vpurify_flag/will_dump_p case is special */
+      if (use_read0)
         {
-		  struct buffer *buf = XBUFFER (readcharfun);
-		  if (BUF_PT (buf) == BUF_ZV (buf))
-		    continue_reading_p = 0;
+        /* avoid condition case */
+          lread_skip_whitespace (frame);
+          if (frame->read_eof)
+            {
+              lread_unwind_for_eval (frame);
+              break;
             }
+          val = read0 (frame);
+          frame->nexprs++;
         }
-	  else if (! NILP (Vload_read_function))
-	    val = calln (Vload_read_function, readcharfun);
       else
-	    val = read_internal_start (readcharfun, Qnil, Qnil, false);
+        {
+          /* 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)
+            {
+              eassert (!UNINIT_SPECPDL_REF (frame->dynamic_frame));
+              lread_unwind_for_eval (frame);
+              break;
             }
-      /* 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;
+          frame->nexprs++;
+        }
+
 
-      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_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 (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,
+                                buffer,
+                                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-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
@@ -2607,49 +4121,19 @@ DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
  evaluated code should work normally even if PRINTFLAG is nil, in
  which case the output is displayed in the echo area.
 
-This function ignores the global value of the `lexical-binding'
-variable.  Instead it will heed the buffer-local value of that
-variable and any
+This function ignores the current value of the `lexical-binding'
+variable.  Instead it will heed any
   -*- lexical-binding: t -*-
-settings in the buffer; if there is no such setting, and the
-buffer-local value of the variable is nil, the buffer will be
-evaluated with the value of `lexical binding' equal to its
-top-level default value, as returned by `default-toplevel-value'.
+settings in the buffer, and if there is no such setting, the buffer
+will be evaluated without lexical binding.
 
 This function preserves the position of point.  */)
   (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 +4151,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 +4206,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 +4225,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 +4239,199 @@ 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));
+}
+
+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: read_minibuffer does not offer an option for
+         returning symbols with position */
+      /* 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;
 }
 
-/* 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)
+/* 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 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)))))
+  Lisp_Object full_name = Qnil;
+  Lisp_Object name = Qnil;
+  if (!NILP (coding))
+    {
+      CHECK_CODING_SYSTEM (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;
+    }
+  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))
       {
-      ptrdiff_t startval, endval;
-      Lisp_Object string;
-
-      if (STRINGP (stream))
-	string = stream;
+        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;
         }
-
-  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;
+          stream = base_stream;
+    }
+  frame->start = start;
+  frame->end = end;
+  frame->full_name = full_name;
+  frame->name = name;
+  frame->locate_syms = locate_syms;
+  if (BUFFERP (stream))
+    {
+      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);
+    }
+  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 = INIT_INPROC();
+      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! */
+  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 +4447,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 +4460,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 +4474,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 +4500,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 +4515,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 +4530,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 +4539,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 +4557,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 +4581,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 +4618,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 +4637,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;
             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 +4671,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);
+              invalid_syntax (frame, "Character name too long");
           }
         if (length == 0)
-          invalid_syntax ("Empty character name", readcharfun);
+          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 +4689,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 +4737,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 +4751,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 +4762,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 +4777,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 +4797,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 +4811,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.
@@ -3245,7 +4836,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 +4844,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 +4875,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)
         {
@@ -3299,7 +4890,7 @@ read_string_literal (Lisp_Object readcharfun)
       if (ch == '\\')
         {
           /* First apply string-specific escape rules:  */
-	  ch = READCHAR;
+          ch = READCHAR (frame);
           switch (ch)
             {
             case 's':
@@ -3311,7 +4902,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 +4947,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 +4962,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 +5058,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 +5084,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 +5108,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 +5128,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 +5171,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 +5196,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
+/* 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 +5238,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 +5255,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 +5295,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 +5312,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 +5334,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 +5379,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,55 +5431,116 @@ 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;
+  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;					\
+#define READ_AND_BUFFER(frame,c)                                        \
+  c = READCHAR (frame);                                                 \
   if (c < 0)                                                            \
-    INVALID_SYNTAX_WITH_BUFFER ();		\
-  if (multibyte)				\
+    INVALID_SYNTAX_WITH_BUFFER (frame);                                 \
+  if (frame->multibyte)                                                 \
     p += CHAR_STRING (c, (unsigned char *) p);                          \
   else                                                                  \
     *p++ = c;                                                           \
@@ -3959,21 +5548,22 @@ #define READ_AND_BUFFER(c)			\
     {                                                                   \
       offset = p - read_buffer;                                         \
       read_buffer = grow_read_buffer (read_buffer, offset,		\
-				       &heapbuf, &read_buffer_size, count); \
+				      &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 +5572,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 +5583,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 +5622,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?  */
       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 +5673,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 +5692,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 +5776,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 +5812,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 +5829,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 +5852,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);
+                    if (n < 0 || n > 36)
+                      invalid_radix_integer (frame,n);
+                    obj = read_integer (frame, n);
                     break;
                   }
                 else if (n <= MOST_POSITIVE_FIXNUM && !NILP (Vread_circle))
@@ -4287,7 +5875,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 +5884,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 +5895,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 +5938,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 +5959,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 +5997,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 +6013,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 +6034,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 +6052,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
@@ -4488,7 +6076,7 @@ read0 (Lisp_Object readcharfun, bool locate_syms)
 
             Lisp_Object found;
             if (skip_shorthand
-		/* We exempt characters used in the "core" Emacs Lisp
+/* We exempt characters used in the "core" Emacs Lisp
    symbols that are comprised entirely of characters
    that have the 'symbol constituent' syntax from
    transforming according to shorthands.  */
@@ -4507,18 +6095,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 +6117,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 +6137,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 +6151,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 +6166,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 +6189,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 +6204,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 +6213,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 +6227,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 +6489,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)
@@ -4987,7 +6568,7 @@ intern_1 (const char *str, ptrdiff_t len)
   Lisp_Object tem = oblookup (obarray, str, len, len);
 
   return (BARE_SYMBOL_P (tem) ? tem
-	  /* The above `oblookup' was done on the basis of nchars==nbytes, so
+/* The above `oblookup' was done on the basis of nchars==nbytes, so
    the string has to be unibyte.  */
           : intern_driver (make_unibyte_string (str, len),
                            obarray, tem));
@@ -5149,14 +6730,14 @@ DEFUN ("unintern", Funintern, Sunintern, 2, 2, 0,
                                         SCHARS (string), SBYTES (string),
                                         &longhand, &longhand_chars,
                                         &longhand_bytes);
+  if (FIXNUMP (tem)
+/* If arg was a symbol, don't delete anything but that symbol itself.  */
+      || (BARE_SYMBOL_P (name) && !BASE_EQ (name, tem)))
+    {
       if (longhand)
-    xfree(longhand);
-
-  if (FIXNUMP (tem))
-    return Qnil;
-  /* If arg was a symbol, don't delete anything but that symbol itself.  */
-  if (BARE_SYMBOL_P (name) && !BASE_EQ (name, tem))
+        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 +6749,23 @@ 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;
+  {
+    /* 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 it? */
+    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 +6791,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 +6812,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;
@@ -5629,7 +7225,7 @@ load_path_check (Lisp_Object lpath)
 static Lisp_Object
 load_path_default (void)
 {
-  if (will_dump_p ())
+  if (will_dump_p () || (!initialized && !NILP(Vinstallation_directory)))
     /* PATH_DUMPLOADSEARCH is the lisp dir in the source directory.
        We used to add ../lisp (ie the lisp dir in the build
        directory) at the front here, but that should not be
@@ -5801,7 +7397,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 +7442,157 @@ 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:
+      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:
+      frame->char_offset = frame->input.frame.source->char_offset;
+      frame->byte_offset = frame->input.frame.source->byte_offset;
+      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;
+    }
+  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)
 {
@@ -5944,8 +7700,6 @@ syms_of_lread (void)
 customize `jka-compr-load-suffixes' rather than the present variable.  */);
   Vload_file_rep_suffixes = list1 (empty_unibyte_string);
 
-  DEFSYM (Qjka_compr_load_suffixes, "jka-compr-load-suffixes");
-
   DEFVAR_BOOL ("load-in-progress", load_in_progress,
     doc: /* Non-nil if inside of `load'.  */);
   DEFSYM (Qload_in_progress, "load-in-progress");
@@ -6010,6 +7764,7 @@ syms_of_lread (void)
     doc: /* Used for internal purposes by `load'.  */);
   Vcurrent_load_list = Qnil;
 
+  DEFSYM (Qload_read_function,"load-read-function");
   DEFVAR_LISP ("load-read-function", Vload_read_function,
     doc: /* Function used for reading expressions.
 It is used by `load' and `eval-region'.
@@ -6127,30 +7882,28 @@ syms_of_lread (void)
 through `require'.  */);
   load_no_native = false;
 
-  DEFVAR_LISP ("load-path-filter-function",
-	       Vload_path_filter_function,
-	       doc: /* If non-nil, a function to filter `load-path' for `load'.
-
-If this variable is a function, it is called when `load' is about to
-search for a file along `load-path'.  This function is called with three
-arguments: the current value of `load-path' (a list of directories),
-the FILE argument to `load', and the current list of load-suffixes.
-
-It should return a (hopefully shorter) list of directories, which `load'
-will use instead of `load-path' to look for the file to load.  */);
-  Vload_path_filter_function = Qnil;
-
   /* Vsource_directory was initialized in init_lread.  */
 
   DEFSYM (Qcurrent_load_list, "current-load-list");
   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 +7928,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");