root/src/lread.c

DEFINITIONS

1. readchar
2. skip_dyn_bytes
3. skip_dyn_eof
4. unreadchar
5. readbyte_for_lambda
6. readbyte_from_stdio
7. readbyte_from_file
8. readbyte_from_string
9. invalid_syntax_lisp
10. invalid_syntax
11. read_emacs_mule_char
12. read_filtered_event
13. DEFUN
14. lisp_file_lexically_bound_p
15. safe_to_load_version
16. record_load_unwind
17. load_error_handler
18. load_warn_unescaped_character_literals
19. DEFUN
20. suffix_p
21. close_infile_unwind
22. compute_found_effective
23. loadhist_initialize
24. save_match_data_load
25. complete_filename_p
26. maybe_swap_for_eln1
27. maybe_swap_for_eln
28. openp
29. build_load_history
30. readevalloop_1
31. end_of_file_error
32. readevalloop_eager_expand_eval
33. readevalloop
34. DEFUN
35. DEFUN
36. read_internal_start
37. grow_read_buffer
38. character_name_to_code
39. read_escape
40. digit_to_number
41. invalid_radix_integer
42. read_integer
43. read_char_literal
44. read_string_literal
45. hash_table_from_plist
46. record_from_list
47. vector_from_rev_list
48. bytecode_from_rev_list
49. char_table_from_rev_list
50. sub_char_table_from_rev_list
51. string_props_from_rev_list
52. read_bool_vector
53. skip_lazy_string
54. get_lazy_string
55. symbol_char_span
56. skip_space_and_comments
57. mark_lread
58. read_stack_top
59. read_stack_pop
60. read_stack_empty_p
61. grow_read_stack
62. read_stack_push
63. read_stack_reset
64. read0
65. substitute_object_recurse
66. substitute_in_interval
67. string_to_number
68. check_obarray
69. intern_sym
70. intern_driver
71. intern_1
72. intern_c_string_1
73. define_symbol
74. oblookup
75. oblookup_considering_shorthand
76. map_obarray
77. mapatoms_1
78. init_obarray_once
79. defsubr
80. defalias
81. defvar_int
82. defvar_bool
83. defvar_lisp_nopro
84. defvar_lisp
85. defvar_kboard
86. load_path_check
87. load_path_default
88. init_lread
89. dir_warning
90. syms_of_lread

     1 /* Lisp parsing and input streams.
     2 
     3 Copyright (C) 1985-1989, 1993-1995, 1997-2023 Free Software Foundation,
     4 Inc.
     5 
     6 This file is part of GNU Emacs.
     7 
     8 GNU Emacs is free software: you can redistribute it and/or modify
     9 it under the terms of the GNU General Public License as published by
    10 the Free Software Foundation, either version 3 of the License, or (at
    11 your option) any later version.
    12 
    13 GNU Emacs is distributed in the hope that it will be useful,
    14 but WITHOUT ANY WARRANTY; without even the implied warranty of
    15 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    16 GNU General Public License for more details.
    17 
    18 You should have received a copy of the GNU General Public License
    19 along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.  */
    20 
    21 /* Tell globals.h to define tables needed by init_obarray.  */
    22 #define DEFINE_SYMBOLS
    23 
    24 #include <config.h>
    25 #include "sysstdio.h"
    26 #include <stdlib.h>
    27 #include <sys/types.h>
    28 #include <sys/stat.h>
    29 #include <sys/file.h>
    30 #include <errno.h>
    31 #include <math.h>
    32 #include <stat-time.h>
    33 #include "lisp.h"
    34 #include "dispextern.h"
    35 #include "intervals.h"
    36 #include "character.h"
    37 #include "buffer.h"
    38 #include "charset.h"
    39 #include <epaths.h>
    40 #include "commands.h"
    41 #include "keyboard.h"
    42 #include "systime.h"
    43 #include "termhooks.h"
    44 #include "blockinput.h"
    45 #include "pdumper.h"
    46 #include <c-ctype.h>
    47 #include <vla.h>
    48 
    49 #ifdef MSDOS
    50 #include "msdos.h"
    51 #endif
    52 
    53 #ifdef HAVE_NS
    54 #include "nsterm.h"
    55 #endif
    56 
    57 #include <unistd.h>
    58 
    59 #ifdef HAVE_SETLOCALE
    60 #include <locale.h>
    61 #endif /* HAVE_SETLOCALE */
    62 
    63 #include <fcntl.h>
    64 
    65 #ifdef HAVE_FSEEKO
    66 #define file_offset off_t
    67 #define file_tell ftello
    68 #else
    69 #define file_offset long
    70 #define file_tell ftell
    71 #endif
    72 
    73 #if IEEE_FLOATING_POINT
    74 # include <ieee754.h>
    75 # ifndef INFINITY
    76 #  define INFINITY ((union ieee754_double) {.ieee = {.exponent = -1}}.d)
    77 # endif
    78 #endif
    79 
    80 /* The objects or placeholders read with the #n=object form.
    81 
    82    A hash table maps a number to either a placeholder (while the
    83    object is still being parsed, in case it's referenced within its
    84    own definition) or to the completed object.  With small integers
    85    for keys, it's effectively little more than a vector, but it'll
    86    manage any needed resizing for us.
    87 
    88    The variable must be reset to an empty hash table before all
    89    top-level calls to read0.  In between calls, it may be an empty
    90    hash table left unused from the previous call (to reduce
    91    allocations), or nil.  */
    92 static Lisp_Object read_objects_map;
    93 
    94 /* The recursive objects read with the #n=object form.
    95 
    96    Objects that might have circular references are stored here, so
    97    that recursive substitution knows not to keep processing them
    98    multiple times.
    99 
   100    Only objects that are completely processed, including substituting
   101    references to themselves (but not necessarily replacing
   102    placeholders for other objects still being read), are stored.
   103 
   104    A hash table is used for efficient lookups of keys.  We don't care
   105    what the value slots hold.  The variable must be set to an empty
   106    hash table before all top-level calls to read0.  In between calls,
   107    it may be an empty hash table left unused from the previous call
   108    (to reduce allocations), or nil.  */
   109 static Lisp_Object read_objects_completed;
   110 
   111 /* File and lookahead for get-file-char and get-emacs-mule-file-char
   112    to read from.  Used by Fload.  */
   113 static struct infile
   114 {
   115   /* The input stream.  */
   116   FILE *stream;
   117 
   118   /* Lookahead byte count.  */
   119   signed char lookahead;
   120 
   121   /* Lookahead bytes, in reverse order.  Keep these here because it is
   122      not portable to ungetc more than one byte at a time.  */
   123   unsigned char buf[MAX_MULTIBYTE_LENGTH - 1];
   124 } *infile;
   125 
   126 /* For use within read-from-string (this reader is non-reentrant!!)  */
   127 static ptrdiff_t read_from_string_index;
   128 static ptrdiff_t read_from_string_index_byte;
   129 static ptrdiff_t read_from_string_limit;
   130 
   131 /* Position in object from which characters are being read by `readchar'.  */
   132 static EMACS_INT readchar_offset;
   133 
   134 struct saved_string {
   135   char *string;                 /* string in allocated buffer */
   136   ptrdiff_t size;               /* allocated size of buffer */
   137   ptrdiff_t length;             /* length of string in buffer */
   138   file_offset position;         /* position in file the string came from */
   139 };
   140 
   141 /* The last two strings skipped with #@ (most recent first).  */
   142 static struct saved_string saved_strings[2];
   143 
   144 /* A list of file names for files being loaded in Fload.  Used to
   145    check for recursive loads.  */
   146 
   147 static Lisp_Object Vloads_in_progress;
   148 
   149 static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
   150                                  Lisp_Object);
   151 
   152 static void readevalloop (Lisp_Object, struct infile *, Lisp_Object, bool,
   153                           Lisp_Object, Lisp_Object,
   154                           Lisp_Object, Lisp_Object);
   155 
   156 static void build_load_history (Lisp_Object, bool);
   157 
   158 static Lisp_Object oblookup_considering_shorthand (Lisp_Object, const char *,
   159                                                    ptrdiff_t, ptrdiff_t,
   160                                                    char **, ptrdiff_t *,
   161                                                    ptrdiff_t *);
   162 
   163 
   164 /* Functions that read one byte from the current source READCHARFUN
   165    or unreads one byte.  If the integer argument C is -1, it returns
   166    one read byte, or -1 when there's no more byte in the source.  If C
   167    is 0 or positive, it unreads C, and the return value is not
   168    interesting.  */
   169 
   170 static int readbyte_for_lambda (int, Lisp_Object);
   171 static int readbyte_from_file (int, Lisp_Object);
   172 static int readbyte_from_string (int, Lisp_Object);
   173 
   174 /* Handle unreading and rereading of characters.
   175    Write READCHAR to read a character,
   176    UNREAD(c) to unread c to be read again.
   177 
   178    These macros correctly read/unread multibyte characters.  */
   179 
   180 #define READCHAR readchar (readcharfun, NULL)
   181 #define UNREAD(c) unreadchar (readcharfun, c)
   182 
   183 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source.  */
   184 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
   185 
   186 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
   187    Qlambda, or a cons, we use this to keep an unread character because
   188    a file stream can't handle multibyte-char unreading.  The value -1
   189    means that there's no unread character.  */
   190 static int unread_char = -1;
   191 
   192 static int
   193 readchar (Lisp_Object readcharfun, bool *multibyte)
   194 {
   195   Lisp_Object tem;
   196   register int c;
   197   int (*readbyte) (int, Lisp_Object);
   198   unsigned char buf[MAX_MULTIBYTE_LENGTH];
   199   int i, len;
   200   bool emacs_mule_encoding = 0;
   201 
   202   if (multibyte)
   203     *multibyte = 0;
   204 
   205   readchar_offset++;
   206 
   207   if (BUFFERP (readcharfun))
   208     {
   209       register struct buffer *inbuffer = XBUFFER (readcharfun);
   210 
   211       ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
   212 
   213       if (! BUFFER_LIVE_P (inbuffer))
   214         return -1;
   215 
   216       if (pt_byte >= BUF_ZV_BYTE (inbuffer))
   217         return -1;
   218 
   219       if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
   220         {
   221           /* Fetch the character code from the buffer.  */
   222           unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
   223           int clen;
   224           c = string_char_and_length (p, &clen);
   225           pt_byte += clen;
   226           if (multibyte)
   227             *multibyte = 1;
   228         }
   229       else
   230         {
   231           c = BUF_FETCH_BYTE (inbuffer, pt_byte);
   232           if (! ASCII_CHAR_P (c))
   233             c = BYTE8_TO_CHAR (c);
   234           pt_byte++;
   235         }
   236       SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
   237 
   238       return c;
   239     }
   240   if (MARKERP (readcharfun))
   241     {
   242       register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
   243 
   244       ptrdiff_t bytepos = marker_byte_position (readcharfun);
   245 
   246       if (bytepos >= BUF_ZV_BYTE (inbuffer))
   247         return -1;
   248 
   249       if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
   250         {
   251           /* Fetch the character code from the buffer.  */
   252           unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
   253           int clen;
   254           c = string_char_and_length (p, &clen);
   255           bytepos += clen;
   256           if (multibyte)
   257             *multibyte = 1;
   258         }
   259       else
   260         {
   261           c = BUF_FETCH_BYTE (inbuffer, bytepos);
   262           if (! ASCII_CHAR_P (c))
   263             c = BYTE8_TO_CHAR (c);
   264           bytepos++;
   265         }
   266 
   267       XMARKER (readcharfun)->bytepos = bytepos;
   268       XMARKER (readcharfun)->charpos++;
   269 
   270       return c;
   271     }
   272 
   273   if (EQ (readcharfun, Qlambda))
   274     {
   275       readbyte = readbyte_for_lambda;
   276       goto read_multibyte;
   277     }
   278 
   279   if (EQ (readcharfun, Qget_file_char))
   280     {
   281       eassert (infile);
   282       readbyte = readbyte_from_file;
   283       goto read_multibyte;
   284     }
   285 
   286   if (STRINGP (readcharfun))
   287     {
   288       if (read_from_string_index >= read_from_string_limit)
   289         c = -1;
   290       else if (STRING_MULTIBYTE (readcharfun))
   291         {
   292           if (multibyte)
   293             *multibyte = 1;
   294           c = (fetch_string_char_advance_no_check
   295                (readcharfun,
   296                 &read_from_string_index,
   297                 &read_from_string_index_byte));
   298         }
   299       else
   300         {
   301           c = SREF (readcharfun, read_from_string_index_byte);
   302           read_from_string_index++;
   303           read_from_string_index_byte++;
   304         }
   305       return c;
   306     }
   307 
   308   if (CONSP (readcharfun) && STRINGP (XCAR (readcharfun)))
   309     {
   310       /* This is the case that read_vector is reading from a unibyte
   311          string that contains a byte sequence previously skipped
   312          because of #@NUMBER.  The car part of readcharfun is that
   313          string, and the cdr part is a value of readcharfun given to
   314          read_vector.  */
   315       readbyte = readbyte_from_string;
   316       eassert (infile);
   317       if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
   318         emacs_mule_encoding = 1;
   319       goto read_multibyte;
   320     }
   321 
   322   if (EQ (readcharfun, Qget_emacs_mule_file_char))
   323     {
   324       readbyte = readbyte_from_file;
   325       eassert (infile);
   326       emacs_mule_encoding = 1;
   327       goto read_multibyte;
   328     }
   329 
   330   tem = call0 (readcharfun);
   331 
   332   if (NILP (tem))
   333     return -1;
   334   return XFIXNUM (tem);
   335 
   336  read_multibyte:
   337   if (unread_char >= 0)
   338     {
   339       c = unread_char;
   340       unread_char = -1;
   341       return c;
   342     }
   343   c = (*readbyte) (-1, readcharfun);
   344   if (c < 0)
   345     return c;
   346   if (multibyte)
   347     *multibyte = 1;
   348   if (ASCII_CHAR_P (c))
   349     return c;
   350   if (emacs_mule_encoding)
   351     return read_emacs_mule_char (c, readbyte, readcharfun);
   352   i = 0;
   353   buf[i++] = c;
   354   len = BYTES_BY_CHAR_HEAD (c);
   355   while (i < len)
   356     {
   357       buf[i++] = c = (*readbyte) (-1, readcharfun);
   358       if (c < 0 || ! TRAILING_CODE_P (c))
   359         {
   360           for (i -= c < 0; 0 < --i; )
   361             (*readbyte) (buf[i], readcharfun);
   362           return BYTE8_TO_CHAR (buf[0]);
   363         }
   364     }
   365   return STRING_CHAR (buf);
   366 }
   367 
   368 #define FROM_FILE_P(readcharfun)                        \
   369   (EQ (readcharfun, Qget_file_char)                     \
   370    || EQ (readcharfun, Qget_emacs_mule_file_char))
   371 
   372 static void
   373 skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
   374 {
   375   if (FROM_FILE_P (readcharfun))
   376     {
   377       block_input ();           /* FIXME: Not sure if it's needed.  */
   378       fseek (infile->stream, n - infile->lookahead, SEEK_CUR);
   379       unblock_input ();
   380       infile->lookahead = 0;
   381     }
   382   else
   383     { /* We're not reading directly from a file.  In that case, it's difficult
   384          to reliably count bytes, since these are usually meant for the file's
   385          encoding, whereas we're now typically in the internal encoding.
   386          But luckily, skip_dyn_bytes is used to skip over a single
   387          dynamic-docstring (or dynamic byte-code) which is always quoted such
   388          that \037 is the final char.  */
   389       int c;
   390       do {
   391         c = READCHAR;
   392       } while (c >= 0 && c != '\037');
   393     }
   394 }
   395 
   396 static void
   397 skip_dyn_eof (Lisp_Object readcharfun)
   398 {
   399   if (FROM_FILE_P (readcharfun))
   400     {
   401       block_input ();           /* FIXME: Not sure if it's needed.  */
   402       fseek (infile->stream, 0, SEEK_END);
   403       unblock_input ();
   404       infile->lookahead = 0;
   405     }
   406   else
   407     while (READCHAR >= 0);
   408 }
   409 
   410 /* Unread the character C in the way appropriate for the stream READCHARFUN.
   411    If the stream is a user function, call it with the char as argument.  */
   412 
   413 static void
   414 unreadchar (Lisp_Object readcharfun, int c)
   415 {
   416   readchar_offset--;
   417   if (c == -1)
   418     /* Don't back up the pointer if we're unreading the end-of-input mark,
   419        since readchar didn't advance it when we read it.  */
   420     ;
   421   else if (BUFFERP (readcharfun))
   422     {
   423       struct buffer *b = XBUFFER (readcharfun);
   424       ptrdiff_t charpos = BUF_PT (b);
   425       ptrdiff_t bytepos = BUF_PT_BYTE (b);
   426 
   427       if (! NILP (BVAR (b, enable_multibyte_characters)))
   428         bytepos -= buf_prev_char_len (b, bytepos);
   429       else
   430         bytepos--;
   431 
   432       SET_BUF_PT_BOTH (b, charpos - 1, bytepos);
   433     }
   434   else if (MARKERP (readcharfun))
   435     {
   436       struct buffer *b = XMARKER (readcharfun)->buffer;
   437       ptrdiff_t bytepos = XMARKER (readcharfun)->bytepos;
   438 
   439       XMARKER (readcharfun)->charpos--;
   440       if (! NILP (BVAR (b, enable_multibyte_characters)))
   441         bytepos -= buf_prev_char_len (b, bytepos);
   442       else
   443         bytepos--;
   444 
   445       XMARKER (readcharfun)->bytepos = bytepos;
   446     }
   447   else if (STRINGP (readcharfun))
   448     {
   449       read_from_string_index--;
   450       read_from_string_index_byte
   451         = string_char_to_byte (readcharfun, read_from_string_index);
   452     }
   453   else if (CONSP (readcharfun) && STRINGP (XCAR (readcharfun)))
   454     {
   455       unread_char = c;
   456     }
   457   else if (EQ (readcharfun, Qlambda))
   458     {
   459       unread_char = c;
   460     }
   461   else if (FROM_FILE_P (readcharfun))
   462     {
   463       unread_char = c;
   464     }
   465   else
   466     call1 (readcharfun, make_fixnum (c));
   467 }
   468 
   469 static int
   470 readbyte_for_lambda (int c, Lisp_Object readcharfun)
   471 {
   472   return read_bytecode_char (c >= 0);
   473 }
   474 
   475 
   476 static int
   477 readbyte_from_stdio (void)
   478 {
   479   if (infile->lookahead)
   480     return infile->buf[--infile->lookahead];
   481 
   482   int c;
   483   FILE *instream = infile->stream;
   484 
   485   block_input ();
   486 
   487   /* Interrupted reads have been observed while reading over the network.  */
   488   while ((c = getc (instream)) == EOF && errno == EINTR && ferror (instream))
   489     {
   490       unblock_input ();
   491       maybe_quit ();
   492       block_input ();
   493       clearerr (instream);
   494     }
   495 
   496   unblock_input ();
   497 
   498   return (c == EOF ? -1 : c);
   499 }
   500 
   501 static int
   502 readbyte_from_file (int c, Lisp_Object readcharfun)
   503 {
   504   eassert (infile);
   505   if (c >= 0)
   506     {
   507       eassert (infile->lookahead < sizeof infile->buf);
   508       infile->buf[infile->lookahead++] = c;
   509       return 0;
   510     }
   511 
   512   return readbyte_from_stdio ();
   513 }
   514 
   515 static int
   516 readbyte_from_string (int c, Lisp_Object readcharfun)
   517 {
   518   Lisp_Object string = XCAR (readcharfun);
   519 
   520   if (c >= 0)
   521     {
   522       read_from_string_index--;
   523       read_from_string_index_byte
   524         = string_char_to_byte (string, read_from_string_index);
   525     }
   526 
   527   return (read_from_string_index < read_from_string_limit
   528           ? fetch_string_char_advance (string,
   529                                        &read_from_string_index,
   530                                        &read_from_string_index_byte)
   531           : -1);
   532 }
   533 
   534 
   535 /* Signal Qinvalid_read_syntax error.
   536    S is error string of length N (if > 0)  */
   537 
   538 static AVOID
   539 invalid_syntax_lisp (Lisp_Object s, Lisp_Object readcharfun)
   540 {
   541   if (BUFFERP (readcharfun))
   542     {
   543       ptrdiff_t line, column;
   544 
   545       /* Get the line/column in the readcharfun buffer.  */
   546       {
   547         specpdl_ref count = SPECPDL_INDEX ();
   548 
   549         record_unwind_protect_excursion ();
   550         set_buffer_internal (XBUFFER (readcharfun));
   551         line = count_lines (BEGV_BYTE, PT_BYTE) + 1;
   552         column = current_column ();
   553         unbind_to (count, Qnil);
   554       }
   555 
   556       xsignal (Qinvalid_read_syntax,
   557                list3 (s, make_fixnum (line), make_fixnum (column)));
   558     }
   559   else
   560     xsignal1 (Qinvalid_read_syntax, s);
   561 }
   562 
   563 static AVOID
   564 invalid_syntax (const char *s, Lisp_Object readcharfun)
   565 {
   566   invalid_syntax_lisp (build_string (s), readcharfun);
   567 }
   568 
   569 
   570 /* Read one non-ASCII character from INFILE.  The character is
   571    encoded in `emacs-mule' and the first byte is already read in
   572    C.  */
   573 
   574 static int
   575 read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun)
   576 {
   577   /* Emacs-mule coding uses at most 4-byte for one character.  */
   578   unsigned char buf[4];
   579   int len = emacs_mule_bytes[c];
   580   struct charset *charset;
   581   int i;
   582   unsigned code;
   583 
   584   if (len == 1)
   585     /* C is not a valid leading-code of `emacs-mule'.  */
   586     return BYTE8_TO_CHAR (c);
   587 
   588   i = 0;
   589   buf[i++] = c;
   590   while (i < len)
   591     {
   592       buf[i++] = c = (*readbyte) (-1, readcharfun);
   593       if (c < 0xA0)
   594         {
   595           for (i -= c < 0; 0 < --i; )
   596             (*readbyte) (buf[i], readcharfun);
   597           return BYTE8_TO_CHAR (buf[0]);
   598         }
   599     }
   600 
   601   if (len == 2)
   602     {
   603       charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
   604       code = buf[1] & 0x7F;
   605     }
   606   else if (len == 3)
   607     {
   608       if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
   609           || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
   610         {
   611           charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
   612           code = buf[2] & 0x7F;
   613         }
   614       else
   615         {
   616           charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
   617           code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
   618         }
   619     }
   620   else
   621     {
   622       charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
   623       code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
   624     }
   625   c = DECODE_CHAR (charset, code);
   626   if (c < 0)
   627     invalid_syntax ("invalid multibyte form", readcharfun);
   628   return c;
   629 }
   630 
   631 
   632 /* An in-progress substitution of OBJECT for PLACEHOLDER.  */
   633 struct subst
   634 {
   635   Lisp_Object object;
   636   Lisp_Object placeholder;
   637 
   638   /* Hash table of subobjects of OBJECT that might be circular.  If
   639      Qt, all such objects might be circular.  */
   640   Lisp_Object completed;
   641 
   642   /* List of subobjects of OBJECT that have already been visited.  */
   643   Lisp_Object seen;
   644 };
   645 
   646 static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
   647                                         Lisp_Object, bool);
   648 static Lisp_Object read0 (Lisp_Object, bool);
   649 
   650 static Lisp_Object substitute_object_recurse (struct subst *, Lisp_Object);
   651 static void substitute_in_interval (INTERVAL, void *);
   652 
   653 
   654 /* Get a character from the tty.  */
   655 
   656 /* Read input events until we get one that's acceptable for our purposes.
   657 
   658    If NO_SWITCH_FRAME, switch-frame events are stashed
   659    until we get a character we like, and then stuffed into
   660    unread_switch_frame.
   661 
   662    If ASCII_REQUIRED, check function key events to see
   663    if the unmodified version of the symbol has a Qascii_character
   664    property, and use that character, if present.
   665 
   666    If ERROR_NONASCII, signal an error if the input we
   667    get isn't an ASCII character with modifiers.  If it's false but
   668    ASCII_REQUIRED is true, just re-read until we get an ASCII
   669    character.
   670 
   671    If INPUT_METHOD, invoke the current input method
   672    if the character warrants that.
   673 
   674    If SECONDS is a number, wait that many seconds for input, and
   675    return Qnil if no input arrives within that time.  */
   676 
   677 static Lisp_Object
   678 read_filtered_event (bool no_switch_frame, bool ascii_required,
   679                      bool error_nonascii, bool input_method, Lisp_Object seconds)
   680 {
   681   Lisp_Object val, delayed_switch_frame;
   682   struct timespec end_time;
   683 
   684 #ifdef HAVE_WINDOW_SYSTEM
   685   if (display_hourglass_p)
   686     cancel_hourglass ();
   687 #endif
   688 
   689   delayed_switch_frame = Qnil;
   690 
   691   /* Compute timeout.  */
   692   if (NUMBERP (seconds))
   693     {
   694       double duration = XFLOATINT (seconds);
   695       struct timespec wait_time = dtotimespec (duration);
   696       end_time = timespec_add (current_timespec (), wait_time);
   697     }
   698 
   699   /* Read until we get an acceptable event.  */
   700  retry:
   701   do
   702     val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0,
   703                      NUMBERP (seconds) ? &end_time : NULL);
   704   while (FIXNUMP (val) && XFIXNUM (val) == -2); /* wrong_kboard_jmpbuf */
   705 
   706   if (BUFFERP (val))
   707     goto retry;
   708 
   709   /* `switch-frame' events are put off until after the next ASCII
   710      character.  This is better than signaling an error just because
   711      the last characters were typed to a separate minibuffer frame,
   712      for example.  Eventually, some code which can deal with
   713      switch-frame events will read it and process it.  */
   714   if (no_switch_frame
   715       && EVENT_HAS_PARAMETERS (val)
   716       && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
   717     {
   718       delayed_switch_frame = val;
   719       goto retry;
   720     }
   721 
   722   if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
   723     {
   724       /* Convert certain symbols to their ASCII equivalents.  */
   725       if (SYMBOLP (val))
   726         {
   727           Lisp_Object tem, tem1;
   728           tem = Fget (val, Qevent_symbol_element_mask);
   729           if (!NILP (tem))
   730             {
   731               tem1 = Fget (Fcar (tem), Qascii_character);
   732               /* Merge this symbol's modifier bits
   733                  with the ASCII equivalent of its basic code.  */
   734               if (!NILP (tem1))
   735                 XSETFASTINT (val, XFIXNUM (tem1) | XFIXNUM (Fcar (Fcdr (tem))));
   736             }
   737         }
   738 
   739       /* If we don't have a character now, deal with it appropriately.  */
   740       if (!FIXNUMP (val))
   741         {
   742           if (error_nonascii)
   743             {
   744               Vunread_command_events = list1 (val);
   745               error ("Non-character input-event");
   746             }
   747           else
   748             goto retry;
   749         }
   750     }
   751 
   752   if (! NILP (delayed_switch_frame))
   753     unread_switch_frame = delayed_switch_frame;
   754 
   755 #if 0
   756 
   757 #ifdef HAVE_WINDOW_SYSTEM
   758   if (display_hourglass_p)
   759     start_hourglass ();
   760 #endif
   761 
   762 #endif
   763 
   764   return val;
   765 }
   766 
   767 DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
   768        doc: /* Read a character event from the command input (keyboard or macro).
   769 It is returned as a number.
   770 If the event has modifiers, they are resolved and reflected in the
   771 returned character code if possible (e.g. C-SPC yields 0 and C-a yields 97).
   772 If some of the modifiers cannot be reflected in the character code, the
   773 returned value will include those modifiers, and will not be a valid
   774 character code: it will fail the `characterp' test.  Use `event-basic-type'
   775 to recover the character code with the modifiers removed.
   776 
   777 If the user generates an event which is not a character (i.e. a mouse
   778 click or function key event), `read-char' signals an error.  As an
   779 exception, switch-frame events are put off until non-character events
   780 can be read.
   781 If you want to read non-character events, or ignore them, call
   782 `read-event' or `read-char-exclusive' instead.
   783 
   784 If the optional argument PROMPT is non-nil, display that as a prompt.
   785 If PROMPT is nil or the string \"\", the key sequence/events that led
   786 to the current command is used as the prompt.
   787 
   788 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
   789 input method is turned on in the current buffer, that input method
   790 is used for reading a character.
   791 
   792 If the optional argument SECONDS is non-nil, it should be a number
   793 specifying the maximum number of seconds to wait for input.  If no
   794 input arrives in that time, return nil.  SECONDS may be a
   795 floating-point value.
   796 
   797 If `inhibit-interaction' is non-nil, this function will signal an
   798 `inhibited-interaction' error.  */)
   799   (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
   800 {
   801   Lisp_Object val;
   802 
   803   barf_if_interaction_inhibited ();
   804 
   805   if (! NILP (prompt))
   806     {
   807       cancel_echoing ();
   808       message_with_string ("%s", prompt, 0);
   809     }
   810   val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
   811 
   812   return (NILP (val) ? Qnil
   813           : make_fixnum (char_resolve_modifier_mask (XFIXNUM (val))));
   814 }
   815 
   816 DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
   817        doc: /* Read an event object from the input stream.
   818 
   819 If you want to read non-character events, consider calling `read-key'
   820 instead.  `read-key' will decode events via `input-decode-map' that
   821 `read-event' will not.  On a terminal this includes function keys such
   822 as <F7> and <RIGHT>, or mouse events generated by `xterm-mouse-mode'.
   823 
   824 If the optional argument PROMPT is non-nil, display that as a prompt.
   825 If PROMPT is nil or the string \"\", the key sequence/events that led
   826 to the current command is used as the prompt.
   827 
   828 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
   829 input method is turned on in the current buffer, that input method
   830 is used for reading a character.
   831 
   832 If the optional argument SECONDS is non-nil, it should be a number
   833 specifying the maximum number of seconds to wait for input.  If no
   834 input arrives in that time, return nil.  SECONDS may be a
   835 floating-point value.
   836 
   837 If `inhibit-interaction' is non-nil, this function will signal an
   838 `inhibited-interaction' error.  */)
   839   (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
   840 {
   841   barf_if_interaction_inhibited ();
   842 
   843   if (! NILP (prompt))
   844     {
   845       cancel_echoing ();
   846       message_with_string ("%s", prompt, 0);
   847     }
   848   return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
   849 }
   850 
   851 DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
   852        doc: /* Read a character event from the command input (keyboard or macro).
   853 It is returned as a number.  Non-character events are ignored.
   854 If the event has modifiers, they are resolved and reflected in the
   855 returned character code if possible (e.g. C-SPC yields 0 and C-a yields 97).
   856 If some of the modifiers cannot be reflected in the character code, the
   857 returned value will include those modifiers, and will not be a valid
   858 character code: it will fail the `characterp' test.  Use `event-basic-type'
   859 to recover the character code with the modifiers removed.
   860 
   861 If the optional argument PROMPT is non-nil, display that as a prompt.
   862 If PROMPT is nil or the string \"\", the key sequence/events that led
   863 to the current command is used as the prompt.
   864 
   865 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
   866 input method is turned on in the current buffer, that input method
   867 is used for reading a character.
   868 
   869 If the optional argument SECONDS is non-nil, it should be a number
   870 specifying the maximum number of seconds to wait for input.  If no
   871 input arrives in that time, return nil.  SECONDS may be a
   872 floating-point value.
   873 
   874 If `inhibit-interaction' is non-nil, this function will signal an
   875 `inhibited-interaction' error.  */)
   876 (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
   877 {
   878   Lisp_Object val;
   879 
   880   barf_if_interaction_inhibited ();
   881 
   882   if (! NILP (prompt))
   883     {
   884       cancel_echoing ();
   885       message_with_string ("%s", prompt, 0);
   886     }
   887 
   888   val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
   889 
   890   return (NILP (val) ? Qnil
   891           : make_fixnum (char_resolve_modifier_mask (XFIXNUM (val))));
   892 }
   893 
   894 DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
   895        doc: /* Don't use this yourself.  */)
   896   (void)
   897 {
   898   if (!infile)
   899     error ("get-file-char misused");
   900   return make_fixnum (readbyte_from_stdio ());
   901 }
   902 
   903 
   904 
   905 
   906 /* Return true if the lisp code read using READCHARFUN defines a non-nil
   907    `lexical-binding' file variable.  After returning, the stream is
   908    positioned following the first line, if it is a comment or #! line,
   909    otherwise nothing is read.  */
   910 
   911 static bool
   912 lisp_file_lexically_bound_p (Lisp_Object readcharfun)
   913 {
   914   int ch = READCHAR;
   915 
   916   if (ch == '#')
   917     {
   918       ch = READCHAR;
   919       if (ch != '!')
   920         {
   921           UNREAD (ch);
   922           UNREAD ('#');
   923           return 0;
   924         }
   925       while (ch != '\n' && ch != EOF)
   926         ch = READCHAR;
   927       if (ch == '\n') ch = READCHAR;
   928       /* It is OK to leave the position after a #! line, since
   929          that is what read0 does.  */
   930     }
   931 
   932   if (ch != ';')
   933     /* The first line isn't a comment, just give up.  */
   934     {
   935       UNREAD (ch);
   936       return 0;
   937     }
   938   else
   939     /* Look for an appropriate file-variable in the first line.  */
   940     {
   941       bool rv = 0;
   942       enum {
   943         NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX
   944       } beg_end_state = NOMINAL;
   945       bool in_file_vars = 0;
   946 
   947 #define UPDATE_BEG_END_STATE(ch)                                \
   948   if (beg_end_state == NOMINAL)                                 \
   949     beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL);   \
   950   else if (beg_end_state == AFTER_FIRST_DASH)                   \
   951     beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL);      \
   952   else if (beg_end_state == AFTER_ASTERIX)                      \
   953     {                                                           \
   954       if (ch == '-')                                            \
   955         in_file_vars = !in_file_vars;                           \
   956       beg_end_state = NOMINAL;                                  \
   957     }
   958 
   959       /* Skip until we get to the file vars, if any.  */
   960       do
   961         {
   962           ch = READCHAR;
   963           UPDATE_BEG_END_STATE (ch);
   964         }
   965       while (!in_file_vars && ch != '\n' && ch != EOF);
   966 
   967       while (in_file_vars)
   968         {
   969           char var[100], val[100];
   970           unsigned i;
   971 
   972           ch = READCHAR;
   973 
   974           /* Read a variable name.  */
   975           while (ch == ' ' || ch == '\t')
   976             ch = READCHAR;
   977 
   978           i = 0;
   979           beg_end_state = NOMINAL;
   980           while (ch != ':' && ch != '\n' && ch != EOF && in_file_vars)
   981             {
   982               if (i < sizeof var - 1)
   983                 var[i++] = ch;
   984               UPDATE_BEG_END_STATE (ch);
   985               ch = READCHAR;
   986             }
   987 
   988           /* Stop scanning if no colon was found before end marker.  */
   989           if (!in_file_vars || ch == '\n' || ch == EOF)
   990             break;
   991 
   992           while (i > 0 && (var[i - 1] == ' ' || var[i - 1] == '\t'))
   993             i--;
   994           var[i] = '\0';
   995 
   996           if (ch == ':')
   997             {
   998               /* Read a variable value.  */
   999               ch = READCHAR;
  1000 
  1001               while (ch == ' ' || ch == '\t')
  1002                 ch = READCHAR;
  1003 
  1004               i = 0;
  1005               beg_end_state = NOMINAL;
  1006               while (ch != ';' && ch != '\n' && ch != EOF && in_file_vars)
  1007                 {
  1008                   if (i < sizeof val - 1)
  1009                     val[i++] = ch;
  1010                   UPDATE_BEG_END_STATE (ch);
  1011                   ch = READCHAR;
  1012                 }
  1013               if (! in_file_vars)
  1014                 /* The value was terminated by an end-marker, which remove.  */
  1015                 i -= 3;
  1016               while (i > 0 && (val[i - 1] == ' ' || val[i - 1] == '\t'))
  1017                 i--;
  1018               val[i] = '\0';
  1019 
  1020               if (strcmp (var, "lexical-binding") == 0)
  1021                 /* This is it...  */
  1022                 {
  1023                   rv = (strcmp (val, "nil") != 0);
  1024                   break;
  1025                 }
  1026             }
  1027         }
  1028 
  1029       while (ch != '\n' && ch != EOF)
  1030         ch = READCHAR;
  1031 
  1032       return rv;
  1033     }
  1034 }
  1035 
  1036 /* Value is a version number of byte compiled code if the file
  1037    associated with file descriptor FD is a compiled Lisp file that's
  1038    safe to load.  Only files compiled with Emacs can be loaded.  */
  1039 
  1040 static int
  1041 safe_to_load_version (Lisp_Object file, int fd)
  1042 {
  1043   struct stat st;
  1044   char buf[512];
  1045   int nbytes, i;
  1046   int version = 1;
  1047 
  1048   /* If the file is not regular, then we cannot safely seek it.
  1049      Assume that it is not safe to load as a compiled file.  */
  1050   if (fstat (fd, &st) == 0 && !S_ISREG (st.st_mode))
  1051     return 0;
  1052 
  1053   /* Read the first few bytes from the file, and look for a line
  1054      specifying the byte compiler version used.  */
  1055   nbytes = emacs_read_quit (fd, buf, sizeof buf);
  1056   if (nbytes > 0)
  1057     {
  1058       /* Skip to the next newline, skipping over the initial `ELC'
  1059          with NUL bytes following it, but note the version.  */
  1060       for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
  1061         if (i == 4)
  1062           version = buf[i];
  1063 
  1064       if (i >= nbytes
  1065           || fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
  1066                                               buf + i, nbytes - i) < 0)
  1067         version = 0;
  1068     }
  1069 
  1070   if (lseek (fd, 0, SEEK_SET) < 0)
  1071     report_file_error ("Seeking to start of file", file);
  1072 
  1073   return version;
  1074 }
  1075 
  1076 
  1077 /* Callback for record_unwind_protect.  Restore the old load list OLD,
  1078    after loading a file successfully.  */
  1079 
  1080 static void
  1081 record_load_unwind (Lisp_Object old)
  1082 {
  1083   Vloads_in_progress = old;
  1084 }
  1085 
  1086 /* This handler function is used via internal_condition_case_1.  */
  1087 
  1088 static Lisp_Object
  1089 load_error_handler (Lisp_Object data)
  1090 {
  1091   return Qnil;
  1092 }
  1093 
  1094 static void
  1095 load_warn_unescaped_character_literals (Lisp_Object file)
  1096 {
  1097   Lisp_Object function
  1098     = Fsymbol_function (Qbyte_run_unescaped_character_literals_warning);
  1099   /* If byte-run.el is being loaded,
  1100      `byte-run--unescaped-character-literals-warning' isn't yet
  1101      defined.  Since it'll be byte-compiled later, ignore potential
  1102      unescaped character literals. */
  1103   Lisp_Object warning = NILP (function) ? Qnil : call0 (function);
  1104   if (!NILP (warning))
  1105     {
  1106       AUTO_STRING (format, "Loading `%s': %s");
  1107       CALLN (Fmessage, format, file, warning);
  1108     }
  1109 }
  1110 
  1111 DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
  1112        doc: /* Return the suffixes that `load' should try if a suffix is \
  1113 required.
  1114 This uses the variables `load-suffixes' and `load-file-rep-suffixes'.  */)
  1115   (void)
  1116 {
  1117   Lisp_Object lst = Qnil, suffixes = Vload_suffixes;
  1118   FOR_EACH_TAIL (suffixes)
  1119     {
  1120       Lisp_Object exts = Vload_file_rep_suffixes;
  1121       Lisp_Object suffix = XCAR (suffixes);
  1122       FOR_EACH_TAIL (exts)
  1123         lst = Fcons (concat2 (suffix, XCAR (exts)), lst);
  1124     }
  1125   return Fnreverse (lst);
  1126 }
  1127 
  1128 /* Return true if STRING ends with SUFFIX.  */
  1129 bool
  1130 suffix_p (Lisp_Object string, const char *suffix)
  1131 {
  1132   ptrdiff_t suffix_len = strlen (suffix);
  1133   ptrdiff_t string_len = SBYTES (string);
  1134 
  1135   return (suffix_len <= string_len
  1136           && strcmp (SSDATA (string) + string_len - suffix_len, suffix) == 0);
  1137 }
  1138 
  1139 static void
  1140 close_infile_unwind (void *arg)
  1141 {
  1142   struct infile *prev_infile = arg;
  1143   eassert (infile && infile != prev_infile);
  1144   fclose (infile->stream);
  1145   infile = prev_infile;
  1146 }
  1147 
  1148 /* Compute the filename we want in `load-history' and `load-file-name'.  */
  1149 
  1150 static Lisp_Object
  1151 compute_found_effective (Lisp_Object found)
  1152 {
  1153   /* Reconstruct the .elc filename.  */
  1154   Lisp_Object src_name =
  1155     Fgethash (Ffile_name_nondirectory (found), Vcomp_eln_to_el_h, Qnil);
  1156 
  1157   if (NILP (src_name))
  1158     /* Manual eln load.  */
  1159     return found;
  1160 
  1161   if (suffix_p (src_name, "el.gz"))
  1162     src_name = Fsubstring (src_name, make_fixnum (0), make_fixnum (-3));
  1163   return concat2 (src_name, build_string ("c"));
  1164 }
  1165 
  1166 static void
  1167 loadhist_initialize (Lisp_Object filename)
  1168 {
  1169   eassert (STRINGP (filename) || NILP (filename));
  1170   specbind (Qcurrent_load_list, Fcons (filename, Qnil));
  1171 }
  1172 
  1173 DEFUN ("load", Fload, Sload, 1, 5, 0,
  1174        doc: /* Execute a file of Lisp code named FILE.
  1175 First try FILE with `.elc' appended, then try with `.el', then try
  1176 with a system-dependent suffix of dynamic modules (see `load-suffixes'),
  1177 then try FILE unmodified (the exact suffixes in the exact order are
  1178 determined by `load-suffixes').  Environment variable references in
  1179 FILE are replaced with their values by calling `substitute-in-file-name'.
  1180 This function searches the directories in `load-path'.
  1181 
  1182 If optional second arg NOERROR is non-nil,
  1183 report no error if FILE doesn't exist.
  1184 Print messages at start and end of loading unless
  1185 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
  1186 overrides that).
  1187 If optional fourth arg NOSUFFIX is non-nil, don't try adding
  1188 suffixes to the specified name FILE.
  1189 If optional fifth arg MUST-SUFFIX is non-nil, insist on
  1190 the suffix `.elc' or `.el' or the module suffix; don't accept just
  1191 FILE unless it ends in one of those suffixes or includes a directory name.
  1192 
  1193 If NOSUFFIX is nil, then if a file could not be found, try looking for
  1194 a different representation of the file by adding non-empty suffixes to
  1195 its name, before trying another file.  Emacs uses this feature to find
  1196 compressed versions of files when Auto Compression mode is enabled.
  1197 If NOSUFFIX is non-nil, disable this feature.
  1198 
  1199 The suffixes that this function tries out, when NOSUFFIX is nil, are
  1200 given by the return value of `get-load-suffixes' and the values listed
  1201 in `load-file-rep-suffixes'.  If MUST-SUFFIX is non-nil, only the
  1202 return value of `get-load-suffixes' is used, i.e. the file name is
  1203 required to have a non-empty suffix.
  1204 
  1205 When searching suffixes, this function normally stops at the first
  1206 one that exists.  If the option `load-prefer-newer' is non-nil,
  1207 however, it tries all suffixes, and uses whichever file is the newest.
  1208 
  1209 Loading a file records its definitions, and its `provide' and
  1210 `require' calls, in an element of `load-history' whose
  1211 car is the file name loaded.  See `load-history'.
  1212 
  1213 While the file is in the process of being loaded, the variable
  1214 `load-in-progress' is non-nil and the variable `load-file-name'
  1215 is bound to the file's name.
  1216 
  1217 Return t if the file exists and loads successfully.  */)
  1218   (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage,
  1219    Lisp_Object nosuffix, Lisp_Object must_suffix)
  1220 {
  1221   FILE *stream UNINIT;
  1222   int fd;
  1223   specpdl_ref fd_index UNINIT;
  1224   specpdl_ref count = SPECPDL_INDEX ();
  1225   Lisp_Object found, efound, hist_file_name;
  1226   /* True means we printed the ".el is newer" message.  */
  1227   bool newer = 0;
  1228   /* True means we are loading a compiled file.  */
  1229   bool compiled = 0;
  1230   Lisp_Object handler;
  1231   const char *fmode = "r" FOPEN_TEXT;
  1232   int version;
  1233 
  1234   CHECK_STRING (file);
  1235 
  1236   /* If file name is magic, call the handler.  */
  1237   handler = Ffind_file_name_handler (file, Qload);
  1238   if (!NILP (handler))
  1239     return
  1240       call6 (handler, Qload, file, noerror, nomessage, nosuffix, must_suffix);
  1241 
  1242   /* The presence of this call is the result of a historical accident:
  1243      it used to be in every file-operation and when it got removed
  1244      everywhere, it accidentally stayed here.  Since then, enough people
  1245      supposedly have things like (load "$PROJECT/foo.el") in their .emacs
  1246      that it seemed risky to remove.  */
  1247   if (! NILP (noerror))
  1248     {
  1249       file = internal_condition_case_1 (Fsubstitute_in_file_name, file,
  1250                                         Qt, load_error_handler);
  1251       if (NILP (file))
  1252         return Qnil;
  1253     }
  1254   else
  1255     file = Fsubstitute_in_file_name (file);
  1256 
  1257   bool no_native = suffix_p (file, ".elc");
  1258 
  1259   /* Avoid weird lossage with null string as arg,
  1260      since it would try to load a directory as a Lisp file.  */
  1261   if (SCHARS (file) == 0)
  1262     {
  1263       fd = -1;
  1264       errno = ENOENT;
  1265     }
  1266   else
  1267     {
  1268       Lisp_Object suffixes;
  1269       found = Qnil;
  1270 
  1271       if (! NILP (must_suffix))
  1272         {
  1273           /* Don't insist on adding a suffix if FILE already ends with one.  */
  1274           if (suffix_p (file, ".el")
  1275               || suffix_p (file, ".elc")
  1276 #ifdef HAVE_MODULES
  1277               || suffix_p (file, MODULES_SUFFIX)
  1278 #ifdef MODULES_SECONDARY_SUFFIX
  1279               || suffix_p (file, MODULES_SECONDARY_SUFFIX)
  1280 #endif
  1281 #endif
  1282 #ifdef HAVE_NATIVE_COMP
  1283               || suffix_p (file, NATIVE_ELISP_SUFFIX)
  1284 #endif
  1285               )
  1286             must_suffix = Qnil;
  1287           /* Don't insist on adding a suffix
  1288              if the argument includes a directory name.  */
  1289           else if (! NILP (Ffile_name_directory (file)))
  1290             must_suffix = Qnil;
  1291         }
  1292 
  1293       if (!NILP (nosuffix))
  1294         suffixes = Qnil;
  1295       else
  1296         {
  1297           suffixes = Fget_load_suffixes ();
  1298           if (NILP (must_suffix))
  1299             suffixes = CALLN (Fappend, suffixes, Vload_file_rep_suffixes);
  1300         }
  1301 
  1302       fd =
  1303         openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer,
  1304                no_native);
  1305     }
  1306 
  1307   if (fd == -1)
  1308     {
  1309       if (NILP (noerror))
  1310         report_file_error ("Cannot open load file", file);
  1311       return Qnil;
  1312     }
  1313 
  1314   /* Tell startup.el whether or not we found the user's init file.  */
  1315   if (EQ (Qt, Vuser_init_file))
  1316     Vuser_init_file = found;
  1317 
  1318   /* If FD is -2, that means openp found a magic file.  */
  1319   if (fd == -2)
  1320     {
  1321       if (NILP (Fequal (found, file)))
  1322         /* If FOUND is a different file name from FILE,
  1323            find its handler even if we have already inhibited
  1324            the `load' operation on FILE.  */
  1325         handler = Ffind_file_name_handler (found, Qt);
  1326       else
  1327         handler = Ffind_file_name_handler (found, Qload);
  1328       if (! NILP (handler))
  1329         return call5 (handler, Qload, found, noerror, nomessage, Qt);
  1330 #ifdef DOS_NT
  1331       /* Tramp has to deal with semi-broken packages that prepend
  1332          drive letters to remote files.  For that reason, Tramp
  1333          catches file operations that test for file existence, which
  1334          makes openp think X:/foo.elc files are remote.  However,
  1335          Tramp does not catch `load' operations for such files, so we
  1336          end up with a nil as the `load' handler above.  If we would
  1337          continue with fd = -2, we will behave wrongly, and in
  1338          particular try reading a .elc file in the "rt" mode instead
  1339          of "rb".  See bug #9311 for the results.  To work around
  1340          this, we try to open the file locally, and go with that if it
  1341          succeeds.  */
  1342       fd = emacs_open (SSDATA (ENCODE_FILE (found)), O_RDONLY, 0);
  1343       if (fd == -1)
  1344         fd = -2;
  1345 #endif
  1346     }
  1347 
  1348   if (0 <= fd)
  1349     {
  1350       fd_index = SPECPDL_INDEX ();
  1351       record_unwind_protect_int (close_file_unwind, fd);
  1352     }
  1353 
  1354 #ifdef HAVE_MODULES
  1355   bool is_module =
  1356     suffix_p (found, MODULES_SUFFIX)
  1357 #ifdef MODULES_SECONDARY_SUFFIX
  1358     || suffix_p (found, MODULES_SECONDARY_SUFFIX)
  1359 #endif
  1360     ;
  1361 #else
  1362   bool is_module = false;
  1363 #endif
  1364 
  1365 #ifdef HAVE_NATIVE_COMP
  1366   bool is_native_elisp = suffix_p (found, NATIVE_ELISP_SUFFIX);
  1367 #else
  1368   bool is_native_elisp = false;
  1369 #endif
  1370 
  1371   /* Check if we're stuck in a recursive load cycle.
  1372 
  1373      2000-09-21: It's not possible to just check for the file loaded
  1374      being a member of Vloads_in_progress.  This fails because of the
  1375      way the byte compiler currently works; `provide's are not
  1376      evaluated, see font-lock.el/jit-lock.el as an example.  This
  1377      leads to a certain amount of ``normal'' recursion.
  1378 
  1379      Also, just loading a file recursively is not always an error in
  1380      the general case; the second load may do something different.  */
  1381   {
  1382     int load_count = 0;
  1383     Lisp_Object tem = Vloads_in_progress;
  1384     FOR_EACH_TAIL_SAFE (tem)
  1385       if (!NILP (Fequal (found, XCAR (tem))) && (++load_count > 3))
  1386         signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
  1387     record_unwind_protect (record_load_unwind, Vloads_in_progress);
  1388     Vloads_in_progress = Fcons (found, Vloads_in_progress);
  1389   }
  1390 
  1391   /* All loads are by default dynamic, unless the file itself specifies
  1392      otherwise using a file-variable in the first line.  This is bound here
  1393      so that it takes effect whether or not we use
  1394      Vload_source_file_function.  */
  1395   specbind (Qlexical_binding, Qnil);
  1396 
  1397   Lisp_Object found_eff =
  1398     is_native_elisp
  1399     ? compute_found_effective (found)
  1400     : found;
  1401 
  1402   hist_file_name = (! NILP (Vpurify_flag)
  1403                     ? concat2 (Ffile_name_directory (file),
  1404                                Ffile_name_nondirectory (found_eff))
  1405                     : found_eff);
  1406 
  1407   version = -1;
  1408 
  1409   /* Check for the presence of unescaped character literals and warn
  1410      about them. */
  1411   specbind (Qlread_unescaped_character_literals, Qnil);
  1412   record_unwind_protect (load_warn_unescaped_character_literals, file);
  1413 
  1414   bool is_elc = suffix_p (found, ".elc");
  1415   if (is_elc
  1416       /* version = 1 means the file is empty, in which case we can
  1417          treat it as not byte-compiled.  */
  1418       || (fd >= 0 && (version = safe_to_load_version (file, fd)) > 1))
  1419     /* Load .elc files directly, but not when they are
  1420        remote and have no handler!  */
  1421     {
  1422       if (fd != -2)
  1423         {
  1424           struct stat s1, s2;
  1425           int result;
  1426 
  1427           struct timespec epoch_timespec = {(time_t)0, 0}; /* 1970-01-01T00:00 UTC */
  1428           if (version < 0 && !(version = safe_to_load_version (file, fd)))
  1429             error ("File `%s' was not compiled in Emacs", SDATA (found));
  1430 
  1431           compiled = 1;
  1432 
  1433           efound = ENCODE_FILE (found);
  1434           fmode = "r" FOPEN_BINARY;
  1435 
  1436           /* openp already checked for newness, no point doing it again.
  1437              FIXME would be nice to get a message when openp
  1438              ignores suffix order due to load_prefer_newer.  */
  1439           if (!load_prefer_newer && is_elc)
  1440             {
  1441               result = emacs_fstatat (AT_FDCWD, SSDATA (efound), &s1, 0);
  1442               if (result == 0)
  1443                 {
  1444                   SSET (efound, SBYTES (efound) - 1, 0);
  1445                   result = emacs_fstatat (AT_FDCWD, SSDATA (efound), &s2, 0);
  1446                   SSET (efound, SBYTES (efound) - 1, 'c');
  1447                 }
  1448 
  1449               if (result == 0
  1450                   && timespec_cmp (get_stat_mtime (&s1), get_stat_mtime (&s2)) < 0)
  1451                 {
  1452                   /* Make the progress messages mention that source is newer.  */
  1453                   newer = 1;
  1454 
  1455                   /* If we won't print another message, mention this anyway.  */
  1456                   if (!NILP (nomessage) && !force_load_messages
  1457                       /* We don't want this message during
  1458                          bootstrapping for the "compile-first" .elc
  1459                          files, which have had their timestamps set to
  1460                          the epoch.  See bug #58224.  */
  1461                       && timespec_cmp (get_stat_mtime (&s1), epoch_timespec))
  1462                     {
  1463                       Lisp_Object msg_file;
  1464                       msg_file = Fsubstring (found, make_fixnum (0), make_fixnum (-1));
  1465                       message_with_string ("Source file `%s' newer than byte-compiled file; using older file",
  1466                                            msg_file, 1);
  1467                     }
  1468                 }
  1469             } /* !load_prefer_newer */
  1470         }
  1471     }
  1472   else if (!is_module && !is_native_elisp)
  1473     {
  1474       /* We are loading a source file (*.el).  */
  1475       if (!NILP (Vload_source_file_function))
  1476         {
  1477           Lisp_Object val;
  1478 
  1479           if (fd >= 0)
  1480             {
  1481               emacs_close (fd);
  1482               clear_unwind_protect (fd_index);
  1483             }
  1484           val = call4 (Vload_source_file_function, found, hist_file_name,
  1485                        NILP (noerror) ? Qnil : Qt,
  1486                        (NILP (nomessage) || force_load_messages) ? Qnil : Qt);
  1487           return unbind_to (count, val);
  1488         }
  1489     }
  1490 
  1491   if (fd < 0)
  1492     {
  1493       /* We somehow got here with fd == -2, meaning the file is deemed
  1494          to be remote.  Don't even try to reopen the file locally;
  1495          just force a failure.  */
  1496       stream = NULL;
  1497       errno = EINVAL;
  1498     }
  1499   else if (!is_module && !is_native_elisp)
  1500     {
  1501 #ifdef WINDOWSNT
  1502       emacs_close (fd);
  1503       clear_unwind_protect (fd_index);
  1504       efound = ENCODE_FILE (found);
  1505       stream = emacs_fopen (SSDATA (efound), fmode);
  1506 #else
  1507       stream = fdopen (fd, fmode);
  1508 #endif
  1509     }
  1510 
  1511   /* Declare here rather than inside the else-part because the storage
  1512      might be accessed by the unbind_to call below.  */
  1513   struct infile input;
  1514 
  1515   if (is_module || is_native_elisp)
  1516     {
  1517       /* `module-load' uses the file name, so we can close the stream
  1518          now.  */
  1519       if (fd >= 0)
  1520         {
  1521           emacs_close (fd);
  1522           clear_unwind_protect (fd_index);
  1523         }
  1524     }
  1525   else
  1526     {
  1527       if (! stream)
  1528         report_file_error ("Opening stdio stream", file);
  1529       set_unwind_protect_ptr (fd_index, close_infile_unwind, infile);
  1530       input.stream = stream;
  1531       input.lookahead = 0;
  1532       infile = &input;
  1533       unread_char = -1;
  1534     }
  1535 
  1536   if (! NILP (Vpurify_flag))
  1537     Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list);
  1538 
  1539   if (NILP (nomessage) || force_load_messages)
  1540     {
  1541       if (is_module)
  1542         message_with_string ("Loading %s (module)...", file, 1);
  1543       else if (is_native_elisp)
  1544         message_with_string ("Loading %s (native compiled elisp)...", file, 1);
  1545       else if (!compiled)
  1546         message_with_string ("Loading %s (source)...", file, 1);
  1547       else if (newer)
  1548         message_with_string ("Loading %s (compiled; note, source file is newer)...",
  1549                  file, 1);
  1550       else /* The typical case; compiled file newer than source file.  */
  1551         message_with_string ("Loading %s...", file, 1);
  1552     }
  1553 
  1554   specbind (Qload_file_name, hist_file_name);
  1555   specbind (Qload_true_file_name, found);
  1556   specbind (Qinhibit_file_name_operation, Qnil);
  1557   specbind (Qload_in_progress, Qt);
  1558 
  1559   if (is_module)
  1560     {
  1561 #ifdef HAVE_MODULES
  1562       loadhist_initialize (found);
  1563       Fmodule_load (found);
  1564       build_load_history (found, true);
  1565 #else
  1566       /* This cannot happen.  */
  1567       emacs_abort ();
  1568 #endif
  1569     }
  1570   else if (is_native_elisp)
  1571     {
  1572 #ifdef HAVE_NATIVE_COMP
  1573       loadhist_initialize (hist_file_name);
  1574       Fnative_elisp_load (found, Qnil);
  1575       build_load_history (hist_file_name, true);
  1576 #else
  1577       /* This cannot happen.  */
  1578       emacs_abort ();
  1579 #endif
  1580 
  1581     }
  1582   else
  1583     {
  1584       if (lisp_file_lexically_bound_p (Qget_file_char))
  1585         Fset (Qlexical_binding, Qt);
  1586 
  1587       if (! version || version >= 22)
  1588         readevalloop (Qget_file_char, &input, hist_file_name,
  1589                       0, Qnil, Qnil, Qnil, Qnil);
  1590       else
  1591         {
  1592           /* We can't handle a file which was compiled with
  1593              byte-compile-dynamic by older version of Emacs.  */
  1594           specbind (Qload_force_doc_strings, Qt);
  1595           readevalloop (Qget_emacs_mule_file_char, &input, hist_file_name,
  1596                         0, Qnil, Qnil, Qnil, Qnil);
  1597         }
  1598     }
  1599   unbind_to (count, Qnil);
  1600 
  1601   /* Run any eval-after-load forms for this file.  */
  1602   if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
  1603     call1 (Qdo_after_load_evaluation, hist_file_name) ;
  1604 
  1605   for (int i = 0; i < ARRAYELTS (saved_strings); i++)
  1606     {
  1607       xfree (saved_strings[i].string);
  1608       saved_strings[i].string = NULL;
  1609       saved_strings[i].size = 0;
  1610     }
  1611 
  1612   if (!noninteractive && (NILP (nomessage) || force_load_messages))
  1613     {
  1614       if (is_module)
  1615         message_with_string ("Loading %s (module)...done", file, 1);
  1616       else if (is_native_elisp)
  1617         message_with_string ("Loading %s (native compiled elisp)...done", file, 1);
  1618       else if (!compiled)
  1619         message_with_string ("Loading %s (source)...done", file, 1);
  1620       else if (newer)
  1621         message_with_string ("Loading %s (compiled; note, source file is newer)...done",
  1622                  file, 1);
  1623       else /* The typical case; compiled file newer than source file.  */
  1624         message_with_string ("Loading %s...done", file, 1);
  1625     }
  1626 
  1627   return Qt;
  1628 }
  1629 
  1630 Lisp_Object
  1631 save_match_data_load (Lisp_Object file, Lisp_Object noerror,
  1632                       Lisp_Object nomessage, Lisp_Object nosuffix,
  1633                       Lisp_Object must_suffix)
  1634 {
  1635   specpdl_ref count = SPECPDL_INDEX ();
  1636   record_unwind_save_match_data ();
  1637   Lisp_Object result = Fload (file, noerror, nomessage, nosuffix, must_suffix);
  1638   return unbind_to (count, result);
  1639 }
  1640 
  1641 static bool
  1642 complete_filename_p (Lisp_Object pathname)
  1643 {
  1644   const unsigned char *s = SDATA (pathname);
  1645   return (IS_DIRECTORY_SEP (s[0])
  1646           || (SCHARS (pathname) > 2
  1647               && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2])));
  1648 }
  1649 
  1650 DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
  1651        doc: /* Search for FILENAME through PATH.
  1652 Returns the file's name in absolute form, or nil if not found.
  1653 If SUFFIXES is non-nil, it should be a list of suffixes to append to
  1654 file name when searching.
  1655 If non-nil, PREDICATE is used instead of `file-readable-p'.
  1656 PREDICATE can also be an integer to pass to the faccessat(2) function,
  1657 in which case file-name-handlers are ignored.
  1658 This function will normally skip directories, so if you want it to find
  1659 directories, make sure the PREDICATE function returns `dir-ok' for them.  */)
  1660   (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate)
  1661 {
  1662   Lisp_Object file;
  1663   int fd = openp (path, filename, suffixes, &file, predicate, false, true);
  1664   if (NILP (predicate) && fd >= 0)
  1665     emacs_close (fd);
  1666   return file;
  1667 }
  1668 
  1669 #ifdef HAVE_NATIVE_COMP
  1670 static bool
  1671 maybe_swap_for_eln1 (Lisp_Object src_name, Lisp_Object eln_name,
  1672                      Lisp_Object *filename, int *fd, struct timespec mtime)
  1673 {
  1674   struct stat eln_st;
  1675   int eln_fd = emacs_open (SSDATA (ENCODE_FILE (eln_name)), O_RDONLY, 0);
  1676 
  1677   if (eln_fd > 0)
  1678     {
  1679       if (fstat (eln_fd, &eln_st) || S_ISDIR (eln_st.st_mode))
  1680         emacs_close (eln_fd);
  1681       else
  1682         {
  1683           struct timespec eln_mtime = get_stat_mtime (&eln_st);
  1684           if (timespec_cmp (eln_mtime, mtime) >= 0)
  1685             {
  1686               emacs_close (*fd);
  1687               *fd = eln_fd;
  1688               *filename = eln_name;
  1689               /* Store the eln -> el relation.  */
  1690               Fputhash (Ffile_name_nondirectory (eln_name),
  1691                         src_name, Vcomp_eln_to_el_h);
  1692               return true;
  1693             }
  1694           else
  1695             emacs_close (eln_fd);
  1696         }
  1697     }
  1698 
  1699   return false;
  1700 }
  1701 #endif
  1702 
  1703 /* Look for a suitable .eln file to be loaded in place of FILENAME.
  1704    If found replace the content of FILENAME and FD. */
  1705 
  1706 static void
  1707 maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd,
  1708                     struct timespec mtime)
  1709 {
  1710 #ifdef HAVE_NATIVE_COMP
  1711 
  1712   if (no_native
  1713       || load_no_native)
  1714     Fputhash (*filename, Qt, V_comp_no_native_file_h);
  1715   else
  1716     Fremhash (*filename, V_comp_no_native_file_h);
  1717 
  1718   if (no_native
  1719       || load_no_native
  1720       || !suffix_p (*filename, ".elc"))
  1721     return;
  1722 
  1723   /* Search eln in the eln-cache directories.  */
  1724   Lisp_Object eln_path_tail = Vnative_comp_eln_load_path;
  1725   Lisp_Object src_name =
  1726     Fsubstring (*filename, Qnil, make_fixnum (-1));
  1727   if (NILP (Ffile_exists_p (src_name)))
  1728     {
  1729       src_name = concat2 (src_name, build_string (".gz"));
  1730       if (NILP (Ffile_exists_p (src_name)))
  1731         {
  1732           if (!NILP (find_symbol_value (
  1733                        Qnative_comp_warning_on_missing_source)))
  1734             {
  1735               /* If we have an installation without any .el files,
  1736                  there's really no point in giving a warning here,
  1737                  because that will trigger a cascade of warnings.  So
  1738                  just do a sanity check and refuse to do anything if we
  1739                  can't find even central .el files.  */
  1740               if (NILP (Flocate_file_internal (build_string ("simple.el"),
  1741                                                Vload_path,
  1742                                                Qnil, Qnil)))
  1743                 return;
  1744               Vdelayed_warnings_list
  1745                 = Fcons (list2
  1746                          (Qcomp,
  1747                           CALLN (Fformat,
  1748                                  build_string ("Cannot look up eln "
  1749                                                "file as no source file "
  1750                                                "was found for %s"),
  1751                                  *filename)),
  1752                          Vdelayed_warnings_list);
  1753               return;
  1754             }
  1755         }
  1756     }
  1757   Lisp_Object eln_rel_name = Fcomp_el_to_eln_rel_filename (src_name);
  1758 
  1759   Lisp_Object dir = Qnil;
  1760   FOR_EACH_TAIL_SAFE (eln_path_tail)
  1761     {
  1762       dir = XCAR (eln_path_tail);
  1763       Lisp_Object eln_name =
  1764         Fexpand_file_name (eln_rel_name,
  1765                            Fexpand_file_name (Vcomp_native_version_dir, dir));
  1766       if (maybe_swap_for_eln1 (src_name, eln_name, filename, fd, mtime))
  1767         return;
  1768     }
  1769 
  1770   /* Look also in preloaded subfolder of the last entry in
  1771      `comp-eln-load-path'.  */
  1772   dir = Fexpand_file_name (build_string ("preloaded"),
  1773                            Fexpand_file_name (Vcomp_native_version_dir,
  1774                                               dir));
  1775   maybe_swap_for_eln1 (src_name, Fexpand_file_name (eln_rel_name, dir),
  1776                        filename, fd, mtime);
  1777 #endif
  1778 }
  1779 
  1780 /* Search for a file whose name is STR, looking in directories
  1781    in the Lisp list PATH, and trying suffixes from SUFFIX.
  1782    On success, return a file descriptor (or 1 or -2 as described below).
  1783    On failure, return -1 and set errno.
  1784 
  1785    SUFFIXES is a list of strings containing possible suffixes.
  1786    The empty suffix is automatically added if the list is empty.
  1787 
  1788    PREDICATE t means the files are binary.
  1789    PREDICATE non-nil and non-t means don't open the files,
  1790    just look for one that satisfies the predicate.  In this case,
  1791    return -2 on success.  The predicate can be a lisp function or
  1792    an integer to pass to `access' (in which case file-name-handlers
  1793    are ignored).
  1794 
  1795    If STOREPTR is nonzero, it points to a slot where the name of
  1796    the file actually found should be stored as a Lisp string.
  1797    nil is stored there on failure.
  1798 
  1799    If the file we find is remote, return -2
  1800    but store the found remote file name in *STOREPTR.
  1801 
  1802    If NEWER is true, try all SUFFIXes and return the result for the
  1803    newest file that exists.  Does not apply to remote files,
  1804    or if a non-nil and non-t PREDICATE is specified.
  1805 
  1806    if NO_NATIVE is true do not try to load native code.  */
  1807 
  1808 int
  1809 openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
  1810        Lisp_Object *storeptr, Lisp_Object predicate, bool newer,
  1811        bool no_native)
  1812 {
  1813   ptrdiff_t fn_size = 100;
  1814   char buf[100];
  1815   char *fn = buf;
  1816   bool absolute;
  1817   ptrdiff_t want_length;
  1818   Lisp_Object filename;
  1819   Lisp_Object string, tail, encoded_fn, save_string;
  1820   ptrdiff_t max_suffix_len = 0;
  1821   int last_errno = ENOENT;
  1822   int save_fd = -1;
  1823   USE_SAFE_ALLOCA;
  1824 
  1825   /* The last-modified time of the newest matching file found.
  1826      Initialize it to something less than all valid timestamps.  */
  1827   struct timespec save_mtime = make_timespec (TYPE_MINIMUM (time_t), -1);
  1828 
  1829   CHECK_STRING (str);
  1830 
  1831   tail = suffixes;
  1832   FOR_EACH_TAIL_SAFE (tail)
  1833     {
  1834       CHECK_STRING_CAR (tail);
  1835       max_suffix_len = max (max_suffix_len,
  1836                             SBYTES (XCAR (tail)));
  1837     }
  1838 
  1839   string = filename = encoded_fn = save_string = Qnil;
  1840 
  1841   if (storeptr)
  1842     *storeptr = Qnil;
  1843 
  1844   absolute = complete_filename_p (str);
  1845 
  1846   AUTO_LIST1 (just_use_str, Qnil);
  1847   if (NILP (path))
  1848     path = just_use_str;
  1849 
  1850   /* Go through all entries in the path and see whether we find the
  1851      executable. */
  1852   FOR_EACH_TAIL_SAFE (path)
  1853    {
  1854     ptrdiff_t baselen, prefixlen;
  1855 
  1856     if (EQ (path, just_use_str))
  1857       filename = str;
  1858     else
  1859       filename = Fexpand_file_name (str, XCAR (path));
  1860     if (!complete_filename_p (filename))
  1861       /* If there are non-absolute elts in PATH (eg ".").  */
  1862       /* Of course, this could conceivably lose if luser sets
  1863          default-directory to be something non-absolute...  */
  1864       {
  1865         filename = Fexpand_file_name (filename, BVAR (current_buffer, directory));
  1866         if (!complete_filename_p (filename))
  1867           /* Give up on this path element!  */
  1868           continue;
  1869       }
  1870 
  1871     /* Calculate maximum length of any filename made from
  1872        this path element/specified file name and any possible suffix.  */
  1873     want_length = max_suffix_len + SBYTES (filename);
  1874     if (fn_size <= want_length)
  1875       {
  1876         fn_size = 100 + want_length;
  1877         fn = SAFE_ALLOCA (fn_size);
  1878       }
  1879 
  1880     /* Copy FILENAME's data to FN but remove starting /: if any.  */
  1881     prefixlen = ((SCHARS (filename) > 2
  1882                   && SREF (filename, 0) == '/'
  1883                   && SREF (filename, 1) == ':')
  1884                  ? 2 : 0);
  1885     baselen = SBYTES (filename) - prefixlen;
  1886     memcpy (fn, SDATA (filename) + prefixlen, baselen);
  1887 
  1888     /* Loop over suffixes.  */
  1889     AUTO_LIST1 (empty_string_only, empty_unibyte_string);
  1890     tail = NILP (suffixes) ? empty_string_only : suffixes;
  1891     FOR_EACH_TAIL_SAFE (tail)
  1892       {
  1893         Lisp_Object suffix = XCAR (tail);
  1894         ptrdiff_t fnlen, lsuffix = SBYTES (suffix);
  1895         Lisp_Object handler;
  1896 
  1897         /* Make complete filename by appending SUFFIX.  */
  1898         memcpy (fn + baselen, SDATA (suffix), lsuffix + 1);
  1899         fnlen = baselen + lsuffix;
  1900 
  1901         /* Check that the file exists and is not a directory.  */
  1902         /* We used to only check for handlers on non-absolute file names:
  1903            if (absolute)
  1904            handler = Qnil;
  1905            else
  1906            handler = Ffind_file_name_handler (filename, Qfile_exists_p);
  1907            It's not clear why that was the case and it breaks things like
  1908            (load "/bar.el") where the file is actually "/bar.el.gz".  */
  1909         /* make_string has its own ideas on when to return a unibyte
  1910            string and when a multibyte string, but we know better.
  1911            We must have a unibyte string when dumping, since
  1912            file-name encoding is shaky at best at that time, and in
  1913            particular default-file-name-coding-system is reset
  1914            several times during loadup.  We therefore don't want to
  1915            encode the file before passing it to file I/O library
  1916            functions.  */
  1917         if (!STRING_MULTIBYTE (filename) && !STRING_MULTIBYTE (suffix))
  1918           string = make_unibyte_string (fn, fnlen);
  1919         else
  1920           string = make_string (fn, fnlen);
  1921         handler = Ffind_file_name_handler (string, Qfile_exists_p);
  1922         if ((!NILP (handler) || (!NILP (predicate) && !EQ (predicate, Qt)))
  1923             && !FIXNATP (predicate))
  1924           {
  1925             bool exists;
  1926             if (NILP (predicate) || EQ (predicate, Qt))
  1927               exists = !NILP (Ffile_readable_p (string));
  1928             else
  1929               {
  1930                 Lisp_Object tmp = call1 (predicate, string);
  1931                 if (NILP (tmp))
  1932                   exists = false;
  1933                 else if (EQ (tmp, Qdir_ok)
  1934                          || NILP (Ffile_directory_p (string)))
  1935                   exists = true;
  1936                 else
  1937                   {
  1938                     exists = false;
  1939                     last_errno = EISDIR;
  1940                   }
  1941               }
  1942 
  1943             if (exists)
  1944               {
  1945                 /* We succeeded; return this descriptor and filename.  */
  1946                 if (storeptr)
  1947                   *storeptr = string;
  1948                 SAFE_FREE ();
  1949                 return -2;
  1950               }
  1951           }
  1952         else
  1953           {
  1954             int fd;
  1955             const char *pfn;
  1956             struct stat st;
  1957 
  1958             encoded_fn = ENCODE_FILE (string);
  1959             pfn = SSDATA (encoded_fn);
  1960 
  1961             /* Check that we can access or open it.  */
  1962             if (FIXNATP (predicate))
  1963               {
  1964                 fd = -1;
  1965                 if (INT_MAX < XFIXNAT (predicate))
  1966                   last_errno = EINVAL;
  1967                 else if (faccessat (AT_FDCWD, pfn, XFIXNAT (predicate),
  1968                                     AT_EACCESS)
  1969                          == 0)
  1970                   {
  1971                     if (file_directory_p (encoded_fn))
  1972                       last_errno = EISDIR;
  1973                     else if (errno == ENOENT || errno == ENOTDIR)
  1974                       fd = 1;
  1975                     else
  1976                       last_errno = errno;
  1977                   }
  1978                 else if (! (errno == ENOENT || errno == ENOTDIR))
  1979                   last_errno = errno;
  1980               }
  1981             else
  1982               {
  1983                 /*  In some systems (like Windows) finding out if a
  1984                     file exists is cheaper to do than actually opening
  1985                     it.  Only open the file when we are sure that it
  1986                     exists.  */
  1987 #ifdef WINDOWSNT
  1988                 if (faccessat (AT_FDCWD, pfn, R_OK, AT_EACCESS))
  1989                   fd = -1;
  1990                 else
  1991 #endif
  1992                   fd = emacs_open (pfn, O_RDONLY, 0);
  1993 
  1994                 if (fd < 0)
  1995                   {
  1996                     if (! (errno == ENOENT || errno == ENOTDIR))
  1997                       last_errno = errno;
  1998                   }
  1999                 else
  2000                   {
  2001                     int err = (fstat (fd, &st) != 0 ? errno
  2002                                : S_ISDIR (st.st_mode) ? EISDIR : 0);
  2003                     if (err)
  2004                       {
  2005                         last_errno = err;
  2006                         emacs_close (fd);
  2007                         fd = -1;
  2008                       }
  2009                   }
  2010               }
  2011 
  2012             if (fd >= 0)
  2013               {
  2014                 if (newer && !FIXNATP (predicate))
  2015                   {
  2016                     struct timespec mtime = get_stat_mtime (&st);
  2017 
  2018                     if (timespec_cmp (mtime, save_mtime) <= 0)
  2019                       emacs_close (fd);
  2020                     else
  2021                       {
  2022                         if (0 <= save_fd)
  2023                           emacs_close (save_fd);
  2024                         save_fd = fd;
  2025                         save_mtime = mtime;
  2026                         save_string = string;
  2027                       }
  2028                   }
  2029                 else
  2030                   {
  2031                     maybe_swap_for_eln (no_native, &string, &fd,
  2032                                         get_stat_mtime (&st));
  2033                     /* We succeeded; return this descriptor and filename.  */
  2034                     if (storeptr)
  2035                       *storeptr = string;
  2036                     SAFE_FREE ();
  2037                     return fd;
  2038                   }
  2039               }
  2040 
  2041             /* No more suffixes.  Return the newest.  */
  2042             if (0 <= save_fd && ! CONSP (XCDR (tail)))
  2043               {
  2044                 maybe_swap_for_eln (no_native, &save_string, &save_fd,
  2045                                     save_mtime);
  2046                 if (storeptr)
  2047                   *storeptr = save_string;
  2048                 SAFE_FREE ();
  2049                 return save_fd;
  2050               }
  2051           }
  2052       }
  2053     if (absolute)
  2054       break;
  2055    }
  2056 
  2057   SAFE_FREE ();
  2058   errno = last_errno;
  2059   return -1;
  2060 }
  2061 
  2062 
  2063 /* Merge the list we've accumulated of globals from the current input source
  2064    into the load_history variable.  The details depend on whether
  2065    the source has an associated file name or not.
  2066 
  2067    FILENAME is the file name that we are loading from.
  2068 
  2069    ENTIRE is true if loading that entire file, false if evaluating
  2070    part of it.  */
  2071 
  2072 static void
  2073 build_load_history (Lisp_Object filename, bool entire)
  2074 {
  2075   Lisp_Object tail, prev, newelt;
  2076   Lisp_Object tem, tem2;
  2077   bool foundit = 0;
  2078 
  2079   tail = Vload_history;
  2080   prev = Qnil;
  2081 
  2082   FOR_EACH_TAIL (tail)
  2083     {
  2084       tem = XCAR (tail);
  2085 
  2086       /* Find the feature's previous assoc list...  */
  2087       if (!NILP (Fequal (filename, Fcar (tem))))
  2088         {
  2089           foundit = 1;
  2090 
  2091           /*  If we're loading the entire file, remove old data.  */
  2092           if (entire)
  2093             {
  2094               if (NILP (prev))
  2095                 Vload_history = XCDR (tail);
  2096               else
  2097                 Fsetcdr (prev, XCDR (tail));
  2098             }
  2099 
  2100           /*  Otherwise, cons on new symbols that are not already members.  */
  2101           else
  2102             {
  2103               tem2 = Vcurrent_load_list;
  2104 
  2105               FOR_EACH_TAIL (tem2)
  2106                 {
  2107                   newelt = XCAR (tem2);
  2108 
  2109                   if (NILP (Fmember (newelt, tem)))
  2110                     Fsetcar (tail, Fcons (XCAR (tem),
  2111                                           Fcons (newelt, XCDR (tem))));
  2112                   maybe_quit ();
  2113                 }
  2114             }
  2115         }
  2116       else
  2117         prev = tail;
  2118       maybe_quit ();
  2119     }
  2120 
  2121   /* If we're loading an entire file, cons the new assoc onto the
  2122      front of load-history, the most-recently-loaded position.  Also
  2123      do this if we didn't find an existing member for the file.  */
  2124   if (entire || !foundit)
  2125     Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
  2126                            Vload_history);
  2127 }
  2128 
  2129 static void
  2130 readevalloop_1 (int old)
  2131 {
  2132   load_convert_to_unibyte = old;
  2133 }
  2134 
  2135 /* Signal an `end-of-file' error, if possible with file name
  2136    information.  */
  2137 
  2138 static AVOID
  2139 end_of_file_error (void)
  2140 {
  2141   if (STRINGP (Vload_true_file_name))
  2142     xsignal1 (Qend_of_file, Vload_true_file_name);
  2143 
  2144   xsignal0 (Qend_of_file);
  2145 }
  2146 
  2147 static Lisp_Object
  2148 readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand)
  2149 {
  2150   /* If we macroexpand the toplevel form non-recursively and it ends
  2151      up being a `progn' (or if it was a progn to start), treat each
  2152      form in the progn as a top-level form.  This way, if one form in
  2153      the progn defines a macro, that macro is in effect when we expand
  2154      the remaining forms.  See similar code in bytecomp.el.  */
  2155   val = call2 (macroexpand, val, Qnil);
  2156   if (EQ (CAR_SAFE (val), Qprogn))
  2157     {
  2158       Lisp_Object subforms = XCDR (val);
  2159       val = Qnil;
  2160       FOR_EACH_TAIL (subforms)
  2161         val = readevalloop_eager_expand_eval (XCAR (subforms), macroexpand);
  2162     }
  2163   else
  2164       val = eval_sub (call2 (macroexpand, val, Qt));
  2165   return val;
  2166 }
  2167 
  2168 /* UNIBYTE specifies how to set load_convert_to_unibyte
  2169    for this invocation.
  2170    READFUN, if non-nil, is used instead of `read'.
  2171 
  2172    START, END specify region to read in current buffer (from eval-region).
  2173    If the input is not from a buffer, they must be nil.  */
  2174 
  2175 static void
  2176 readevalloop (Lisp_Object readcharfun,
  2177               struct infile *infile0,
  2178               Lisp_Object sourcename,
  2179               bool printflag,
  2180               Lisp_Object unibyte, Lisp_Object readfun,
  2181               Lisp_Object start, Lisp_Object end)
  2182 {
  2183   int c;
  2184   Lisp_Object val;
  2185   specpdl_ref count = SPECPDL_INDEX ();
  2186   struct buffer *b = 0;
  2187   bool continue_reading_p;
  2188   Lisp_Object lex_bound;
  2189   /* True if reading an entire buffer.  */
  2190   bool whole_buffer = 0;
  2191   /* True on the first time around.  */
  2192   bool first_sexp = 1;
  2193   Lisp_Object macroexpand = intern ("internal-macroexpand-for-load");
  2194 
  2195   if (!NILP (sourcename))
  2196     CHECK_STRING (sourcename);
  2197 
  2198   if (NILP (Ffboundp (macroexpand))
  2199       || (STRINGP (sourcename) && suffix_p (sourcename, ".elc")))
  2200     /* Don't macroexpand before the corresponding function is defined
  2201        and don't bother macroexpanding in .elc files, since it should have
  2202        been done already.  */
  2203     macroexpand = Qnil;
  2204 
  2205   if (MARKERP (readcharfun))
  2206     {
  2207       if (NILP (start))
  2208         start = readcharfun;
  2209     }
  2210 
  2211   if (BUFFERP (readcharfun))
  2212     b = XBUFFER (readcharfun);
  2213   else if (MARKERP (readcharfun))
  2214     b = XMARKER (readcharfun)->buffer;
  2215 
  2216   /* We assume START is nil when input is not from a buffer.  */
  2217   if (! NILP (start) && !b)
  2218     emacs_abort ();
  2219 
  2220   specbind (Qstandard_input, readcharfun);
  2221   record_unwind_protect_int (readevalloop_1, load_convert_to_unibyte);
  2222   load_convert_to_unibyte = !NILP (unibyte);
  2223 
  2224   /* If lexical binding is active (either because it was specified in
  2225      the file's header, or via a buffer-local variable), create an empty
  2226      lexical environment, otherwise, turn off lexical binding.  */
  2227   lex_bound = find_symbol_value (Qlexical_binding);
  2228   specbind (Qinternal_interpreter_environment,
  2229             (NILP (lex_bound) || BASE_EQ (lex_bound, Qunbound)
  2230              ? Qnil : list1 (Qt)));
  2231   specbind (Qmacroexp__dynvars, Vmacroexp__dynvars);
  2232 
  2233   /* Ensure sourcename is absolute, except whilst preloading.  */
  2234   if (!will_dump_p ()
  2235       && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename)))
  2236     sourcename = Fexpand_file_name (sourcename, Qnil);
  2237 
  2238   loadhist_initialize (sourcename);
  2239 
  2240   continue_reading_p = 1;
  2241   while (continue_reading_p)
  2242     {
  2243       specpdl_ref count1 = SPECPDL_INDEX ();
  2244 
  2245       if (b != 0 && !BUFFER_LIVE_P (b))
  2246         error ("Reading from killed buffer");
  2247 
  2248       if (!NILP (start))
  2249         {
  2250           /* Switch to the buffer we are reading from.  */
  2251           record_unwind_protect_excursion ();
  2252           set_buffer_internal (b);
  2253 
  2254           /* Save point in it.  */
  2255           record_unwind_protect_excursion ();
  2256           /* Save ZV in it.  */
  2257           record_unwind_protect (save_restriction_restore, save_restriction_save ());
  2258           labeled_restrictions_remove_in_current_buffer ();
  2259           /* Those get unbound after we read one expression.  */
  2260 
  2261           /* Set point and ZV around stuff to be read.  */
  2262           Fgoto_char (start);
  2263           if (!NILP (end))
  2264             Fnarrow_to_region (make_fixnum (BEGV), end);
  2265 
  2266           /* Just for cleanliness, convert END to a marker
  2267              if it is an integer.  */
  2268           if (FIXNUMP (end))
  2269             end = Fpoint_max_marker ();
  2270         }
  2271 
  2272       /* On the first cycle, we can easily test here
  2273          whether we are reading the whole buffer.  */
  2274       if (b && first_sexp)
  2275         whole_buffer = (BUF_PT (b) == BUF_BEG (b) && BUF_ZV (b) == BUF_Z (b));
  2276 
  2277       eassert (!infile0 || infile == infile0);
  2278     read_next:
  2279       c = READCHAR;
  2280       if (c == ';')
  2281         {
  2282           while ((c = READCHAR) != '\n' && c != -1);
  2283           goto read_next;
  2284         }
  2285       if (c < 0)
  2286         {
  2287           unbind_to (count1, Qnil);
  2288           break;
  2289         }
  2290 
  2291       /* Ignore whitespace here, so we can detect eof.  */
  2292       if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r'
  2293           || c == NO_BREAK_SPACE)
  2294         goto read_next;
  2295       UNREAD (c);
  2296 
  2297       if (! HASH_TABLE_P (read_objects_map)
  2298           || XHASH_TABLE (read_objects_map)->count)
  2299         read_objects_map
  2300           = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE,
  2301                              DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
  2302                              Qnil, false);
  2303       if (! HASH_TABLE_P (read_objects_completed)
  2304           || XHASH_TABLE (read_objects_completed)->count)
  2305         read_objects_completed
  2306           = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE,
  2307                              DEFAULT_REHASH_SIZE, DEFAULT_REHASH_THRESHOLD,
  2308                              Qnil, false);
  2309       if (!NILP (Vpurify_flag) && c == '(')
  2310         val = read0 (readcharfun, false);
  2311       else
  2312         {
  2313           if (!NILP (readfun))
  2314             {
  2315               val = call1 (readfun, readcharfun);
  2316 
  2317               /* If READCHARFUN has set point to ZV, we should
  2318                  stop reading, even if the form read sets point
  2319                  to a different value when evaluated.  */
  2320               if (BUFFERP (readcharfun))
  2321                 {
  2322                   struct buffer *buf = XBUFFER (readcharfun);
  2323                   if (BUF_PT (buf) == BUF_ZV (buf))
  2324                     continue_reading_p = 0;
  2325                 }
  2326             }
  2327           else if (! NILP (Vload_read_function))
  2328             val = call1 (Vload_read_function, readcharfun);
  2329           else
  2330             val = read_internal_start (readcharfun, Qnil, Qnil, false);
  2331         }
  2332       /* Empty hashes can be reused; otherwise, reset on next call.  */
  2333       if (HASH_TABLE_P (read_objects_map)
  2334           && XHASH_TABLE (read_objects_map)->count > 0)
  2335         read_objects_map = Qnil;
  2336       if (HASH_TABLE_P (read_objects_completed)
  2337           && XHASH_TABLE (read_objects_completed)->count > 0)
  2338         read_objects_completed = Qnil;
  2339 
  2340       if (!NILP (start) && continue_reading_p)
  2341         start = Fpoint_marker ();
  2342 
  2343       /* Restore saved point and BEGV.  */
  2344       unbind_to (count1, Qnil);
  2345 
  2346       /* Now eval what we just read.  */
  2347       if (!NILP (macroexpand))
  2348         val = readevalloop_eager_expand_eval (val, macroexpand);
  2349       else
  2350         val = eval_sub (val);
  2351 
  2352       if (printflag)
  2353         {
  2354           Vvalues = Fcons (val, Vvalues);
  2355           if (EQ (Vstandard_output, Qt))
  2356             Fprin1 (val, Qnil, Qnil);
  2357           else
  2358             Fprint (val, Qnil);
  2359         }
  2360 
  2361       first_sexp = 0;
  2362     }
  2363 
  2364   build_load_history (sourcename,
  2365                       infile0 || whole_buffer);
  2366 
  2367   unbind_to (count, Qnil);
  2368 }
  2369 
  2370 DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
  2371        doc: /* Execute the accessible portion of current buffer as Lisp code.
  2372 You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
  2373 When called from a Lisp program (i.e., not interactively), this
  2374 function accepts up to five optional arguments:
  2375 BUFFER is the buffer to evaluate (nil means use current buffer),
  2376  or a name of a buffer (a string).
  2377 PRINTFLAG controls printing of output by any output functions in the
  2378  evaluated code, such as `print', `princ', and `prin1':
  2379   a value of nil means discard it; anything else is the stream to print to.
  2380   See Info node `(elisp)Output Streams' for details on streams.
  2381 FILENAME specifies the file name to use for `load-history'.
  2382 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
  2383  invocation.
  2384 DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
  2385  evaluated code should work normally even if PRINTFLAG is nil, in
  2386  which case the output is displayed in the echo area.
  2387 
  2388 This function ignores the current value of the `lexical-binding'
  2389 variable.  Instead it will heed any
  2390   -*- lexical-binding: t -*-
  2391 settings in the buffer, and if there is no such setting, the buffer
  2392 will be evaluated without lexical binding.
  2393 
  2394 This function preserves the position of point.  */)
  2395   (Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print)
  2396 {
  2397   specpdl_ref count = SPECPDL_INDEX ();
  2398   Lisp_Object tem, buf;
  2399 
  2400   if (NILP (buffer))
  2401     buf = Fcurrent_buffer ();
  2402   else
  2403     buf = Fget_buffer (buffer);
  2404   if (NILP (buf))
  2405     error ("No such buffer");
  2406 
  2407   if (NILP (printflag) && NILP (do_allow_print))
  2408     tem = Qsymbolp;
  2409   else
  2410     tem = printflag;
  2411 
  2412   if (NILP (filename))
  2413     filename = BVAR (XBUFFER (buf), filename);
  2414 
  2415   specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
  2416   specbind (Qstandard_output, tem);
  2417   record_unwind_protect_excursion ();
  2418   BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
  2419   specbind (Qlexical_binding, lisp_file_lexically_bound_p (buf) ? Qt : Qnil);
  2420   BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
  2421   readevalloop (buf, 0, filename,
  2422                 !NILP (printflag), unibyte, Qnil, Qnil, Qnil);
  2423   return unbind_to (count, Qnil);
  2424 }
  2425 
  2426 DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r",
  2427        doc: /* Execute the region as Lisp code.
  2428 When called from programs, expects two arguments,
  2429 giving starting and ending indices in the current buffer
  2430 of the text to be executed.
  2431 Programs can pass third argument PRINTFLAG which controls output:
  2432  a value of nil means discard it; anything else is stream for printing it.
  2433  See Info node `(elisp)Output Streams' for details on streams.
  2434 Also the fourth argument READ-FUNCTION, if non-nil, is used
  2435 instead of `read' to read each expression.  It gets one argument
  2436 which is the input stream for reading characters.
  2437 
  2438 This function does not move point.  */)
  2439   (Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function)
  2440 {
  2441   /* FIXME: Do the eval-sexp-add-defvars dance!  */
  2442   specpdl_ref count = SPECPDL_INDEX ();
  2443   Lisp_Object tem, cbuf;
  2444 
  2445   cbuf = Fcurrent_buffer ();
  2446 
  2447   if (NILP (printflag))
  2448     tem = Qsymbolp;
  2449   else
  2450     tem = printflag;
  2451   specbind (Qstandard_output, tem);
  2452   specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
  2453 
  2454   /* `readevalloop' calls functions which check the type of start and end.  */
  2455   readevalloop (cbuf, 0, BVAR (XBUFFER (cbuf), filename),
  2456                 !NILP (printflag), Qnil, read_function,
  2457                 start, end);
  2458 
  2459   return unbind_to (count, Qnil);
  2460 }
  2461 
  2462 
  2463 DEFUN ("read", Fread, Sread, 0, 1, 0,
  2464        doc: /* Read one Lisp expression as text from STREAM, return as Lisp object.
  2465 If STREAM is nil, use the value of `standard-input' (which see).
  2466 STREAM or the value of `standard-input' may be:
  2467  a buffer (read from point and advance it)
  2468  a marker (read from where it points and advance it)
  2469  a function (call it with no arguments for each character,
  2470      call it with a char as argument to push a char back)
  2471  a string (takes text from string, starting at the beginning)
  2472  t (read text line using minibuffer and use it, or read from
  2473     standard input in batch mode).  */)
  2474   (Lisp_Object stream)
  2475 {
  2476   if (NILP (stream))
  2477     stream = Vstandard_input;
  2478   if (EQ (stream, Qt))
  2479     stream = Qread_char;
  2480   if (EQ (stream, Qread_char))
  2481     /* FIXME: ?! This is used when the reader is called from the
  2482        minibuffer without a stream, as in (read).  But is this feature
  2483        ever used, and if so, why?  IOW, will anything break if this
  2484        feature is removed !?  */
  2485     return call1 (intern ("read-minibuffer"),
  2486                   build_string ("Lisp expression: "));
  2487 
  2488   return read_internal_start (stream, Qnil, Qnil, false);
  2489 }
  2490 
  2491 DEFUN ("read-positioning-symbols", Fread_positioning_symbols,
  2492        Sread_positioning_symbols, 0, 1, 0,
  2493        doc: /* Read one Lisp expression as text from STREAM, return as Lisp object.
  2494 Convert each occurrence of a symbol into a "symbol with pos" object.
  2495 
  2496 If STREAM is nil, use the value of `standard-input' (which see).
  2497 STREAM or the value of `standard-input' may be:
  2498  a buffer (read from point and advance it)
  2499  a marker (read from where it points and advance it)
  2500  a function (call it with no arguments for each character,
  2501      call it with a char as argument to push a char back)
  2502  a string (takes text from string, starting at the beginning)
  2503  t (read text line using minibuffer and use it, or read from
  2504     standard input in batch mode).  */)
  2505   (Lisp_Object stream)
  2506 {
  2507   if (NILP (stream))
  2508     stream = Vstandard_input;
  2509   if (EQ (stream, Qt))
  2510     stream = Qread_char;
  2511   if (EQ (stream, Qread_char))
  2512     /* FIXME: ?! When is this used !?  */
  2513     return call1 (intern ("read-minibuffer"),
  2514                   build_string ("Lisp expression: "));
  2515 
  2516   return read_internal_start (stream, Qnil, Qnil, true);
  2517 }
  2518 
  2519 DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
  2520        doc: /* Read one Lisp expression which is represented as text by STRING.
  2521 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
  2522 FINAL-STRING-INDEX is an integer giving the position of the next
  2523 remaining character in STRING.  START and END optionally delimit
  2524 a substring of STRING from which to read;  they default to 0 and
  2525 \(length STRING) respectively.  Negative values are counted from
  2526 the end of STRING.  */)
  2527   (Lisp_Object string, Lisp_Object start, Lisp_Object end)
  2528 {
  2529   Lisp_Object ret;
  2530   CHECK_STRING (string);
  2531   /* `read_internal_start' sets `read_from_string_index'.  */
  2532   ret = read_internal_start (string, start, end, false);
  2533   return Fcons (ret, make_fixnum (read_from_string_index));
  2534 }
  2535 
  2536 /* Function to set up the global context we need in toplevel read
  2537    calls.  START and END only used when STREAM is a string.
  2538    LOCATE_SYMS true means read symbol occurrences as symbols with
  2539    position.  */
  2540 static Lisp_Object
  2541 read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end,
  2542                      bool locate_syms)
  2543 {
  2544   Lisp_Object retval;
  2545 
  2546   readchar_offset = BUFFERP (stream) ? XBUFFER (stream)->pt : 0;
  2547   /* We can get called from readevalloop which may have set these
  2548      already.  */
  2549   if (! HASH_TABLE_P (read_objects_map)
  2550       || XHASH_TABLE (read_objects_map)->count)
  2551     read_objects_map
  2552       = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
  2553                          DEFAULT_REHASH_THRESHOLD, Qnil, false);
  2554   if (! HASH_TABLE_P (read_objects_completed)
  2555       || XHASH_TABLE (read_objects_completed)->count)
  2556     read_objects_completed
  2557       = make_hash_table (hashtest_eq, DEFAULT_HASH_SIZE, DEFAULT_REHASH_SIZE,
  2558                          DEFAULT_REHASH_THRESHOLD, Qnil, false);
  2559 
  2560   if (STRINGP (stream)
  2561       || ((CONSP (stream) && STRINGP (XCAR (stream)))))
  2562     {
  2563       ptrdiff_t startval, endval;
  2564       Lisp_Object string;
  2565 
  2566       if (STRINGP (stream))
  2567         string = stream;
  2568       else
  2569         string = XCAR (stream);
  2570 
  2571       validate_subarray (string, start, end, SCHARS (string),
  2572                          &startval, &endval);
  2573 
  2574       read_from_string_index = startval;
  2575       read_from_string_index_byte = string_char_to_byte (string, startval);
  2576       read_from_string_limit = endval;
  2577     }
  2578 
  2579   retval = read0 (stream, locate_syms);
  2580   if (HASH_TABLE_P (read_objects_map)
  2581       && XHASH_TABLE (read_objects_map)->count > 0)
  2582     read_objects_map = Qnil;
  2583   if (HASH_TABLE_P (read_objects_completed)
  2584       && XHASH_TABLE (read_objects_completed)->count > 0)
  2585     read_objects_completed = Qnil;
  2586   return retval;
  2587 }
  2588 
  2589 /* Grow a read buffer BUF that contains OFFSET useful bytes of data,
  2590    by at least MAX_MULTIBYTE_LENGTH bytes.  Update *BUF_ADDR and
  2591    *BUF_SIZE accordingly; 0 <= OFFSET <= *BUF_SIZE.  If *BUF_ADDR is
  2592    initially null, BUF is on the stack: copy its data to the new heap
  2593    buffer.  Otherwise, BUF must equal *BUF_ADDR and can simply be
  2594    reallocated.  Either way, remember the heap allocation (which is at
  2595    pdl slot COUNT) so that it can be freed when unwinding the stack.*/
  2596 
  2597 static char *
  2598 grow_read_buffer (char *buf, ptrdiff_t offset,
  2599                   char **buf_addr, ptrdiff_t *buf_size, specpdl_ref count)
  2600 {
  2601   char *p = xpalloc (*buf_addr, buf_size, MAX_MULTIBYTE_LENGTH, -1, 1);
  2602   if (!*buf_addr)
  2603     {
  2604       memcpy (p, buf, offset);
  2605       record_unwind_protect_ptr (xfree, p);
  2606     }
  2607   else
  2608     set_unwind_protect_ptr (count, xfree, p);
  2609   *buf_addr = p;
  2610   return p;
  2611 }
  2612 
  2613 /* Return the scalar value that has the Unicode character name NAME.
  2614    Raise 'invalid-read-syntax' if there is no such character.  */
  2615 static int
  2616 character_name_to_code (char const *name, ptrdiff_t name_len,
  2617                         Lisp_Object readcharfun)
  2618 {
  2619   /* For "U+XXXX", pass the leading '+' to string_to_number to reject
  2620      monstrosities like "U+-0000".  */
  2621   ptrdiff_t len = name_len - 1;
  2622   Lisp_Object code
  2623     = (name[0] == 'U' && name[1] == '+'
  2624        ? string_to_number (name + 1, 16, &len)
  2625        : call2 (Qchar_from_name, make_unibyte_string (name, name_len), Qt));
  2626 
  2627   if (! RANGED_FIXNUMP (0, code, MAX_UNICODE_CHAR)
  2628       || len != name_len - 1
  2629       || char_surrogate_p (XFIXNUM (code)))
  2630     {
  2631       AUTO_STRING (format, "\\N{%s}");
  2632       AUTO_STRING_WITH_LEN (namestr, name, name_len);
  2633       invalid_syntax_lisp (CALLN (Fformat, format, namestr), readcharfun);
  2634     }
  2635 
  2636   return XFIXNUM (code);
  2637 }
  2638 
  2639 /* Bound on the length of a Unicode character name.  As of
  2640    Unicode 9.0.0 the maximum is 83, so this should be safe.  */
  2641 enum { UNICODE_CHARACTER_NAME_LENGTH_BOUND = 200 };
  2642 
  2643 /* Read a \-escape sequence, assuming we already read the `\'.
  2644    If the escape sequence forces unibyte, return eight-bit char.  */
  2645 
  2646 static int
  2647 read_escape (Lisp_Object readcharfun)
  2648 {
  2649   int c = READCHAR;
  2650   /* \u allows up to four hex digits, \U up to eight.  Default to the
  2651      behavior for \u, and change this value in the case that \U is seen.  */
  2652   int unicode_hex_count = 4;
  2653 
  2654   switch (c)
  2655     {
  2656     case -1:
  2657       end_of_file_error ();
  2658 
  2659     case 'a':
  2660       return '\007';
  2661     case 'b':
  2662       return '\b';
  2663     case 'd':
  2664       return 0177;
  2665     case 'e':
  2666       return 033;
  2667     case 'f':
  2668       return '\f';
  2669     case 'n':
  2670       return '\n';
  2671     case 'r':
  2672       return '\r';
  2673     case 't':
  2674       return '\t';
  2675     case 'v':
  2676       return '\v';
  2677 
  2678     case '\n':
  2679       /* ?\LF is an error; it's probably a user mistake.  */
  2680       error ("Invalid escape character syntax");
  2681 
  2682     case 'M':
  2683       c = READCHAR;
  2684       if (c != '-')
  2685         error ("Invalid escape character syntax");
  2686       c = READCHAR;
  2687       if (c == '\\')
  2688         c = read_escape (readcharfun);
  2689       return c | meta_modifier;
  2690 
  2691     case 'S':
  2692       c = READCHAR;
  2693       if (c != '-')
  2694         error ("Invalid escape character syntax");
  2695       c = READCHAR;
  2696       if (c == '\\')
  2697         c = read_escape (readcharfun);
  2698       return c | shift_modifier;
  2699 
  2700     case 'H':
  2701       c = READCHAR;
  2702       if (c != '-')
  2703         error ("Invalid escape character syntax");
  2704       c = READCHAR;
  2705       if (c == '\\')
  2706         c = read_escape (readcharfun);
  2707       return c | hyper_modifier;
  2708 
  2709     case 'A':
  2710       c = READCHAR;
  2711       if (c != '-')
  2712         error ("Invalid escape character syntax");
  2713       c = READCHAR;
  2714       if (c == '\\')
  2715         c = read_escape (readcharfun);
  2716       return c | alt_modifier;
  2717 
  2718     case 's':
  2719       c = READCHAR;
  2720       if (c != '-')
  2721         {
  2722           UNREAD (c);
  2723           return ' ';
  2724         }
  2725       c = READCHAR;
  2726       if (c == '\\')
  2727         c = read_escape (readcharfun);
  2728       return c | super_modifier;
  2729 
  2730     case 'C':
  2731       c = READCHAR;
  2732       if (c != '-')
  2733         error ("Invalid escape character syntax");
  2734       FALLTHROUGH;
  2735     case '^':
  2736       c = READCHAR;
  2737       if (c == '\\')
  2738         c = read_escape (readcharfun);
  2739       if ((c & ~CHAR_MODIFIER_MASK) == '?')
  2740         return 0177 | (c & CHAR_MODIFIER_MASK);
  2741       else if (! ASCII_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
  2742         return c | ctrl_modifier;
  2743       /* ASCII control chars are made from letters (both cases),
  2744          as well as the non-letters within 0100...0137.  */
  2745       else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
  2746         return (c & (037 | ~0177));
  2747       else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
  2748         return (c & (037 | ~0177));
  2749       else
  2750         return c | ctrl_modifier;
  2751 
  2752     case '0':
  2753     case '1':
  2754     case '2':
  2755     case '3':
  2756     case '4':
  2757     case '5':
  2758     case '6':
  2759     case '7':
  2760       /* An octal escape, as in ANSI C.  */
  2761       {
  2762         register int i = c - '0';
  2763         register int count = 0;
  2764         while (++count < 3)
  2765           {
  2766             if ((c = READCHAR) >= '0' && c <= '7')
  2767               {
  2768                 i *= 8;
  2769                 i += c - '0';
  2770               }
  2771             else
  2772               {
  2773                 UNREAD (c);
  2774                 break;
  2775               }
  2776           }
  2777 
  2778         if (i >= 0x80 && i < 0x100)
  2779           i = BYTE8_TO_CHAR (i);
  2780         return i;
  2781       }
  2782 
  2783     case 'x':
  2784       /* A hex escape, as in ANSI C.  */
  2785       {
  2786         unsigned int i = 0;
  2787         int count = 0;
  2788         while (1)
  2789           {
  2790             c = READCHAR;
  2791             int digit = char_hexdigit (c);
  2792             if (digit < 0)
  2793               {
  2794                 UNREAD (c);
  2795                 break;
  2796               }
  2797             i = (i << 4) + digit;
  2798             /* Allow hex escapes as large as ?\xfffffff, because some
  2799                packages use them to denote characters with modifiers.  */
  2800             if ((CHAR_META | (CHAR_META - 1)) < i)
  2801               error ("Hex character out of range: \\x%x...", i);
  2802             count += count < 3;
  2803           }
  2804 
  2805         if (count < 3 && i >= 0x80)
  2806           return BYTE8_TO_CHAR (i);
  2807         return i;
  2808       }
  2809 
  2810     case 'U':
  2811       /* Post-Unicode-2.0: Up to eight hex chars.  */
  2812       unicode_hex_count = 8;
  2813       FALLTHROUGH;
  2814     case 'u':
  2815 
  2816       /* A Unicode escape.  We only permit them in strings and characters,
  2817          not arbitrarily in the source code, as in some other languages.  */
  2818       {
  2819         unsigned int i = 0;
  2820         int count = 0;
  2821 
  2822         while (++count <= unicode_hex_count)
  2823           {
  2824             c = READCHAR;
  2825             if (c < 0)
  2826               {
  2827                 if (unicode_hex_count > 4)
  2828                   error ("Malformed Unicode escape: \\U%x", i);
  2829                 else
  2830                   error ("Malformed Unicode escape: \\u%x", i);
  2831               }
  2832             /* `isdigit' and `isalpha' may be locale-specific, which we don't
  2833                want.  */
  2834             int digit = char_hexdigit (c);
  2835             if (digit < 0)
  2836               error ("Non-hex character used for Unicode escape: %c (%d)",
  2837                      c, c);
  2838             i = (i << 4) + digit;
  2839           }
  2840         if (i > 0x10FFFF)
  2841           error ("Non-Unicode character: 0x%x", i);
  2842         return i;
  2843       }
  2844 
  2845     case 'N':
  2846       /* Named character.  */
  2847       {
  2848         c = READCHAR;
  2849         if (c != '{')
  2850           invalid_syntax ("Expected opening brace after \\N", readcharfun);
  2851         char name[UNICODE_CHARACTER_NAME_LENGTH_BOUND + 1];
  2852         bool whitespace = false;
  2853         ptrdiff_t length = 0;
  2854         while (true)
  2855           {
  2856             c = READCHAR;
  2857             if (c < 0)
  2858               end_of_file_error ();
  2859             if (c == '}')
  2860               break;
  2861             if (! (0 < c && c < 0x80))
  2862               {
  2863                 AUTO_STRING (format,
  2864                              "Invalid character U+%04X in character name");
  2865                 invalid_syntax_lisp (CALLN (Fformat, format,
  2866                                             make_fixed_natnum (c)),
  2867                                      readcharfun);
  2868               }
  2869             /* Treat multiple adjacent whitespace characters as a
  2870                single space character.  This makes it easier to use
  2871                character names in e.g. multi-line strings.  */
  2872             if (c_isspace (c))
  2873               {
  2874                 if (whitespace)
  2875                   continue;
  2876                 c = ' ';
  2877                 whitespace = true;
  2878               }
  2879             else
  2880               whitespace = false;
  2881             name[length++] = c;
  2882             if (length >= sizeof name)
  2883               invalid_syntax ("Character name too long", readcharfun);
  2884           }
  2885         if (length == 0)
  2886           invalid_syntax ("Empty character name", readcharfun);
  2887         name[length] = '\0';
  2888 
  2889         /* character_name_to_code can invoke read0, recursively.
  2890            This is why read0's buffer is not static.  */
  2891         return character_name_to_code (name, length, readcharfun);
  2892       }
  2893 
  2894     default:
  2895       return c;
  2896     }
  2897 }
  2898 
  2899 /* Return the digit that CHARACTER stands for in the given BASE.
  2900    Return -1 if CHARACTER is out of range for BASE,
  2901    and -2 if CHARACTER is not valid for any supported BASE.  */
  2902 static int
  2903 digit_to_number (int character, int base)
  2904 {
  2905   int digit;
  2906 
  2907   if ('0' <= character && character <= '9')
  2908     digit = character - '0';
  2909   else if ('a' <= character && character <= 'z')
  2910     digit = character - 'a' + 10;
  2911   else if ('A' <= character && character <= 'Z')
  2912     digit = character - 'A' + 10;
  2913   else
  2914     return -2;
  2915 
  2916   return digit < base ? digit : -1;
  2917 }
  2918 
  2919 static void
  2920 invalid_radix_integer (EMACS_INT radix, Lisp_Object readcharfun)
  2921 {
  2922   char buf[64];
  2923   int n = snprintf (buf, sizeof buf, "integer, radix %"pI"d", radix);
  2924   eassert (n < sizeof buf);
  2925   invalid_syntax (buf, readcharfun);
  2926 }
  2927 
  2928 /* Read an integer in radix RADIX using READCHARFUN to read
  2929    characters.  RADIX must be in the interval [2..36].
  2930    Value is the integer read.
  2931    Signal an error if encountering invalid read syntax.  */
  2932 
  2933 static Lisp_Object
  2934 read_integer (Lisp_Object readcharfun, int radix)
  2935 {
  2936   char stackbuf[20];
  2937   char *read_buffer = stackbuf;
  2938   ptrdiff_t read_buffer_size = sizeof stackbuf;
  2939   char *p = read_buffer;
  2940   char *heapbuf = NULL;
  2941   int valid = -1; /* 1 if valid, 0 if not, -1 if incomplete.  */
  2942   specpdl_ref count = SPECPDL_INDEX ();
  2943 
  2944   int c = READCHAR;
  2945   if (c == '-' || c == '+')
  2946     {
  2947       *p++ = c;
  2948       c = READCHAR;
  2949     }
  2950 
  2951   if (c == '0')
  2952     {
  2953       *p++ = c;
  2954       valid = 1;
  2955 
  2956       /* Ignore redundant leading zeros, so the buffer doesn't
  2957          fill up with them.  */
  2958       do
  2959         c = READCHAR;
  2960       while (c == '0');
  2961     }
  2962 
  2963   for (int digit; (digit = digit_to_number (c, radix)) >= -1; )
  2964     {
  2965       if (digit == -1)
  2966         valid = 0;
  2967       if (valid < 0)
  2968         valid = 1;
  2969       /* Allow 1 extra byte for the \0.  */
  2970       if (p + 1 == read_buffer + read_buffer_size)
  2971         {
  2972           ptrdiff_t offset = p - read_buffer;
  2973           read_buffer = grow_read_buffer (read_buffer, offset,
  2974                                           &heapbuf, &read_buffer_size,
  2975                                           count);
  2976           p = read_buffer + offset;
  2977         }
  2978       *p++ = c;
  2979       c = READCHAR;
  2980     }
  2981 
  2982   UNREAD (c);
  2983 
  2984   if (valid != 1)
  2985     invalid_radix_integer (radix, readcharfun);
  2986 
  2987   *p = '\0';
  2988   return unbind_to (count, string_to_number (read_buffer, radix, NULL));
  2989 }
  2990 
  2991 
  2992 /* Read a character literal (preceded by `?').  */
  2993 static Lisp_Object
  2994 read_char_literal (Lisp_Object readcharfun)
  2995 {
  2996   int ch = READCHAR;
  2997   if (ch < 0)
  2998     end_of_file_error ();
  2999 
  3000   /* Accept `single space' syntax like (list ? x) where the
  3001      whitespace character is SPC or TAB.
  3002      Other literal whitespace like NL, CR, and FF are not accepted,
  3003      as there are well-established escape sequences for these.  */
  3004   if (ch == ' ' || ch == '\t')
  3005     return make_fixnum (ch);
  3006 
  3007   if (   ch == '(' || ch == ')' || ch == '[' || ch == ']'
  3008       || ch == '"' || ch == ';')
  3009     {
  3010       CHECK_LIST (Vlread_unescaped_character_literals);
  3011       Lisp_Object char_obj = make_fixed_natnum (ch);
  3012       if (NILP (Fmemq (char_obj, Vlread_unescaped_character_literals)))
  3013         Vlread_unescaped_character_literals =
  3014           Fcons (char_obj, Vlread_unescaped_character_literals);
  3015     }
  3016 
  3017   if (ch == '\\')
  3018     ch = read_escape (readcharfun);
  3019 
  3020   int modifiers = ch & CHAR_MODIFIER_MASK;
  3021   ch &= ~CHAR_MODIFIER_MASK;
  3022   if (CHAR_BYTE8_P (ch))
  3023     ch = CHAR_TO_BYTE8 (ch);
  3024   ch |= modifiers;
  3025 
  3026   int nch = READCHAR;
  3027   UNREAD (nch);
  3028   if (nch <= 32
  3029       || nch == '"' || nch == '\'' || nch == ';' || nch == '('
  3030       || nch == ')' || nch == '['  || nch == ']' || nch == '#'
  3031       || nch == '?' || nch == '`'  || nch == ',' || nch == '.')
  3032     return make_fixnum (ch);
  3033 
  3034   invalid_syntax ("?", readcharfun);
  3035 }
  3036 
  3037 /* Read a string literal (preceded by '"').  */
  3038 static Lisp_Object
  3039 read_string_literal (Lisp_Object readcharfun)
  3040 {
  3041   char stackbuf[1024];
  3042   char *read_buffer = stackbuf;
  3043   ptrdiff_t read_buffer_size = sizeof stackbuf;
  3044   specpdl_ref count = SPECPDL_INDEX ();
  3045   char *heapbuf = NULL;
  3046   char *p = read_buffer;
  3047   char *end = read_buffer + read_buffer_size;
  3048   /* True if we saw an escape sequence specifying
  3049      a multibyte character.  */
  3050   bool force_multibyte = false;
  3051   /* True if we saw an escape sequence specifying
  3052      a single-byte character.  */
  3053   bool force_singlebyte = false;
  3054   ptrdiff_t nchars = 0;
  3055 
  3056   int ch;
  3057   while ((ch = READCHAR) >= 0 && ch != '\"')
  3058     {
  3059       if (end - p < MAX_MULTIBYTE_LENGTH)
  3060         {
  3061           ptrdiff_t offset = p - read_buffer;
  3062           read_buffer = grow_read_buffer (read_buffer, offset,
  3063                                           &heapbuf, &read_buffer_size,
  3064                                           count);
  3065           p = read_buffer + offset;
  3066           end = read_buffer + read_buffer_size;
  3067         }
  3068 
  3069       if (ch == '\\')
  3070         {
  3071           /* First apply string-specific escape rules:  */
  3072           ch = READCHAR;
  3073           switch (ch)
  3074             {
  3075             case 's':
  3076               /* `\s' is always a space in strings.  */
  3077               ch = ' ';
  3078               break;
  3079             case ' ':
  3080             case '\n':
  3081               /* `\SPC' and `\LF' generate no characters at all.  */
  3082               continue;
  3083             default:
  3084               UNREAD (ch);
  3085               ch = read_escape (readcharfun);
  3086               break;
  3087             }
  3088 
  3089           int modifiers = ch & CHAR_MODIFIER_MASK;
  3090           ch &= ~CHAR_MODIFIER_MASK;
  3091 
  3092           if (CHAR_BYTE8_P (ch))
  3093             force_singlebyte = true;
  3094           else if (! ASCII_CHAR_P (ch))
  3095             force_multibyte = true;
  3096           else          /* I.e. ASCII_CHAR_P (ch).  */
  3097             {
  3098               /* Allow `\C-SPC' and `\^SPC'.  This is done here because
  3099                  the literals ?\C-SPC and ?\^SPC (rather inconsistently)
  3100                  yield (' ' | CHAR_CTL); see bug#55738.  */
  3101               if (modifiers == CHAR_CTL && ch == ' ')
  3102                 {
  3103                   ch = 0;
  3104                   modifiers = 0;
  3105                 }
  3106               if (modifiers & CHAR_SHIFT)
  3107                 {
  3108                   /* Shift modifier is valid only with [A-Za-z].  */
  3109                   if (ch >= 'A' && ch <= 'Z')
  3110                     modifiers &= ~CHAR_SHIFT;
  3111                   else if (ch >= 'a' && ch <= 'z')
  3112                     {
  3113                       ch -= ('a' - 'A');
  3114                       modifiers &= ~CHAR_SHIFT;
  3115                     }
  3116                 }
  3117 
  3118               if (modifiers & CHAR_META)
  3119                 {
  3120                   /* Move the meta bit to the right place for a
  3121                      string.  */
  3122                   modifiers &= ~CHAR_META;
  3123                   ch = BYTE8_TO_CHAR (ch | 0x80);
  3124                   force_singlebyte = true;
  3125                 }
  3126             }
  3127 
  3128           /* Any modifiers remaining are invalid.  */
  3129           if (modifiers)
  3130             invalid_syntax ("Invalid modifier in string", readcharfun);
  3131           p += CHAR_STRING (ch, (unsigned char *) p);
  3132         }
  3133       else
  3134         {
  3135           p += CHAR_STRING (ch, (unsigned char *) p);
  3136           if (CHAR_BYTE8_P (ch))
  3137             force_singlebyte = true;
  3138           else if (! ASCII_CHAR_P (ch))
  3139             force_multibyte = true;
  3140         }
  3141       nchars++;
  3142     }
  3143 
  3144   if (ch < 0)
  3145     end_of_file_error ();
  3146 
  3147   if (!force_multibyte && force_singlebyte)
  3148     {
  3149       /* READ_BUFFER contains raw 8-bit bytes and no multibyte
  3150          forms.  Convert it to unibyte.  */
  3151       nchars = str_as_unibyte ((unsigned char *) read_buffer,
  3152                                p - read_buffer);
  3153       p = read_buffer + nchars;
  3154     }
  3155 
  3156   Lisp_Object obj = make_specified_string (read_buffer, nchars, p - read_buffer,
  3157                                            (force_multibyte
  3158                                             || (p - read_buffer != nchars)));
  3159   return unbind_to (count, obj);
  3160 }
  3161 
  3162 /* Make a hash table from the constructor plist.  */
  3163 static Lisp_Object
  3164 hash_table_from_plist (Lisp_Object plist)
  3165 {
  3166   Lisp_Object params[12];
  3167   Lisp_Object *par = params;
  3168 
  3169   /* This is repetitive but fast and simple.  */
  3170 #define ADDPARAM(name)                                  \
  3171   do {                                                  \
  3172     Lisp_Object val = plist_get (plist, Q ## name);     \
  3173     if (!NILP (val))                                    \
  3174       {                                                 \
  3175         *par++ = QC ## name;                            \
  3176         *par++ = val;                                   \
  3177       }                                                 \
  3178   } while (0)
  3179 
  3180   ADDPARAM (size);
  3181   ADDPARAM (test);
  3182   ADDPARAM (weakness);
  3183   ADDPARAM (rehash_size);
  3184   ADDPARAM (rehash_threshold);
  3185   ADDPARAM (purecopy);
  3186 
  3187   Lisp_Object data = plist_get (plist, Qdata);
  3188 
  3189   /* Now use params to make a new hash table and fill it.  */
  3190   Lisp_Object ht = Fmake_hash_table (par - params, params);
  3191 
  3192   Lisp_Object last = data;
  3193   FOR_EACH_TAIL_SAFE (data)
  3194     {
  3195       Lisp_Object key = XCAR (data);
  3196       data = XCDR (data);
  3197       if (!CONSP (data))
  3198         break;
  3199       Lisp_Object val = XCAR (data);
  3200       last = XCDR (data);
  3201       Fputhash (key, val, ht);
  3202     }
  3203   if (!NILP (last))
  3204     error ("Hash table data is not a list of even length");
  3205 
  3206   return ht;
  3207 }
  3208 
  3209 static Lisp_Object
  3210 record_from_list (Lisp_Object elems)
  3211 {
  3212   ptrdiff_t size = list_length (elems);
  3213   Lisp_Object obj = Fmake_record (XCAR (elems),
  3214                                   make_fixnum (size - 1),
  3215                                   Qnil);
  3216   Lisp_Object tl = XCDR (elems);
  3217   for (int i = 1; i < size; i++)
  3218     {
  3219       ASET (obj, i, XCAR (tl));
  3220       tl = XCDR (tl);
  3221     }
  3222   return obj;
  3223 }
  3224 
  3225 /* Turn a reversed list into a vector.  */
  3226 static Lisp_Object
  3227 vector_from_rev_list (Lisp_Object elems)
  3228 {
  3229   ptrdiff_t size = list_length (elems);
  3230   Lisp_Object obj = make_nil_vector (size);
  3231   Lisp_Object *vec = XVECTOR (obj)->contents;
  3232   for (ptrdiff_t i = size - 1; i >= 0; i--)
  3233     {
  3234       vec[i] = XCAR (elems);
  3235       Lisp_Object next = XCDR (elems);
  3236       free_cons (XCONS (elems));
  3237       elems = next;
  3238     }
  3239   return obj;
  3240 }
  3241 
  3242 static Lisp_Object
  3243 bytecode_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
  3244 {
  3245   Lisp_Object obj = vector_from_rev_list (elems);
  3246   Lisp_Object *vec = XVECTOR (obj)->contents;
  3247   ptrdiff_t size = ASIZE (obj);
  3248 
  3249   if (!(size >= COMPILED_STACK_DEPTH + 1 && size <= COMPILED_INTERACTIVE + 1
  3250         && (FIXNUMP (vec[COMPILED_ARGLIST])
  3251             || CONSP (vec[COMPILED_ARGLIST])
  3252             || NILP (vec[COMPILED_ARGLIST]))
  3253         && FIXNATP (vec[COMPILED_STACK_DEPTH])))
  3254     invalid_syntax ("Invalid byte-code object", readcharfun);
  3255 
  3256   if (load_force_doc_strings
  3257       && NILP (vec[COMPILED_CONSTANTS])
  3258       && STRINGP (vec[COMPILED_BYTECODE]))
  3259     {
  3260       /* Lazily-loaded bytecode is represented by the constant slot being nil
  3261          and the bytecode slot a (lazily loaded) string containing the
  3262          print representation of (BYTECODE . CONSTANTS).  Unpack the
  3263          pieces by coerceing the string to unibyte and reading the result.  */
  3264       Lisp_Object enc = vec[COMPILED_BYTECODE];
  3265       Lisp_Object pair = Fread (Fcons (enc, readcharfun));
  3266       if (!CONSP (pair))
  3267         invalid_syntax ("Invalid byte-code object", readcharfun);
  3268 
  3269       vec[COMPILED_BYTECODE] = XCAR (pair);
  3270       vec[COMPILED_CONSTANTS] = XCDR (pair);
  3271     }
  3272 
  3273   if (!((STRINGP (vec[COMPILED_BYTECODE])
  3274          && VECTORP (vec[COMPILED_CONSTANTS]))
  3275         || CONSP (vec[COMPILED_BYTECODE])))
  3276     invalid_syntax ("Invalid byte-code object", readcharfun);
  3277 
  3278   if (STRINGP (vec[COMPILED_BYTECODE]))
  3279     {
  3280       if (STRING_MULTIBYTE (vec[COMPILED_BYTECODE]))
  3281         {
  3282           /* BYTESTR must have been produced by Emacs 20.2 or earlier
  3283              because it produced a raw 8-bit string for byte-code and
  3284              now such a byte-code string is loaded as multibyte with
  3285              raw 8-bit characters converted to multibyte form.
  3286              Convert them back to the original unibyte form.  */
  3287           vec[COMPILED_BYTECODE] = Fstring_as_unibyte (vec[COMPILED_BYTECODE]);
  3288         }
  3289       /* Bytecode must be immovable.  */
  3290       pin_string (vec[COMPILED_BYTECODE]);
  3291     }
  3292 
  3293   XSETPVECTYPE (XVECTOR (obj), PVEC_COMPILED);
  3294   return obj;
  3295 }
  3296 
  3297 static Lisp_Object
  3298 char_table_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
  3299 {
  3300   Lisp_Object obj = vector_from_rev_list (elems);
  3301   if (ASIZE (obj) < CHAR_TABLE_STANDARD_SLOTS)
  3302     invalid_syntax ("Invalid size char-table", readcharfun);
  3303   XSETPVECTYPE (XVECTOR (obj), PVEC_CHAR_TABLE);
  3304   return obj;
  3305 
  3306 }
  3307 
  3308 static Lisp_Object
  3309 sub_char_table_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
  3310 {
  3311   /* A sub-char-table can't be read as a regular vector because of two
  3312      C integer fields.  */
  3313   elems = Fnreverse (elems);
  3314   ptrdiff_t size = list_length (elems);
  3315   if (size < 2)
  3316     error ("Invalid size of sub-char-table");
  3317 
  3318   if (!RANGED_FIXNUMP (1, XCAR (elems), 3))
  3319     error ("Invalid depth in sub-char-table");
  3320   int depth = XFIXNUM (XCAR (elems));
  3321 
  3322   if (chartab_size[depth] != size - 2)
  3323     error ("Invalid size in sub-char-table");
  3324   elems = XCDR (elems);
  3325 
  3326   if (!RANGED_FIXNUMP (0, XCAR (elems), MAX_CHAR))
  3327     error ("Invalid minimum character in sub-char-table");
  3328   int min_char = XFIXNUM (XCAR (elems));
  3329   elems = XCDR (elems);
  3330 
  3331   Lisp_Object tbl = make_uninit_sub_char_table (depth, min_char);
  3332   for (int i = 0; i < size - 2; i++)
  3333     {
  3334       XSUB_CHAR_TABLE (tbl)->contents[i] = XCAR (elems);
  3335       elems = XCDR (elems);
  3336     }
  3337   return tbl;
  3338 }
  3339 
  3340 static Lisp_Object
  3341 string_props_from_rev_list (Lisp_Object elems, Lisp_Object readcharfun)
  3342 {
  3343   elems = Fnreverse (elems);
  3344   if (NILP (elems) || !STRINGP (XCAR (elems)))
  3345     invalid_syntax ("#", readcharfun);
  3346   Lisp_Object obj = XCAR (elems);
  3347   for (Lisp_Object tl = XCDR (elems); !NILP (tl);)
  3348     {
  3349       Lisp_Object beg = XCAR (tl);
  3350       tl = XCDR (tl);
  3351       if (NILP (tl))
  3352         invalid_syntax ("Invalid string property list", readcharfun);
  3353       Lisp_Object end = XCAR (tl);
  3354       tl = XCDR (tl);
  3355       if (NILP (tl))
  3356         invalid_syntax ("Invalid string property list", readcharfun);
  3357       Lisp_Object plist = XCAR (tl);
  3358       tl = XCDR (tl);
  3359       Fset_text_properties (beg, end, plist, obj);
  3360     }
  3361   return obj;
  3362 }
  3363 
  3364 /* Read a bool vector (preceded by "#&").  */
  3365 static Lisp_Object
  3366 read_bool_vector (Lisp_Object readcharfun)
  3367 {
  3368   ptrdiff_t length = 0;
  3369   for (;;)
  3370     {
  3371       int c = READCHAR;
  3372       if (c < '0' || c > '9')
  3373         {
  3374           if (c != '"')
  3375             invalid_syntax ("#&", readcharfun);
  3376           break;
  3377         }
  3378       if (INT_MULTIPLY_WRAPV (length, 10, &length)
  3379           || INT_ADD_WRAPV (length, c - '0', &length))
  3380         invalid_syntax ("#&", readcharfun);
  3381     }
  3382 
  3383   ptrdiff_t size_in_chars = bool_vector_bytes (length);
  3384   Lisp_Object str = read_string_literal (readcharfun);
  3385   if (STRING_MULTIBYTE (str)
  3386       || !(size_in_chars == SCHARS (str)
  3387            /* We used to print 1 char too many when the number of bits
  3388               was a multiple of 8.  Accept such input in case it came
  3389               from an old version.  */
  3390            || length == (SCHARS (str) - 1) * BOOL_VECTOR_BITS_PER_CHAR))
  3391     invalid_syntax ("#&...", readcharfun);
  3392 
  3393   Lisp_Object obj = make_uninit_bool_vector (length);
  3394   unsigned char *data = bool_vector_uchar_data (obj);
  3395   memcpy (data, SDATA (str), size_in_chars);
  3396   /* Clear the extraneous bits in the last byte.  */
  3397   if (length != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
  3398     data[size_in_chars - 1] &= (1 << (length % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
  3399   return obj;
  3400 }
  3401 
  3402 /* Skip (and optionally remember) a lazily-loaded string
  3403    preceded by "#@".  Return true if this was a normal skip,
  3404    false if we read #@00 (which skips to EOB/EOF).  */
  3405 static bool
  3406 skip_lazy_string (Lisp_Object readcharfun)
  3407 {
  3408   ptrdiff_t nskip = 0;
  3409   ptrdiff_t digits = 0;
  3410   for (;;)
  3411     {
  3412       int c = READCHAR;
  3413       if (c < '0' || c > '9')
  3414         {
  3415           if (nskip > 0)
  3416             /* We can't use UNREAD here, because in the code below we side-step
  3417                READCHAR.  Instead, assume the first char after #@NNN occupies
  3418                a single byte, which is the case normally since it's just
  3419                a space.  */
  3420             nskip--;
  3421           else
  3422             UNREAD (c);
  3423           break;
  3424         }
  3425       if (INT_MULTIPLY_WRAPV (nskip, 10, &nskip)
  3426           || INT_ADD_WRAPV (nskip, c - '0', &nskip))
  3427         invalid_syntax ("#@", readcharfun);
  3428       digits++;
  3429       if (digits == 2 && nskip == 0)
  3430         {
  3431           /* #@00 means "read nil and skip to end" */
  3432           skip_dyn_eof (readcharfun);
  3433           return false;
  3434         }
  3435     }
  3436 
  3437   if (load_force_doc_strings && FROM_FILE_P (readcharfun))
  3438     {
  3439       /* If we are supposed to force doc strings into core right now,
  3440          record the last string that we skipped,
  3441          and record where in the file it comes from.  */
  3442 
  3443       /* First exchange the two saved_strings.  */
  3444       verify (ARRAYELTS (saved_strings) == 2);
  3445       struct saved_string t = saved_strings[0];
  3446       saved_strings[0] = saved_strings[1];
  3447       saved_strings[1] = t;
  3448 
  3449       enum { extra = 100 };
  3450       struct saved_string *ss = &saved_strings[0];
  3451       if (ss->size == 0)
  3452         {
  3453           ss->size = nskip + extra;
  3454           ss->string = xmalloc (ss->size);
  3455         }
  3456       else if (nskip > ss->size)
  3457         {
  3458           ss->size = nskip + extra;
  3459           ss->string = xrealloc (ss->string, ss->size);
  3460         }
  3461 
  3462       FILE *instream = infile->stream;
  3463       ss->position = (file_tell (instream) - infile->lookahead);
  3464 
  3465       /* Copy that many bytes into the saved string.  */
  3466       ptrdiff_t i = 0;
  3467       int c = 0;
  3468       for (int n = min (nskip, infile->lookahead); n > 0; n--)
  3469         ss->string[i++] = c = infile->buf[--infile->lookahead];
  3470       block_input ();
  3471       for (; i < nskip && c >= 0; i++)
  3472         ss->string[i] = c = getc (instream);
  3473       unblock_input ();
  3474 
  3475       ss->length = i;
  3476     }
  3477   else
  3478     /* Skip that many bytes.  */
  3479     skip_dyn_bytes (readcharfun, nskip);
  3480 
  3481   return true;
  3482 }
  3483 
  3484 /* Given a lazy-loaded string designator VAL, return the actual string.
  3485    VAL is (FILENAME . POS).  */
  3486 static Lisp_Object
  3487 get_lazy_string (Lisp_Object val)
  3488 {
  3489   /* Get a doc string from the file we are loading.
  3490      If it's in a saved string, get it from there.
  3491 
  3492      Here, we don't know if the string is a bytecode string or a doc
  3493      string.  As a bytecode string must be unibyte, we always return a
  3494      unibyte string.  If it is actually a doc string, caller must make
  3495      it multibyte.  */
  3496 
  3497   /* We used to emit negative positions for 'user variables' (whose doc
  3498      strings started with an asterisk); take the absolute value for
  3499      compatibility.  */
  3500   EMACS_INT pos = eabs (XFIXNUM (XCDR (val)));
  3501   struct saved_string *ss = &saved_strings[0];
  3502   struct saved_string *ssend = ss + ARRAYELTS (saved_strings);
  3503   while (ss < ssend
  3504          && !(pos >= ss->position && pos < ss->position + ss->length))
  3505     ss++;
  3506   if (ss >= ssend)
  3507     return get_doc_string (val, 1, 0);
  3508 
  3509   ptrdiff_t start = pos - ss->position;
  3510   char *str = ss->string;
  3511   ptrdiff_t from = start;
  3512   ptrdiff_t to = start;
  3513 
  3514   /* Process quoting with ^A, and find the end of the string,
  3515      which is marked with ^_ (037).  */
  3516   while (str[from] != 037)
  3517     {
  3518       int c = str[from++];
  3519       if (c == 1)
  3520         {
  3521           c = str[from++];
  3522           str[to++] = (c == 1 ? c
  3523                        : c == '0' ? 0
  3524                        : c == '_' ? 037
  3525                        : c);
  3526         }
  3527       else
  3528         str[to++] = c;
  3529     }
  3530 
  3531   return make_unibyte_string (str + start, to - start);
  3532 }
  3533 
  3534 
  3535 /* Length of prefix only consisting of symbol constituent characters.  */
  3536 static ptrdiff_t
  3537 symbol_char_span (const char *s)
  3538 {
  3539   const char *p = s;
  3540   while (   *p == '^' || *p == '*' || *p == '+' || *p == '-' || *p == '/'
  3541          || *p == '<' || *p == '=' || *p == '>' || *p == '_' || *p == '|')
  3542     p++;
  3543   return p - s;
  3544 }
  3545 
  3546 static void
  3547 skip_space_and_comments (Lisp_Object readcharfun)
  3548 {
  3549   int c;
  3550   do
  3551     {
  3552       c = READCHAR;
  3553       if (c == ';')
  3554         do
  3555           c = READCHAR;
  3556         while (c >= 0 && c != '\n');
  3557       if (c < 0)
  3558         end_of_file_error ();
  3559     }
  3560   while (c <= 32 || c == NO_BREAK_SPACE);
  3561   UNREAD (c);
  3562 }
  3563 
  3564 /* When an object is read, the type of the top read stack entry indicates
  3565    the syntactic context.  */
  3566 enum read_entry_type
  3567 {
  3568                                 /* preceding syntactic context */
  3569   RE_list_start,                /* "(" */
  3570 
  3571   RE_list,                      /* "(" (+ OBJECT) */
  3572   RE_list_dot,                  /* "(" (+ OBJECT) "." */
  3573 
  3574   RE_vector,                    /* "[" (* OBJECT) */
  3575   RE_record,                    /* "#s(" (* OBJECT) */
  3576   RE_char_table,                /* "#^[" (* OBJECT) */
  3577   RE_sub_char_table,            /* "#^^[" (* OBJECT) */
  3578   RE_byte_code,                 /* "#[" (* OBJECT) */
  3579   RE_string_props,              /* "#(" (* OBJECT) */
  3580 
  3581   RE_special,                   /* "'" | "#'" | "`" | "," | ",@" */
  3582 
  3583   RE_numbered,                  /* "#" (+ DIGIT) "=" */
  3584 };
  3585 
  3586 struct read_stack_entry
  3587 {
  3588   enum read_entry_type type;
  3589   union {
  3590     /* RE_list, RE_list_dot */
  3591     struct {
  3592       Lisp_Object head;         /* first cons of list */
  3593       Lisp_Object tail;         /* last cons of list */
  3594     } list;
  3595 
  3596     /* RE_vector, RE_record, RE_char_table, RE_sub_char_table,
  3597        RE_byte_code, RE_string_props */
  3598     struct {
  3599       Lisp_Object elems;        /* list of elements in reverse order */
  3600       bool old_locate_syms;     /* old value of locate_syms */
  3601     } vector;
  3602 
  3603     /* RE_special */
  3604     struct {
  3605       Lisp_Object symbol;       /* symbol from special syntax */
  3606     } special;
  3607 
  3608     /* RE_numbered */
  3609     struct {
  3610       Lisp_Object number;       /* number as a fixnum */
  3611       Lisp_Object placeholder;  /* placeholder object */
  3612     } numbered;
  3613   } u;
  3614 };
  3615 
  3616 struct read_stack
  3617 {
  3618   struct read_stack_entry *stack;  /* base of stack */
  3619   ptrdiff_t size;                  /* allocated size in entries */
  3620   ptrdiff_t sp;                    /* current number of entries */
  3621 };
  3622 
  3623 static struct read_stack rdstack = {NULL, 0, 0};
  3624 
  3625 void
  3626 mark_lread (void)
  3627 {
  3628   /* Mark the read stack, which may contain data not otherwise traced */
  3629   for (ptrdiff_t i = 0; i < rdstack.sp; i++)
  3630     {
  3631       struct read_stack_entry *e = &rdstack.stack[i];
  3632       switch (e->type)
  3633         {
  3634         case RE_list_start:
  3635           break;
  3636         case RE_list:
  3637         case RE_list_dot:
  3638           mark_object (e->u.list.head);
  3639           mark_object (e->u.list.tail);
  3640           break;
  3641         case RE_vector:
  3642         case RE_record:
  3643         case RE_char_table:
  3644         case RE_sub_char_table:
  3645         case RE_byte_code:
  3646         case RE_string_props:
  3647           mark_object (e->u.vector.elems);
  3648           break;
  3649         case RE_special:
  3650           mark_object (e->u.special.symbol);
  3651           break;
  3652         case RE_numbered:
  3653           mark_object (e->u.numbered.number);
  3654           mark_object (e->u.numbered.placeholder);
  3655           break;
  3656         }
  3657     }
  3658 }
  3659 
  3660 static inline struct read_stack_entry *
  3661 read_stack_top (void)
  3662 {
  3663   eassume (rdstack.sp > 0);
  3664   return &rdstack.stack[rdstack.sp - 1];
  3665 }
  3666 
  3667 static inline struct read_stack_entry *
  3668 read_stack_pop (void)
  3669 {
  3670   eassume (rdstack.sp > 0);
  3671   return &rdstack.stack[--rdstack.sp];
  3672 }
  3673 
  3674 static inline bool
  3675 read_stack_empty_p (ptrdiff_t base_sp)
  3676 {
  3677   return rdstack.sp <= base_sp;
  3678 }
  3679 
  3680 NO_INLINE static void
  3681 grow_read_stack (void)
  3682 {
  3683   struct read_stack *rs = &rdstack;
  3684   eassert (rs->sp == rs->size);
  3685   rs->stack = xpalloc (rs->stack, &rs->size, 1, -1, sizeof *rs->stack);
  3686   eassert (rs->sp < rs->size);
  3687 }
  3688 
  3689 static inline void
  3690 read_stack_push (struct read_stack_entry e)
  3691 {
  3692   if (rdstack.sp >= rdstack.size)
  3693     grow_read_stack ();
  3694   rdstack.stack[rdstack.sp++] = e;
  3695 }
  3696 
  3697 static void
  3698 read_stack_reset (intmax_t sp)
  3699 {
  3700   eassert (sp <= rdstack.sp);
  3701   rdstack.sp = sp;
  3702 }
  3703 
  3704 /* Read a Lisp object.
  3705    If LOCATE_SYMS is true, symbols are read with position.  */
  3706 static Lisp_Object
  3707 read0 (Lisp_Object readcharfun, bool locate_syms)
  3708 {
  3709   char stackbuf[64];
  3710   char *read_buffer = stackbuf;
  3711   ptrdiff_t read_buffer_size = sizeof stackbuf;
  3712   char *heapbuf = NULL;
  3713 
  3714   specpdl_ref base_pdl = SPECPDL_INDEX ();
  3715   ptrdiff_t base_sp = rdstack.sp;
  3716   record_unwind_protect_intmax (read_stack_reset, base_sp);
  3717 
  3718   specpdl_ref count = SPECPDL_INDEX ();
  3719 
  3720   bool uninterned_symbol;
  3721   bool skip_shorthand;
  3722 
  3723   /* Read an object into `obj'.  */
  3724  read_obj: ;
  3725   Lisp_Object obj;
  3726   bool multibyte;
  3727   int c = READCHAR_REPORT_MULTIBYTE (&multibyte);
  3728   if (c < 0)
  3729     end_of_file_error ();
  3730 
  3731   switch (c)
  3732     {
  3733     case '(':
  3734       read_stack_push ((struct read_stack_entry) {.type = RE_list_start});
  3735       goto read_obj;
  3736 
  3737     case ')':
  3738       if (read_stack_empty_p (base_sp))
  3739         invalid_syntax (")", readcharfun);
  3740       switch (read_stack_top ()->type)
  3741         {
  3742         case RE_list_start:
  3743           read_stack_pop ();
  3744           obj = Qnil;
  3745           break;
  3746         case RE_list:
  3747           obj = read_stack_pop ()->u.list.head;
  3748           break;
  3749         case RE_record:
  3750           {
  3751             locate_syms = read_stack_top ()->u.vector.old_locate_syms;
  3752             Lisp_Object elems = Fnreverse (read_stack_pop ()->u.vector.elems);
  3753             if (NILP (elems))
  3754               invalid_syntax ("#s", readcharfun);
  3755 
  3756             if (BASE_EQ (XCAR (elems), Qhash_table))
  3757               obj = hash_table_from_plist (XCDR (elems));
  3758             else
  3759               obj = record_from_list (elems);
  3760             break;
  3761           }
  3762         case RE_string_props:
  3763           locate_syms = read_stack_top ()->u.vector.old_locate_syms;
  3764           obj = string_props_from_rev_list (read_stack_pop () ->u.vector.elems,
  3765                                             readcharfun);
  3766           break;
  3767         default:
  3768           invalid_syntax (")", readcharfun);
  3769         }
  3770       break;
  3771 
  3772     case '[':
  3773       read_stack_push ((struct read_stack_entry) {
  3774           .type = RE_vector,
  3775           .u.vector.elems = Qnil,
  3776           .u.vector.old_locate_syms = locate_syms,
  3777         });
  3778       /* FIXME: should vectors be read with locate_syms=false?  */
  3779       goto read_obj;
  3780 
  3781     case ']':
  3782       if (read_stack_empty_p (base_sp))
  3783         invalid_syntax ("]", readcharfun);
  3784       switch (read_stack_top ()->type)
  3785         {
  3786         case RE_vector:
  3787           locate_syms = read_stack_top ()->u.vector.old_locate_syms;
  3788           obj = vector_from_rev_list (read_stack_pop ()->u.vector.elems);
  3789           break;
  3790         case RE_byte_code:
  3791           locate_syms = read_stack_top ()->u.vector.old_locate_syms;
  3792           obj = bytecode_from_rev_list (read_stack_pop ()->u.vector.elems,
  3793                                         readcharfun);
  3794           break;
  3795         case RE_char_table:
  3796           locate_syms = read_stack_top ()->u.vector.old_locate_syms;
  3797           obj = char_table_from_rev_list (read_stack_pop ()->u.vector.elems,
  3798                                           readcharfun);
  3799           break;
  3800         case RE_sub_char_table:
  3801           locate_syms = read_stack_top ()->u.vector.old_locate_syms;
  3802           obj = sub_char_table_from_rev_list (read_stack_pop ()->u.vector.elems,
  3803                                               readcharfun);
  3804           break;
  3805         default:
  3806           invalid_syntax ("]", readcharfun);
  3807           break;
  3808         }
  3809       break;
  3810 
  3811     case '#':
  3812       {
  3813         int ch = READCHAR;
  3814         switch (ch)
  3815           {
  3816           case '\'':
  3817             /* #'X -- special syntax for (function X) */
  3818             read_stack_push ((struct read_stack_entry) {
  3819                 .type = RE_special,
  3820                 .u.special.symbol = Qfunction,
  3821               });
  3822             goto read_obj;
  3823 
  3824           case '#':
  3825             /* ## -- the empty symbol */
  3826             obj = Fintern (empty_unibyte_string, Qnil);
  3827             break;
  3828 
  3829           case 's':
  3830             /* #s(...) -- a record or hash-table */
  3831             ch = READCHAR;
  3832             if (ch != '(')
  3833               {
  3834                 UNREAD (ch);
  3835                 invalid_syntax ("#s", readcharfun);
  3836               }
  3837             read_stack_push ((struct read_stack_entry) {
  3838                 .type = RE_record,
  3839                 .u.vector.elems = Qnil,
  3840                 .u.vector.old_locate_syms = locate_syms,
  3841               });
  3842             locate_syms = false;
  3843             goto read_obj;
  3844 
  3845           case '^':
  3846             /* #^[...]  -- char-table
  3847                #^^[...] -- sub-char-table */
  3848             ch = READCHAR;
  3849             if (ch == '^')
  3850               {
  3851                 ch = READCHAR;
  3852                 if (ch == '[')
  3853                   {
  3854                     read_stack_push ((struct read_stack_entry) {
  3855                         .type = RE_sub_char_table,
  3856                         .u.vector.elems = Qnil,
  3857                         .u.vector.old_locate_syms = locate_syms,
  3858                       });
  3859                     locate_syms = false;
  3860                     goto read_obj;
  3861                   }
  3862                 else
  3863                   {
  3864                     UNREAD (ch);
  3865                     invalid_syntax ("#^^", readcharfun);
  3866                   }
  3867               }
  3868             else if (ch == '[')
  3869               {
  3870                 read_stack_push ((struct read_stack_entry) {
  3871                     .type = RE_char_table,
  3872                     .u.vector.elems = Qnil,
  3873                     .u.vector.old_locate_syms = locate_syms,
  3874                   });
  3875                 locate_syms = false;
  3876                 goto read_obj;
  3877               }
  3878             else
  3879               {
  3880                 UNREAD (ch);
  3881                 invalid_syntax ("#^", readcharfun);
  3882               }
  3883 
  3884           case '(':
  3885             /* #(...) -- string with properties */
  3886             read_stack_push ((struct read_stack_entry) {
  3887                 .type = RE_string_props,
  3888                 .u.vector.elems = Qnil,
  3889                 .u.vector.old_locate_syms = locate_syms,
  3890               });
  3891             locate_syms = false;
  3892             goto read_obj;
  3893 
  3894           case '[':
  3895             /* #[...] -- byte-code */
  3896             read_stack_push ((struct read_stack_entry) {
  3897                 .type = RE_byte_code,
  3898                 .u.vector.elems = Qnil,
  3899                 .u.vector.old_locate_syms = locate_syms,
  3900               });
  3901             locate_syms = false;
  3902             goto read_obj;
  3903 
  3904           case '&':
  3905             /* #&N"..." -- bool-vector */
  3906             obj = read_bool_vector (readcharfun);
  3907             break;
  3908 
  3909           case '!':
  3910             /* #! appears at the beginning of an executable file.
  3911                Skip the rest of the line.  */
  3912             {
  3913               int c;
  3914               do
  3915                 c = READCHAR;
  3916               while (c >= 0 && c != '\n');
  3917               goto read_obj;
  3918             }
  3919 
  3920           case 'x':
  3921           case 'X':
  3922             obj = read_integer (readcharfun, 16);
  3923             break;
  3924 
  3925           case 'o':
  3926           case 'O':
  3927             obj = read_integer (readcharfun, 8);
  3928             break;
  3929 
  3930           case 'b':
  3931           case 'B':
  3932             obj = read_integer (readcharfun, 2);
  3933             break;
  3934 
  3935           case '@':
  3936             /* #@NUMBER is used to skip NUMBER following bytes.
  3937                That's used in .elc files to skip over doc strings
  3938                and function definitions that can be loaded lazily.  */
  3939             if (skip_lazy_string (readcharfun))
  3940               goto read_obj;
  3941             obj = Qnil;       /* #@00 skips to EOB/EOF and yields nil.  */
  3942             break;
  3943 
  3944           case '$':
  3945             /* #$ -- reference to lazy-loaded string */
  3946             obj = Vload_file_name;
  3947             break;
  3948 
  3949           case ':':
  3950             /* #:X -- uninterned symbol */
  3951             c = READCHAR;
  3952             if (c <= 32 || c == NO_BREAK_SPACE
  3953                 || c == '"' || c == '\'' || c == ';' || c == '#'
  3954                 || c == '(' || c == ')'  || c == '[' || c == ']'
  3955                 || c == '`' || c == ',')
  3956               {
  3957                 /* No symbol character follows: this is the empty symbol.  */
  3958                 UNREAD (c);
  3959                 obj = Fmake_symbol (empty_unibyte_string);
  3960                 break;
  3961               }
  3962             uninterned_symbol = true;
  3963             skip_shorthand = false;
  3964             goto read_symbol;
  3965 
  3966           case '_':
  3967             /* #_X -- symbol without shorthand */
  3968             c = READCHAR;
  3969             if (c <= 32 || c == NO_BREAK_SPACE
  3970                 || c == '"' || c == '\'' || c == ';' || c == '#'
  3971                 || c == '(' || c == ')'  || c == '[' || c == ']'
  3972                 || c == '`' || c == ',')
  3973               {
  3974                 /* No symbol character follows: this is the empty symbol.  */
  3975                 UNREAD (c);
  3976                 obj = Fintern (empty_unibyte_string, Qnil);
  3977                 break;
  3978               }
  3979             uninterned_symbol = false;
  3980             skip_shorthand = true;
  3981             goto read_symbol;
  3982 
  3983           default:
  3984             if (ch >= '0' && ch <= '9')
  3985               {
  3986                 /* #N=OBJ or #N# -- first read the number N */
  3987                 EMACS_INT n = ch - '0';
  3988                 int c;
  3989                 for (;;)
  3990                   {
  3991                     c = READCHAR;
  3992                     if (c < '0' || c > '9')
  3993                       break;
  3994                     if (INT_MULTIPLY_WRAPV (n, 10, &n)
  3995                         || INT_ADD_WRAPV (n, c - '0', &n))
  3996                       invalid_syntax ("#", readcharfun);
  3997                   }
  3998                 if (c == 'r' || c == 'R')
  3999                   {
  4000                     /* #NrDIGITS -- radix-N number */
  4001                     if (n < 0 || n > 36)
  4002                       invalid_radix_integer (n, readcharfun);
  4003                     obj = read_integer (readcharfun, n);
  4004                     break;
  4005                   }
  4006                 else if (n <= MOST_POSITIVE_FIXNUM && !NILP (Vread_circle))
  4007                   {
  4008                     if (c == '=')
  4009                       {
  4010                         /* #N=OBJ -- assign number N to OBJ */
  4011                         Lisp_Object placeholder = Fcons (Qnil, Qnil);
  4012 
  4013                         struct Lisp_Hash_Table *h
  4014                           = XHASH_TABLE (read_objects_map);
  4015                         Lisp_Object number = make_fixnum (n);
  4016                         Lisp_Object hash;
  4017                         ptrdiff_t i = hash_lookup (h, number, &hash);
  4018                         if (i >= 0)
  4019                           /* Not normal, but input could be malformed.  */
  4020                           set_hash_value_slot (h, i, placeholder);
  4021                         else
  4022                           hash_put (h, number, placeholder, hash);
  4023                         read_stack_push ((struct read_stack_entry) {
  4024                             .type = RE_numbered,
  4025                             .u.numbered.number = number,
  4026                             .u.numbered.placeholder = placeholder,
  4027                           });
  4028                         goto read_obj;
  4029                       }
  4030                     else if (c == '#')
  4031                       {
  4032                         /* #N# -- reference to numbered object */
  4033                         struct Lisp_Hash_Table *h
  4034                           = XHASH_TABLE (read_objects_map);
  4035                         ptrdiff_t i = hash_lookup (h, make_fixnum (n), NULL);
  4036                         if (i < 0)
  4037                           invalid_syntax ("#", readcharfun);
  4038                         obj = HASH_VALUE (h, i);
  4039                         break;
  4040                       }
  4041                     else
  4042                       invalid_syntax ("#", readcharfun);
  4043                   }
  4044                 else
  4045                   invalid_syntax ("#", readcharfun);
  4046               }
  4047             else
  4048               invalid_syntax ("#", readcharfun);
  4049           }
  4050         break;
  4051       }
  4052 
  4053     case '?':
  4054       obj = read_char_literal (readcharfun);
  4055       break;
  4056 
  4057     case '"':
  4058       obj = read_string_literal (readcharfun);
  4059       break;
  4060 
  4061     case '\'':
  4062       read_stack_push ((struct read_stack_entry) {
  4063           .type = RE_special,
  4064           .u.special.symbol = Qquote,
  4065         });
  4066       goto read_obj;
  4067 
  4068     case '`':
  4069       read_stack_push ((struct read_stack_entry) {
  4070           .type = RE_special,
  4071           .u.special.symbol = Qbackquote,
  4072         });
  4073       goto read_obj;
  4074 
  4075     case ',':
  4076       {
  4077         int ch = READCHAR;
  4078         Lisp_Object sym;
  4079         if (ch == '@')
  4080           sym = Qcomma_at;
  4081         else
  4082           {
  4083             if (ch >= 0)
  4084               UNREAD (ch);
  4085             sym = Qcomma;
  4086           }
  4087         read_stack_push ((struct read_stack_entry) {
  4088             .type = RE_special,
  4089             .u.special.symbol = sym,
  4090           });
  4091         goto read_obj;
  4092       }
  4093 
  4094     case ';':
  4095       {
  4096         int c;
  4097         do
  4098           c = READCHAR;
  4099         while (c >= 0 && c != '\n');
  4100         goto read_obj;
  4101       }
  4102 
  4103     case '.':
  4104       {
  4105         int nch = READCHAR;
  4106         UNREAD (nch);
  4107         if (nch <= 32 || nch == NO_BREAK_SPACE
  4108             || nch == '"' || nch == '\'' || nch == ';'
  4109             || nch == '(' || nch == '[' || nch == '#'
  4110             || nch == '?' || nch == '`' || nch == ',')
  4111           {
  4112             if (!read_stack_empty_p (base_sp)
  4113                 && read_stack_top ()->type ==  RE_list)
  4114               {
  4115                 read_stack_top ()->type = RE_list_dot;
  4116                 goto read_obj;
  4117               }
  4118             invalid_syntax (".", readcharfun);
  4119           }
  4120       }
  4121       /* may be a number or symbol starting with a dot */
  4122       FALLTHROUGH;
  4123 
  4124     default:
  4125       if (c <= 32 || c == NO_BREAK_SPACE)
  4126         goto read_obj;
  4127 
  4128       uninterned_symbol = false;
  4129       skip_shorthand = false;
  4130       /* symbol or number */
  4131     read_symbol:
  4132       {
  4133         char *p = read_buffer;
  4134         char *end = read_buffer + read_buffer_size;
  4135         bool quoted = false;
  4136         EMACS_INT start_position = readchar_offset - 1;
  4137 
  4138         do
  4139           {
  4140             if (end - p < MAX_MULTIBYTE_LENGTH + 1)
  4141               {
  4142                 ptrdiff_t offset = p - read_buffer;
  4143                 read_buffer = grow_read_buffer (read_buffer, offset,
  4144                                                 &heapbuf, &read_buffer_size,
  4145                                                 count);
  4146                 p = read_buffer + offset;
  4147                 end = read_buffer + read_buffer_size;
  4148               }
  4149 
  4150             if (c == '\\')
  4151               {
  4152                 c = READCHAR;
  4153                 if (c < 0)
  4154                   end_of_file_error ();
  4155                 quoted = true;
  4156               }
  4157 
  4158             if (multibyte)
  4159               p += CHAR_STRING (c, (unsigned char *) p);
  4160             else
  4161               *p++ = c;
  4162             c = READCHAR;
  4163           }
  4164         while (c > 32
  4165                && c != NO_BREAK_SPACE
  4166                && (c >= 128
  4167                    || !(   c == '"' || c == '\'' || c == ';' || c == '#'
  4168                         || c == '(' || c == ')'  || c == '[' || c == ']'
  4169                         || c == '`' || c == ',')));
  4170 
  4171         *p = 0;
  4172         ptrdiff_t nbytes = p - read_buffer;
  4173         UNREAD (c);
  4174 
  4175         /* Only attempt to parse the token as a number if it starts as one.  */
  4176         char c0 = read_buffer[0];
  4177         if (((c0 >= '0' && c0 <= '9') || c0 == '.' || c0 == '-' || c0 == '+')
  4178             && !quoted && !uninterned_symbol && !skip_shorthand)
  4179           {
  4180             ptrdiff_t len;
  4181             Lisp_Object result = string_to_number (read_buffer, 10, &len);
  4182             if (!NILP (result) && len == nbytes)
  4183               {
  4184                 obj = result;
  4185                 break;
  4186               }
  4187           }
  4188 
  4189         /* symbol, possibly uninterned */
  4190         ptrdiff_t nchars
  4191           = (multibyte
  4192              ? multibyte_chars_in_text ((unsigned char *)read_buffer, nbytes)
  4193              : nbytes);
  4194         Lisp_Object result;
  4195         if (uninterned_symbol)
  4196           {
  4197             Lisp_Object name
  4198               = (!NILP (Vpurify_flag)
  4199                  ? make_pure_string (read_buffer, nchars, nbytes, multibyte)
  4200                  : make_specified_string (read_buffer, nchars, nbytes,
  4201                                           multibyte));
  4202             result = Fmake_symbol (name);
  4203           }
  4204         else
  4205           {
  4206             /* Don't create the string object for the name unless
  4207                we're going to retain it in a new symbol.
  4208 
  4209                Like intern_1 but supports multibyte names.  */
  4210             Lisp_Object obarray = check_obarray (Vobarray);
  4211 
  4212             char *longhand = NULL;
  4213             ptrdiff_t longhand_chars = 0;
  4214             ptrdiff_t longhand_bytes = 0;
  4215 
  4216             Lisp_Object found;
  4217             if (skip_shorthand
  4218                 /* We exempt characters used in the "core" Emacs Lisp
  4219                    symbols that are comprised entirely of characters
  4220                    that have the 'symbol constituent' syntax from
  4221                    transforming according to shorthands.  */
  4222                 || symbol_char_span (read_buffer) >= nbytes)
  4223               found = oblookup (obarray, read_buffer, nchars, nbytes);
  4224             else
  4225               found = oblookup_considering_shorthand (obarray, read_buffer,
  4226                                                       nchars, nbytes, &longhand,
  4227                                                       &longhand_chars,
  4228                                                       &longhand_bytes);
  4229 
  4230             if (SYMBOLP (found))
  4231               result = found;
  4232             else if (longhand)
  4233               {
  4234                 Lisp_Object name = make_specified_string (longhand,
  4235                                                           longhand_chars,
  4236                                                           longhand_bytes,
  4237                                                           multibyte);
  4238                 xfree (longhand);
  4239                 result = intern_driver (name, obarray, found);
  4240               }
  4241             else
  4242               {
  4243                 Lisp_Object name = make_specified_string (read_buffer, nchars,
  4244                                                           nbytes, multibyte);
  4245                 result = intern_driver (name, obarray, found);
  4246               }
  4247           }
  4248         if (locate_syms && !NILP (result))
  4249           result = build_symbol_with_pos (result,
  4250                                           make_fixnum (start_position));
  4251 
  4252         obj = result;
  4253         break;
  4254       }
  4255     }
  4256 
  4257   /* We have read an object in `obj'.  Use the stack to decide what to
  4258      do with it.  */
  4259   while (rdstack.sp > base_sp)
  4260     {
  4261       struct read_stack_entry *e = read_stack_top ();
  4262       switch (e->type)
  4263         {
  4264         case RE_list_start:
  4265           e->type = RE_list;
  4266           e->u.list.head = e->u.list.tail = Fcons (obj, Qnil);
  4267           goto read_obj;
  4268 
  4269         case RE_list:
  4270           {
  4271             Lisp_Object tl = Fcons (obj, Qnil);
  4272             XSETCDR (e->u.list.tail, tl);
  4273             e->u.list.tail = tl;
  4274             goto read_obj;
  4275           }
  4276 
  4277         case RE_list_dot:
  4278           {
  4279             skip_space_and_comments (readcharfun);
  4280             int ch = READCHAR;
  4281             if (ch != ')')
  4282               invalid_syntax ("expected )", readcharfun);
  4283             XSETCDR (e->u.list.tail, obj);
  4284             read_stack_pop ();
  4285             obj = e->u.list.head;
  4286 
  4287             /* Hack: immediately convert (#$ . FIXNUM) to the corresponding
  4288                string if load-force-doc-strings is set.  */
  4289             if (load_force_doc_strings
  4290                 && BASE_EQ (XCAR (obj), Vload_file_name)
  4291                 && !NILP (XCAR (obj))
  4292                 && FIXNUMP (XCDR (obj)))
  4293               obj = get_lazy_string (obj);
  4294 
  4295             break;
  4296           }
  4297 
  4298         case RE_vector:
  4299         case RE_record:
  4300         case RE_char_table:
  4301         case RE_sub_char_table:
  4302         case RE_byte_code:
  4303         case RE_string_props:
  4304           e->u.vector.elems = Fcons (obj, e->u.vector.elems);
  4305           goto read_obj;
  4306 
  4307         case RE_special:
  4308           read_stack_pop ();
  4309           obj = list2 (e->u.special.symbol, obj);
  4310           break;
  4311 
  4312         case RE_numbered:
  4313           {
  4314             read_stack_pop ();
  4315             Lisp_Object placeholder = e->u.numbered.placeholder;
  4316             if (CONSP (obj))
  4317               {
  4318                 if (BASE_EQ (obj, placeholder))
  4319                   /* Catch silly games like #1=#1# */
  4320                   invalid_syntax ("nonsensical self-reference", readcharfun);
  4321 
  4322                 /* Optimization: since the placeholder is already
  4323                    a cons, repurpose it as the actual value.
  4324                    This allows us to skip the substitution below,
  4325                    since the placeholder is already referenced
  4326                    inside OBJ at the appropriate places.  */
  4327                 Fsetcar (placeholder, XCAR (obj));
  4328                 Fsetcdr (placeholder, XCDR (obj));
  4329 
  4330                 struct Lisp_Hash_Table *h2
  4331                   = XHASH_TABLE (read_objects_completed);
  4332                 Lisp_Object hash;
  4333                 ptrdiff_t i = hash_lookup (h2, placeholder, &hash);
  4334                 eassert (i < 0);
  4335                 hash_put (h2, placeholder, Qnil, hash);
  4336                 obj = placeholder;
  4337               }
  4338             else
  4339               {
  4340                 /* If it can be recursive, remember it for future
  4341                    substitutions.  */
  4342                 if (!SYMBOLP (obj) && !NUMBERP (obj)
  4343                     && !(STRINGP (obj) && !string_intervals (obj)))
  4344                   {
  4345                     struct Lisp_Hash_Table *h2
  4346                       = XHASH_TABLE (read_objects_completed);
  4347                     Lisp_Object hash;
  4348                     ptrdiff_t i = hash_lookup (h2, obj, &hash);
  4349                     eassert (i < 0);
  4350                     hash_put (h2, obj, Qnil, hash);
  4351                   }
  4352 
  4353                 /* Now put it everywhere the placeholder was...  */
  4354                 Flread__substitute_object_in_subtree (obj, placeholder,
  4355                                                       read_objects_completed);
  4356 
  4357                 /* ...and #n# will use the real value from now on.  */
  4358                 struct Lisp_Hash_Table *h = XHASH_TABLE (read_objects_map);
  4359                 Lisp_Object hash;
  4360                 ptrdiff_t i = hash_lookup (h, e->u.numbered.number, &hash);
  4361                 eassert (i >= 0);
  4362                 set_hash_value_slot (h, i, obj);
  4363               }
  4364             break;
  4365           }
  4366         }
  4367     }
  4368 
  4369   return unbind_to (base_pdl, obj);
  4370 }
  4371 
  4372 
  4373 DEFUN ("lread--substitute-object-in-subtree",
  4374        Flread__substitute_object_in_subtree,
  4375        Slread__substitute_object_in_subtree, 3, 3, 0,
  4376        doc: /* In OBJECT, replace every occurrence of PLACEHOLDER with OBJECT.
  4377 COMPLETED is a hash table of objects that might be circular, or is t
  4378 if any object might be circular.  */)
  4379   (Lisp_Object object, Lisp_Object placeholder, Lisp_Object completed)
  4380 {
  4381   struct subst subst = { object, placeholder, completed, Qnil };
  4382   Lisp_Object check_object = substitute_object_recurse (&subst, object);
  4383 
  4384   /* The returned object here is expected to always eq the
  4385      original.  */
  4386   if (!EQ (check_object, object))
  4387     error ("Unexpected mutation error in reader");
  4388   return Qnil;
  4389 }
  4390 
  4391 static Lisp_Object
  4392 substitute_object_recurse (struct subst *subst, Lisp_Object subtree)
  4393 {
  4394   /* If we find the placeholder, return the target object.  */
  4395   if (EQ (subst->placeholder, subtree))
  4396     return subst->object;
  4397 
  4398   /* For common object types that can't contain other objects, don't
  4399      bother looking them up; we're done.  */
  4400   if (SYMBOLP (subtree)
  4401       || (STRINGP (subtree) && !string_intervals (subtree))
  4402       || NUMBERP (subtree))
  4403     return subtree;
  4404 
  4405   /* If we've been to this node before, don't explore it again.  */
  4406   if (!NILP (Fmemq (subtree, subst->seen)))
  4407     return subtree;
  4408 
  4409   /* If this node can be the entry point to a cycle, remember that
  4410      we've seen it.  It can only be such an entry point if it was made
  4411      by #n=, which means that we can find it as a value in
  4412      COMPLETED.  */
  4413   if (EQ (subst->completed, Qt)
  4414       || hash_lookup (XHASH_TABLE (subst->completed), subtree, NULL) >= 0)
  4415     subst->seen = Fcons (subtree, subst->seen);
  4416 
  4417   /* Recurse according to subtree's type.
  4418      Every branch must return a Lisp_Object.  */
  4419   switch (XTYPE (subtree))
  4420     {
  4421     case Lisp_Vectorlike:
  4422       {
  4423         ptrdiff_t i = 0, length = 0;
  4424         if (BOOL_VECTOR_P (subtree))
  4425           return subtree;               /* No sub-objects anyway.  */
  4426         else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
  4427                  || COMPILEDP (subtree) || HASH_TABLE_P (subtree)
  4428                  || RECORDP (subtree))
  4429           length = PVSIZE (subtree);
  4430         else if (VECTORP (subtree))
  4431           length = ASIZE (subtree);
  4432         else
  4433           /* An unknown pseudovector may contain non-Lisp fields, so we
  4434              can't just blindly traverse all its fields.  We used to call
  4435              `Flength' which signaled `sequencep', so I just preserved this
  4436              behavior.  */
  4437           wrong_type_argument (Qsequencep, subtree);
  4438 
  4439         if (SUB_CHAR_TABLE_P (subtree))
  4440           i = 2;
  4441         for ( ; i < length; i++)
  4442           ASET (subtree, i,
  4443                 substitute_object_recurse (subst, AREF (subtree, i)));
  4444         return subtree;
  4445       }
  4446 
  4447     case Lisp_Cons:
  4448       XSETCAR (subtree, substitute_object_recurse (subst, XCAR (subtree)));
  4449       XSETCDR (subtree, substitute_object_recurse (subst, XCDR (subtree)));
  4450       return subtree;
  4451 
  4452     case Lisp_String:
  4453       {
  4454         /* Check for text properties in each interval.
  4455            substitute_in_interval contains part of the logic.  */
  4456 
  4457         INTERVAL root_interval = string_intervals (subtree);
  4458         traverse_intervals_noorder (root_interval,
  4459                                     substitute_in_interval, subst);
  4460         return subtree;
  4461       }
  4462 
  4463       /* Other types don't recurse any further.  */
  4464     default:
  4465       return subtree;
  4466     }
  4467 }
  4468 
  4469 /*  Helper function for substitute_object_recurse.  */
  4470 static void
  4471 substitute_in_interval (INTERVAL interval, void *arg)
  4472 {
  4473   set_interval_plist (interval,
  4474                       substitute_object_recurse (arg, interval->plist));
  4475 }
  4476 
  4477 
  4478 /* Convert the initial prefix of STRING to a number, assuming base BASE.
  4479    If the prefix has floating point syntax and BASE is 10, return a
  4480    nearest float; otherwise, if the prefix has integer syntax, return
  4481    the integer; otherwise, return nil.  If PLEN, set *PLEN to the
  4482    length of the numeric prefix if there is one, otherwise *PLEN is
  4483    unspecified.  */
  4484 
  4485 Lisp_Object
  4486 string_to_number (char const *string, int base, ptrdiff_t *plen)
  4487 {
  4488   char const *cp = string;
  4489   bool float_syntax = false;
  4490   double value = 0;
  4491 
  4492   /* Negate the value ourselves.  This treats 0, NaNs, and infinity properly on
  4493      IEEE floating point hosts, and works around a formerly-common bug where
  4494      atof ("-0.0") drops the sign.  */
  4495   bool negative = *cp == '-';
  4496   bool positive = *cp == '+';
  4497 
  4498   bool signedp = negative | positive;
  4499   cp += signedp;
  4500 
  4501   enum { INTOVERFLOW = 1, LEAD_INT = 2, TRAIL_INT = 4, E_EXP = 16 };
  4502   int state = 0;
  4503   int leading_digit = digit_to_number (*cp, base);
  4504   uintmax_t n = leading_digit;
  4505   if (leading_digit >= 0)
  4506     {
  4507       state |= LEAD_INT;
  4508       for (int digit; 0 <= (digit = digit_to_number (*++cp, base)); )
  4509         {
  4510           if (INT_MULTIPLY_OVERFLOW (n, base))
  4511             state |= INTOVERFLOW;
  4512           n *= base;
  4513           if (INT_ADD_OVERFLOW (n, digit))
  4514             state |= INTOVERFLOW;
  4515           n += digit;
  4516         }
  4517     }
  4518   char const *after_digits = cp;
  4519   if (*cp == '.')
  4520     {
  4521       cp++;
  4522     }
  4523 
  4524   if (base == 10)
  4525     {
  4526       if ('0' <= *cp && *cp <= '9')
  4527         {
  4528           state |= TRAIL_INT;
  4529           do
  4530             cp++;
  4531           while ('0' <= *cp && *cp <= '9');
  4532         }
  4533       if (*cp == 'e' || *cp == 'E')
  4534         {
  4535           char const *ecp = cp;
  4536           cp++;
  4537           if (*cp == '+' || *cp == '-')
  4538             cp++;
  4539           if ('0' <= *cp && *cp <= '9')
  4540             {
  4541               state |= E_EXP;
  4542               do
  4543                 cp++;
  4544               while ('0' <= *cp && *cp <= '9');
  4545             }
  4546 #if IEEE_FLOATING_POINT
  4547           else if (cp[-1] == '+'
  4548                    && cp[0] == 'I' && cp[1] == 'N' && cp[2] == 'F')
  4549             {
  4550               state |= E_EXP;
  4551               cp += 3;
  4552               value = INFINITY;
  4553             }
  4554           else if (cp[-1] == '+'
  4555                    && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
  4556             {
  4557               state |= E_EXP;
  4558               cp += 3;
  4559               union ieee754_double u
  4560                 = { .ieee_nan = { .exponent = 0x7ff, .quiet_nan = 1,
  4561                                   .mantissa0 = n >> 31 >> 1, .mantissa1 = n }};
  4562               value = u.d;
  4563             }
  4564 #endif
  4565           else
  4566             cp = ecp;
  4567         }
  4568 
  4569       /* A float has digits after the dot or an exponent.
  4570          This excludes numbers like "1." which are lexed as integers. */
  4571       float_syntax = ((state & TRAIL_INT)
  4572                       || ((state & LEAD_INT) && (state & E_EXP)));
  4573     }
  4574 
  4575   if (plen)
  4576     *plen = cp - string;
  4577 
  4578   /* Return a float if the number uses float syntax.  */
  4579   if (float_syntax)
  4580     {
  4581       /* Convert to floating point, unless the value is already known
  4582          because it is infinite or a NaN.  */
  4583       if (! value)
  4584         value = atof (string + signedp);
  4585       return make_float (negative ? -value : value);
  4586     }
  4587 
  4588   /* Return nil if the number uses invalid syntax.  */
  4589   if (! (state & LEAD_INT))
  4590     return Qnil;
  4591 
  4592   /* Fast path if the integer (san sign) fits in uintmax_t.  */
  4593   if (! (state & INTOVERFLOW))
  4594     {
  4595       if (!negative)
  4596         return make_uint (n);
  4597       if (-MOST_NEGATIVE_FIXNUM < n)
  4598         return make_neg_biguint (n);
  4599       EMACS_INT signed_n = n;
  4600       return make_fixnum (-signed_n);
  4601     }
  4602 
  4603   /* Trim any leading "+" and trailing nondigits, then return a bignum.  */
  4604   string += positive;
  4605   if (!*after_digits)
  4606     return make_bignum_str (string, base);
  4607   ptrdiff_t trimmed_len = after_digits - string;
  4608   USE_SAFE_ALLOCA;
  4609   char *trimmed = SAFE_ALLOCA (trimmed_len + 1);
  4610   memcpy (trimmed, string, trimmed_len);
  4611   trimmed[trimmed_len] = '\0';
  4612   Lisp_Object result = make_bignum_str (trimmed, base);
  4613   SAFE_FREE ();
  4614   return result;
  4615 }
  4616 
  4617 
  4618 static Lisp_Object initial_obarray;
  4619 
  4620 /* `oblookup' stores the bucket number here, for the sake of Funintern.  */
  4621 
  4622 static size_t oblookup_last_bucket_number;
  4623 
  4624 /* Get an error if OBARRAY is not an obarray.
  4625    If it is one, return it.  */
  4626 
  4627 Lisp_Object
  4628 check_obarray (Lisp_Object obarray)
  4629 {
  4630   /* We don't want to signal a wrong-type-argument error when we are
  4631      shutting down due to a fatal error, and we don't want to hit
  4632      assertions in VECTORP and ASIZE if the fatal error was during GC.  */
  4633   if (!fatal_error_in_progress
  4634       && (!VECTORP (obarray) || ASIZE (obarray) == 0))
  4635     {
  4636       /* If Vobarray is now invalid, force it to be valid.  */
  4637       if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
  4638       wrong_type_argument (Qvectorp, obarray);
  4639     }
  4640   return obarray;
  4641 }
  4642 
  4643 /* Intern symbol SYM in OBARRAY using bucket INDEX.  */
  4644 
  4645 static Lisp_Object
  4646 intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index)
  4647 {
  4648   Lisp_Object *ptr;
  4649 
  4650   XSYMBOL (sym)->u.s.interned = (EQ (obarray, initial_obarray)
  4651                                  ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY
  4652                                  : SYMBOL_INTERNED);
  4653 
  4654   if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray))
  4655     {
  4656       make_symbol_constant (sym);
  4657       XSYMBOL (sym)->u.s.redirect = SYMBOL_PLAINVAL;
  4658       /* Mark keywords as special.  This makes (let ((:key 'foo)) ...)
  4659          in lexically bound elisp signal an error, as documented.  */
  4660       XSYMBOL (sym)->u.s.declared_special = true;
  4661       SET_SYMBOL_VAL (XSYMBOL (sym), sym);
  4662     }
  4663 
  4664   ptr = aref_addr (obarray, XFIXNUM (index));
  4665   set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL);
  4666   *ptr = sym;
  4667   return sym;
  4668 }
  4669 
  4670 /* Intern a symbol with name STRING in OBARRAY using bucket INDEX.  */
  4671 
  4672 Lisp_Object
  4673 intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index)
  4674 {
  4675   SET_SYMBOL_VAL (XSYMBOL (Qobarray_cache), Qnil);
  4676   return intern_sym (Fmake_symbol (string), obarray, index);
  4677 }
  4678 
  4679 /* Intern the C string STR: return a symbol with that name,
  4680    interned in the current obarray.  */
  4681 
  4682 Lisp_Object
  4683 intern_1 (const char *str, ptrdiff_t len)
  4684 {
  4685   Lisp_Object obarray = check_obarray (Vobarray);
  4686   Lisp_Object tem = oblookup (obarray, str, len, len);
  4687 
  4688   return (SYMBOLP (tem) ? tem
  4689           /* The above `oblookup' was done on the basis of nchars==nbytes, so
  4690              the string has to be unibyte.  */
  4691           : intern_driver (make_unibyte_string (str, len),
  4692                            obarray, tem));
  4693 }
  4694 
  4695 Lisp_Object
  4696 intern_c_string_1 (const char *str, ptrdiff_t len)
  4697 {
  4698   Lisp_Object obarray = check_obarray (Vobarray);
  4699   Lisp_Object tem = oblookup (obarray, str, len, len);
  4700 
  4701   if (!SYMBOLP (tem))
  4702     {
  4703       Lisp_Object string;
  4704 
  4705       if (NILP (Vpurify_flag))
  4706         string = make_string (str, len);
  4707       else
  4708         string = make_pure_c_string (str, len);
  4709 
  4710       tem = intern_driver (string, obarray, tem);
  4711     }
  4712   return tem;
  4713 }
  4714 
  4715 static void
  4716 define_symbol (Lisp_Object sym, char const *str)
  4717 {
  4718   ptrdiff_t len = strlen (str);
  4719   Lisp_Object string = make_pure_c_string (str, len);
  4720   init_symbol (sym, string);
  4721 
  4722   /* Qunbound is uninterned, so that it's not confused with any symbol
  4723      'unbound' created by a Lisp program.  */
  4724   if (! BASE_EQ (sym, Qunbound))
  4725     {
  4726       Lisp_Object bucket = oblookup (initial_obarray, str, len, len);
  4727       eassert (FIXNUMP (bucket));
  4728       intern_sym (sym, initial_obarray, bucket);
  4729     }
  4730 }
  4731 
  4732 DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
  4733        doc: /* Return the canonical symbol whose name is STRING.
  4734 If there is none, one is created by this function and returned.
  4735 A second optional argument specifies the obarray to use;
  4736 it defaults to the value of `obarray'.  */)
  4737   (Lisp_Object string, Lisp_Object obarray)
  4738 {
  4739   Lisp_Object tem;
  4740 
  4741   obarray = check_obarray (NILP (obarray) ? Vobarray : obarray);
  4742   CHECK_STRING (string);
  4743 
  4744 
  4745   char* longhand = NULL;
  4746   ptrdiff_t longhand_chars = 0;
  4747   ptrdiff_t longhand_bytes = 0;
  4748   tem = oblookup_considering_shorthand (obarray, SSDATA (string),
  4749                                         SCHARS (string), SBYTES (string),
  4750                                         &longhand, &longhand_chars,
  4751                                         &longhand_bytes);
  4752 
  4753   if (!SYMBOLP (tem))
  4754     {
  4755       if (longhand)
  4756         {
  4757           tem = intern_driver (make_specified_string (longhand, longhand_chars,
  4758                                                       longhand_bytes, true),
  4759                                obarray, tem);
  4760           xfree (longhand);
  4761         }
  4762       else
  4763         tem = intern_driver (NILP (Vpurify_flag) ? string : Fpurecopy (string),
  4764                              obarray, tem);
  4765     }
  4766   return tem;
  4767 }
  4768 
  4769 DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
  4770        doc: /* Return the canonical symbol named NAME, or nil if none exists.
  4771 NAME may be a string or a symbol.  If it is a symbol, that exact
  4772 symbol is searched for.
  4773 A second optional argument specifies the obarray to use;
  4774 it defaults to the value of `obarray'.  */)
  4775   (Lisp_Object name, Lisp_Object obarray)
  4776 {
  4777   register Lisp_Object tem, string;
  4778 
  4779   if (NILP (obarray)) obarray = Vobarray;
  4780   obarray = check_obarray (obarray);
  4781 
  4782   if (!SYMBOLP (name))
  4783     {
  4784       char *longhand = NULL;
  4785       ptrdiff_t longhand_chars = 0;
  4786       ptrdiff_t longhand_bytes = 0;
  4787 
  4788       CHECK_STRING (name);
  4789       string = name;
  4790       tem = oblookup_considering_shorthand (obarray, SSDATA (string),
  4791                                             SCHARS (string), SBYTES (string),
  4792                                             &longhand, &longhand_chars,
  4793                                             &longhand_bytes);
  4794       if (longhand)
  4795         xfree (longhand);
  4796       return FIXNUMP (tem) ? Qnil : tem;
  4797     }
  4798   else
  4799     {
  4800       /* If already a symbol, we don't do shorthand-longhand translation,
  4801          as promised in the docstring.  */
  4802       string = SYMBOL_NAME (name);
  4803       tem
  4804         = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string));
  4805       return EQ (name, tem) ? name : Qnil;
  4806     }
  4807 }
  4808 
  4809 DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0,
  4810        doc: /* Delete the symbol named NAME, if any, from OBARRAY.
  4811 The value is t if a symbol was found and deleted, nil otherwise.
  4812 NAME may be a string or a symbol.  If it is a symbol, that symbol
  4813 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
  4814 OBARRAY, if nil, defaults to the value of the variable `obarray'.
  4815 usage: (unintern NAME OBARRAY)  */)
  4816   (Lisp_Object name, Lisp_Object obarray)
  4817 {
  4818   register Lisp_Object tem;
  4819   Lisp_Object string;
  4820   size_t hash;
  4821 
  4822   if (NILP (obarray)) obarray = Vobarray;
  4823   obarray = check_obarray (obarray);
  4824 
  4825   if (SYMBOLP (name))
  4826     string = SYMBOL_NAME (name);
  4827   else
  4828     {
  4829       CHECK_STRING (name);
  4830       string = name;
  4831     }
  4832 
  4833   char *longhand = NULL;
  4834   ptrdiff_t longhand_chars = 0;
  4835   ptrdiff_t longhand_bytes = 0;
  4836   tem = oblookup_considering_shorthand (obarray, SSDATA (string),
  4837                                         SCHARS (string), SBYTES (string),
  4838                                         &longhand, &longhand_chars,
  4839                                         &longhand_bytes);
  4840   if (longhand)
  4841     xfree(longhand);
  4842 
  4843   if (FIXNUMP (tem))
  4844     return Qnil;
  4845   /* If arg was a symbol, don't delete anything but that symbol itself.  */
  4846   if (SYMBOLP (name) && !EQ (name, tem))
  4847     return Qnil;
  4848 
  4849   /* There are plenty of other symbols which will screw up the Emacs
  4850      session if we unintern them, as well as even more ways to use
  4851      `setq' or `fset' or whatnot to make the Emacs session
  4852      unusable.  Let's not go down this silly road.  --Stef  */
  4853   /* if (NILP (tem) || EQ (tem, Qt))
  4854        error ("Attempt to unintern t or nil"); */
  4855 
  4856   XSYMBOL (tem)->u.s.interned = SYMBOL_UNINTERNED;
  4857 
  4858   hash = oblookup_last_bucket_number;
  4859 
  4860   if (EQ (AREF (obarray, hash), tem))
  4861     {
  4862       if (XSYMBOL (tem)->u.s.next)
  4863         {
  4864           Lisp_Object sym;
  4865           XSETSYMBOL (sym, XSYMBOL (tem)->u.s.next);
  4866           ASET (obarray, hash, sym);
  4867         }
  4868       else
  4869         ASET (obarray, hash, make_fixnum (0));
  4870     }
  4871   else
  4872     {
  4873       Lisp_Object tail, following;
  4874 
  4875       for (tail = AREF (obarray, hash);
  4876            XSYMBOL (tail)->u.s.next;
  4877            tail = following)
  4878         {
  4879           XSETSYMBOL (following, XSYMBOL (tail)->u.s.next);
  4880           if (EQ (following, tem))
  4881             {
  4882               set_symbol_next (tail, XSYMBOL (following)->u.s.next);
  4883               break;
  4884             }
  4885         }
  4886     }
  4887 
  4888   return Qt;
  4889 }
  4890 
  4891 /* Return the symbol in OBARRAY whose names matches the string
  4892    of SIZE characters (SIZE_BYTE bytes) at PTR.
  4893    If there is no such symbol, return the integer bucket number of
  4894    where the symbol would be if it were present.
  4895 
  4896    Also store the bucket number in oblookup_last_bucket_number.  */
  4897 
  4898 Lisp_Object
  4899 oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff_t size_byte)
  4900 {
  4901   size_t hash;
  4902   size_t obsize;
  4903   register Lisp_Object tail;
  4904   Lisp_Object bucket, tem;
  4905 
  4906   obarray = check_obarray (obarray);
  4907   /* This is sometimes needed in the middle of GC.  */
  4908   obsize = gc_asize (obarray);
  4909   hash = hash_string (ptr, size_byte) % obsize;
  4910   bucket = AREF (obarray, hash);
  4911   oblookup_last_bucket_number = hash;
  4912   if (BASE_EQ (bucket, make_fixnum (0)))
  4913     ;
  4914   else if (!SYMBOLP (bucket))
  4915     /* Like CADR error message.  */
  4916     xsignal2 (Qwrong_type_argument, Qobarrayp,
  4917               build_string ("Bad data in guts of obarray"));
  4918   else
  4919     for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next))
  4920       {
  4921         if (SBYTES (SYMBOL_NAME (tail)) == size_byte
  4922             && SCHARS (SYMBOL_NAME (tail)) == size
  4923             && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
  4924           return tail;
  4925         else if (XSYMBOL (tail)->u.s.next == 0)
  4926           break;
  4927       }
  4928   XSETINT (tem, hash);
  4929   return tem;
  4930 }
  4931 
  4932 /* Like 'oblookup', but considers 'Vread_symbol_shorthands',
  4933    potentially recognizing that IN is shorthand for some other
  4934    longhand name, which is then placed in OUT.  In that case,
  4935    memory is malloc'ed for OUT (which the caller must free) while
  4936    SIZE_OUT and SIZE_BYTE_OUT respectively hold the character and byte
  4937    sizes of the transformed symbol name.  If IN is not recognized
  4938    shorthand for any other symbol, OUT is set to point to NULL and
  4939    'oblookup' is called.  */
  4940 
  4941 Lisp_Object
  4942 oblookup_considering_shorthand (Lisp_Object obarray, const char *in,
  4943                                 ptrdiff_t size, ptrdiff_t size_byte, char **out,
  4944                                 ptrdiff_t *size_out, ptrdiff_t *size_byte_out)
  4945 {
  4946   Lisp_Object tail = Vread_symbol_shorthands;
  4947 
  4948   /* First, assume no transformation will take place.  */
  4949   *out = NULL;
  4950   /* Then, iterate each pair in Vread_symbol_shorthands.  */
  4951   FOR_EACH_TAIL_SAFE (tail)
  4952     {
  4953       Lisp_Object pair = XCAR (tail);
  4954       /* Be lenient to 'read-symbol-shorthands': if some element isn't a
  4955          cons, or some member of that cons isn't a string, just skip
  4956          to the next element.  */
  4957       if (!CONSP (pair))
  4958         continue;
  4959       Lisp_Object sh_prefix = XCAR (pair);
  4960       Lisp_Object lh_prefix = XCDR (pair);
  4961       if (!STRINGP (sh_prefix) || !STRINGP (lh_prefix))
  4962         continue;
  4963       ptrdiff_t sh_prefix_size = SBYTES (sh_prefix);
  4964 
  4965       /* Compare the prefix of the transformation pair to the symbol
  4966          name.  If a match occurs, do the renaming and exit the loop.
  4967          In other words, only one such transformation may take place.
  4968          Calculate the amount of memory to allocate for the longhand
  4969          version of the symbol name with xrealloc.  This isn't
  4970          strictly needed, but it could later be used as a way for
  4971          multiple transformations on a single symbol name.  */
  4972       if (sh_prefix_size <= size_byte
  4973           && memcmp (SSDATA (sh_prefix), in, sh_prefix_size) == 0)
  4974         {
  4975           ptrdiff_t lh_prefix_size = SBYTES (lh_prefix);
  4976           ptrdiff_t suffix_size = size_byte - sh_prefix_size;
  4977           *out = xrealloc (*out, lh_prefix_size + suffix_size);
  4978           memcpy (*out, SSDATA(lh_prefix), lh_prefix_size);
  4979           memcpy (*out + lh_prefix_size, in + sh_prefix_size, suffix_size);
  4980           *size_out = SCHARS (lh_prefix) - SCHARS (sh_prefix) + size;
  4981           *size_byte_out = lh_prefix_size + suffix_size;
  4982           break;
  4983         }
  4984     }
  4985   /* Now, as promised, call oblookup with the "final" symbol name to
  4986      lookup.  That function remains oblivious to whether a
  4987      transformation happened here or not, but the caller of this
  4988      function can tell by inspecting the OUT parameter.  */
  4989   if (*out)
  4990     return oblookup (obarray, *out, *size_out, *size_byte_out);
  4991   else
  4992     return oblookup (obarray, in, size, size_byte);
  4993 }
  4994 
  4995 
  4996 void
  4997 map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg)
  4998 {
  4999   ptrdiff_t i;
  5000   register Lisp_Object tail;
  5001   CHECK_VECTOR (obarray);
  5002   for (i = ASIZE (obarray) - 1; i >= 0; i--)
  5003     {
  5004       tail = AREF (obarray, i);
  5005       if (SYMBOLP (tail))
  5006         while (1)
  5007           {
  5008             (*fn) (tail, arg);
  5009             if (XSYMBOL (tail)->u.s.next == 0)
  5010               break;
  5011             XSETSYMBOL (tail, XSYMBOL (tail)->u.s.next);
  5012           }
  5013     }
  5014 }
  5015 
  5016 static void
  5017 mapatoms_1 (Lisp_Object sym, Lisp_Object function)
  5018 {
  5019   call1 (function, sym);
  5020 }
  5021 
  5022 DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
  5023        doc: /* Call FUNCTION on every symbol in OBARRAY.
  5024 OBARRAY defaults to the value of `obarray'.  */)
  5025   (Lisp_Object function, Lisp_Object obarray)
  5026 {
  5027   if (NILP (obarray)) obarray = Vobarray;
  5028   obarray = check_obarray (obarray);
  5029 
  5030   map_obarray (obarray, mapatoms_1, function);
  5031   return Qnil;
  5032 }
  5033 
  5034 #define OBARRAY_SIZE 15121
  5035 
  5036 void
  5037 init_obarray_once (void)
  5038 {
  5039   Vobarray = make_vector (OBARRAY_SIZE, make_fixnum (0));
  5040   initial_obarray = Vobarray;
  5041   staticpro (&initial_obarray);
  5042 
  5043   for (int i = 0; i < ARRAYELTS (lispsym); i++)
  5044     define_symbol (builtin_lisp_symbol (i), defsym_name[i]);
  5045 
  5046   DEFSYM (Qunbound, "unbound");
  5047 
  5048   DEFSYM (Qnil, "nil");
  5049   SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
  5050   make_symbol_constant (Qnil);
  5051   XSYMBOL (Qnil)->u.s.declared_special = true;
  5052 
  5053   DEFSYM (Qt, "t");
  5054   SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
  5055   make_symbol_constant (Qt);
  5056   XSYMBOL (Qt)->u.s.declared_special = true;
  5057 
  5058   /* Qt is correct even if not dumping.  loadup.el will set to nil at end.  */
  5059   Vpurify_flag = Qt;
  5060 
  5061   DEFSYM (Qvariable_documentation, "variable-documentation");
  5062 }
  5063 
  5064 
  5065 void
  5066 defsubr (union Aligned_Lisp_Subr *aname)
  5067 {
  5068   struct Lisp_Subr *sname = &aname->s;
  5069   Lisp_Object sym, tem;
  5070   sym = intern_c_string (sname->symbol_name);
  5071   XSETPVECTYPE (sname, PVEC_SUBR);
  5072   XSETSUBR (tem, sname);
  5073   set_symbol_function (sym, tem);
  5074 #ifdef HAVE_NATIVE_COMP
  5075   eassert (NILP (Vcomp_abi_hash));
  5076   Vcomp_subr_list = Fpurecopy (Fcons (tem, Vcomp_subr_list));
  5077 #endif
  5078 }
  5079 
  5080 #ifdef NOTDEF /* Use fset in subr.el now!  */
  5081 void
  5082 defalias (struct Lisp_Subr *sname, char *string)
  5083 {
  5084   Lisp_Object sym;
  5085   sym = intern (string);
  5086   XSETSUBR (XSYMBOL (sym)->u.s.function, sname);
  5087 }
  5088 #endif /* NOTDEF */
  5089 
  5090 /* Define an "integer variable"; a symbol whose value is forwarded to a
  5091    C variable of type intmax_t.  Sample call (with "xx" to fool make-docfile):
  5092    DEFxxVAR_INT ("emacs-priority", &emacs_priority, "Documentation");  */
  5093 void
  5094 defvar_int (struct Lisp_Intfwd const *i_fwd, char const *namestring)
  5095 {
  5096   Lisp_Object sym = intern_c_string (namestring);
  5097   XSYMBOL (sym)->u.s.declared_special = true;
  5098   XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
  5099   SET_SYMBOL_FWD (XSYMBOL (sym), i_fwd);
  5100 }
  5101 
  5102 /* Similar but define a variable whose value is t if 1, nil if 0.  */
  5103 void
  5104 defvar_bool (struct Lisp_Boolfwd const *b_fwd, char const *namestring)
  5105 {
  5106   Lisp_Object sym = intern_c_string (namestring);
  5107   XSYMBOL (sym)->u.s.declared_special = true;
  5108   XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
  5109   SET_SYMBOL_FWD (XSYMBOL (sym), b_fwd);
  5110   Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
  5111 }
  5112 
  5113 /* Similar but define a variable whose value is the Lisp Object stored
  5114    at address.  Two versions: with and without gc-marking of the C
  5115    variable.  The nopro version is used when that variable will be
  5116    gc-marked for some other reason, since marking the same slot twice
  5117    can cause trouble with strings.  */
  5118 void
  5119 defvar_lisp_nopro (struct Lisp_Objfwd const *o_fwd, char const *namestring)
  5120 {
  5121   Lisp_Object sym = intern_c_string (namestring);
  5122   XSYMBOL (sym)->u.s.declared_special = true;
  5123   XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
  5124   SET_SYMBOL_FWD (XSYMBOL (sym), o_fwd);
  5125 }
  5126 
  5127 void
  5128 defvar_lisp (struct Lisp_Objfwd const *o_fwd, char const *namestring)
  5129 {
  5130   defvar_lisp_nopro (o_fwd, namestring);
  5131   staticpro (o_fwd->objvar);
  5132 }
  5133 
  5134 /* Similar but define a variable whose value is the Lisp Object stored
  5135    at a particular offset in the current kboard object.  */
  5136 
  5137 void
  5138 defvar_kboard (struct Lisp_Kboard_Objfwd const *ko_fwd, char const *namestring)
  5139 {
  5140   Lisp_Object sym = intern_c_string (namestring);
  5141   XSYMBOL (sym)->u.s.declared_special = true;
  5142   XSYMBOL (sym)->u.s.redirect = SYMBOL_FORWARDED;
  5143   SET_SYMBOL_FWD (XSYMBOL (sym), ko_fwd);
  5144 }
  5145 
  5146 /* Check that the elements of lpath exist.  */
  5147 
  5148 static void
  5149 load_path_check (Lisp_Object lpath)
  5150 {
  5151   Lisp_Object path_tail;
  5152 
  5153   /* The only elements that might not exist are those from
  5154      PATH_LOADSEARCH, EMACSLOADPATH.  Anything else is only added if
  5155      it exists.  */
  5156   for (path_tail = lpath; !NILP (path_tail); path_tail = XCDR (path_tail))
  5157     {
  5158       Lisp_Object dirfile;
  5159       dirfile = Fcar (path_tail);
  5160       if (STRINGP (dirfile))
  5161         {
  5162           dirfile = Fdirectory_file_name (dirfile);
  5163           if (! file_accessible_directory_p (dirfile))
  5164             dir_warning ("Lisp directory", XCAR (path_tail));
  5165         }
  5166     }
  5167 }
  5168 
  5169 /* Return the default load-path, to be used if EMACSLOADPATH is unset.
  5170    This does not include the standard site-lisp directories
  5171    under the installation prefix (i.e., PATH_SITELOADSEARCH),
  5172    but it does (unless no_site_lisp is set) include site-lisp
  5173    directories in the source/build directories if those exist and we
  5174    are running uninstalled.
  5175 
  5176    Uses the following logic:
  5177    If !will_dump: Use PATH_LOADSEARCH.
  5178    The remainder is what happens when dumping is about to happen:
  5179    If dumping, just use PATH_DUMPLOADSEARCH.
  5180    Otherwise use PATH_LOADSEARCH.
  5181 
  5182    If !initialized, then just return PATH_DUMPLOADSEARCH.
  5183    If initialized:
  5184    If Vinstallation_directory is not nil (ie, running uninstalled):
  5185    If installation-dir/lisp exists and not already a member,
  5186    we must be running uninstalled.  Reset the load-path
  5187    to just installation-dir/lisp.  (The default PATH_LOADSEARCH
  5188    refers to the eventual installation directories.  Since we
  5189    are not yet installed, we should not use them, even if they exist.)
  5190    If installation-dir/lisp does not exist, just add
  5191    PATH_DUMPLOADSEARCH at the end instead.
  5192    Add installation-dir/site-lisp (if !no_site_lisp, and exists
  5193    and not already a member) at the front.
  5194    If installation-dir != source-dir (ie running an uninstalled,
  5195    out-of-tree build) AND install-dir/src/Makefile exists BUT
  5196    install-dir/src/Makefile.in does NOT exist (this is a sanity
  5197    check), then repeat the above steps for source-dir/lisp, site-lisp.  */
  5198 
  5199 static Lisp_Object
  5200 load_path_default (void)
  5201 {
  5202   if (will_dump_p ())
  5203     /* PATH_DUMPLOADSEARCH is the lisp dir in the source directory.
  5204        We used to add ../lisp (ie the lisp dir in the build
  5205        directory) at the front here, but that should not be
  5206        necessary, since in out of tree builds lisp/ is empty, save
  5207        for Makefile.  */
  5208     return decode_env_path (0, PATH_DUMPLOADSEARCH, 0);
  5209 
  5210   Lisp_Object lpath = Qnil;
  5211 
  5212   lpath = decode_env_path (0, PATH_LOADSEARCH, 0);
  5213 
  5214   if (!NILP (Vinstallation_directory))
  5215     {
  5216       Lisp_Object tem, tem1;
  5217 
  5218       /* Add to the path the lisp subdir of the installation
  5219          dir, if it is accessible.  Note: in out-of-tree builds,
  5220          this directory is empty save for Makefile.  */
  5221       tem = Fexpand_file_name (build_string ("lisp"),
  5222                                Vinstallation_directory);
  5223       tem1 = Ffile_accessible_directory_p (tem);
  5224       if (!NILP (tem1))
  5225         {
  5226           if (NILP (Fmember (tem, lpath)))
  5227             {
  5228               /* We are running uninstalled.  The default load-path
  5229                  points to the eventual installed lisp directories.
  5230                  We should not use those now, even if they exist,
  5231                  so start over from a clean slate.  */
  5232               lpath = list1 (tem);
  5233             }
  5234         }
  5235       else
  5236         /* That dir doesn't exist, so add the build-time
  5237            Lisp dirs instead.  */
  5238         {
  5239           Lisp_Object dump_path =
  5240             decode_env_path (0, PATH_DUMPLOADSEARCH, 0);
  5241           lpath = nconc2 (lpath, dump_path);
  5242         }
  5243 
  5244       /* Add site-lisp under the installation dir, if it exists.  */
  5245       if (!no_site_lisp)
  5246         {
  5247           tem = Fexpand_file_name (build_string ("site-lisp"),
  5248                                    Vinstallation_directory);
  5249           tem1 = Ffile_accessible_directory_p (tem);
  5250           if (!NILP (tem1))
  5251             {
  5252               if (NILP (Fmember (tem, lpath)))
  5253                 lpath = Fcons (tem, lpath);
  5254             }
  5255         }
  5256 
  5257       /* If Emacs was not built in the source directory,
  5258          and it is run from where it was built, add to load-path
  5259          the lisp and site-lisp dirs under that directory.  */
  5260 
  5261       if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
  5262         {
  5263           Lisp_Object tem2;
  5264 
  5265           tem = Fexpand_file_name (build_string ("src/Makefile"),
  5266                                    Vinstallation_directory);
  5267           tem1 = Ffile_exists_p (tem);
  5268 
  5269           /* Don't be fooled if they moved the entire source tree
  5270              AFTER dumping Emacs.  If the build directory is indeed
  5271              different from the source dir, src/Makefile.in and
  5272              src/Makefile will not be found together.  */
  5273           tem = Fexpand_file_name (build_string ("src/Makefile.in"),
  5274                                    Vinstallation_directory);
  5275           tem2 = Ffile_exists_p (tem);
  5276           if (!NILP (tem1) && NILP (tem2))
  5277             {
  5278               tem = Fexpand_file_name (build_string ("lisp"),
  5279                                        Vsource_directory);
  5280 
  5281               if (NILP (Fmember (tem, lpath)))
  5282                 lpath = Fcons (tem, lpath);
  5283 
  5284               if (!no_site_lisp)
  5285                 {
  5286                   tem = Fexpand_file_name (build_string ("site-lisp"),
  5287                                            Vsource_directory);
  5288                   tem1 = Ffile_accessible_directory_p (tem);
  5289                   if (!NILP (tem1))
  5290                     {
  5291                       if (NILP (Fmember (tem, lpath)))
  5292                         lpath = Fcons (tem, lpath);
  5293                     }
  5294                 }
  5295             }
  5296         } /* Vinstallation_directory != Vsource_directory */
  5297 
  5298     } /* if Vinstallation_directory */
  5299 
  5300   return lpath;
  5301 }
  5302 
  5303 void
  5304 init_lread (void)
  5305 {
  5306   /* First, set Vload_path.  */
  5307 
  5308   /* Ignore EMACSLOADPATH when dumping.  */
  5309   bool use_loadpath = !will_dump_p ();
  5310 
  5311   if (use_loadpath && egetenv ("EMACSLOADPATH"))
  5312     {
  5313       Vload_path = decode_env_path ("EMACSLOADPATH", 0, 1);
  5314 
  5315       /* Check (non-nil) user-supplied elements.  */
  5316       load_path_check (Vload_path);
  5317 
  5318       /* If no nils in the environment variable, use as-is.
  5319          Otherwise, replace any nils with the default.  */
  5320       if (! NILP (Fmemq (Qnil, Vload_path)))
  5321         {
  5322           Lisp_Object elem, elpath = Vload_path;
  5323           Lisp_Object default_lpath = load_path_default ();
  5324 
  5325           /* Check defaults, before adding site-lisp.  */
  5326           load_path_check (default_lpath);
  5327 
  5328           /* Add the site-lisp directories to the front of the default.  */
  5329           if (!no_site_lisp && PATH_SITELOADSEARCH[0] != '\0')
  5330             {
  5331               Lisp_Object sitelisp;
  5332               sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0);
  5333               if (! NILP (sitelisp))
  5334                 default_lpath = nconc2 (sitelisp, default_lpath);
  5335             }
  5336 
  5337           Vload_path = Qnil;
  5338 
  5339           /* Replace nils from EMACSLOADPATH by default.  */
  5340           while (CONSP (elpath))
  5341             {
  5342               elem = XCAR (elpath);
  5343               elpath = XCDR (elpath);
  5344               Vload_path = CALLN (Fappend, Vload_path,
  5345                                   NILP (elem) ? default_lpath : list1 (elem));
  5346             }
  5347         }                       /* Fmemq (Qnil, Vload_path) */
  5348     }
  5349   else
  5350     {
  5351       Vload_path = load_path_default ();
  5352 
  5353       /* Check before adding site-lisp directories.
  5354          The install should have created them, but they are not
  5355          required, so no need to warn if they are absent.
  5356          Or we might be running before installation.  */
  5357       load_path_check (Vload_path);
  5358 
  5359       /* Add the site-lisp directories at the front.  */
  5360       if (!will_dump_p () && !no_site_lisp && PATH_SITELOADSEARCH[0] != '\0')
  5361         {
  5362           Lisp_Object sitelisp;
  5363           sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0);
  5364           if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path);
  5365         }
  5366     }
  5367 
  5368   Vvalues = Qnil;
  5369 
  5370   load_in_progress = 0;
  5371   Vload_file_name = Qnil;
  5372   Vload_true_file_name = Qnil;
  5373   Vstandard_input = Qt;
  5374   Vloads_in_progress = Qnil;
  5375 }
  5376 
  5377 /* Print a warning that directory intended for use USE and with name
  5378    DIRNAME cannot be accessed.  On entry, errno should correspond to
  5379    the access failure.  Print the warning on stderr and put it in
  5380    *Messages*.  */
  5381 
  5382 void
  5383 dir_warning (char const *use, Lisp_Object dirname)
  5384 {
  5385   static char const format[] = "Warning: %s '%s': %s\n";
  5386   char *diagnostic = emacs_strerror (errno);
  5387   fprintf (stderr, format, use, SSDATA (ENCODE_SYSTEM (dirname)), diagnostic);
  5388 
  5389   /* Don't log the warning before we've initialized!!  */
  5390   if (initialized)
  5391     {
  5392       ptrdiff_t diaglen = strlen (diagnostic);
  5393       AUTO_STRING_WITH_LEN (diag, diagnostic, diaglen);
  5394       if (! NILP (Vlocale_coding_system))
  5395         {
  5396           Lisp_Object s
  5397             = code_convert_string_norecord (diag, Vlocale_coding_system, false);
  5398           diagnostic = SSDATA (s);
  5399           diaglen = SBYTES (s);
  5400         }
  5401       USE_SAFE_ALLOCA;
  5402       char *buffer = SAFE_ALLOCA (sizeof format - 3 * (sizeof "%s" - 1)
  5403                                   + strlen (use) + SBYTES (dirname) + diaglen);
  5404       ptrdiff_t message_len = esprintf (buffer, format, use, SSDATA (dirname),
  5405                                         diagnostic);
  5406       message_dolog (buffer, message_len, 0, STRING_MULTIBYTE (dirname));
  5407       SAFE_FREE ();
  5408     }
  5409 }
  5410 
  5411 void
  5412 syms_of_lread (void)
  5413 {
  5414   defsubr (&Sread);
  5415   defsubr (&Sread_positioning_symbols);
  5416   defsubr (&Sread_from_string);
  5417   defsubr (&Slread__substitute_object_in_subtree);
  5418   defsubr (&Sintern);
  5419   defsubr (&Sintern_soft);
  5420   defsubr (&Sunintern);
  5421   defsubr (&Sget_load_suffixes);
  5422   defsubr (&Sload);
  5423   defsubr (&Seval_buffer);
  5424   defsubr (&Seval_region);
  5425   defsubr (&Sread_char);
  5426   defsubr (&Sread_char_exclusive);
  5427   defsubr (&Sread_event);
  5428   defsubr (&Sget_file_char);
  5429   defsubr (&Smapatoms);
  5430   defsubr (&Slocate_file_internal);
  5431 
  5432   DEFVAR_LISP ("obarray", Vobarray,
  5433                doc: /* Symbol table for use by `intern' and `read'.
  5434 It is a vector whose length ought to be prime for best results.
  5435 The vector's contents don't make sense if examined from Lisp programs;
  5436 to find all the symbols in an obarray, use `mapatoms'.  */);
  5437 
  5438   DEFVAR_LISP ("values", Vvalues,
  5439                doc: /* List of values of all expressions which were read, evaluated and printed.
  5440 Order is reverse chronological.
  5441 This variable is obsolete as of Emacs 28.1 and should not be used.  */);
  5442   XSYMBOL (intern ("values"))->u.s.declared_special = false;
  5443 
  5444   DEFVAR_LISP ("standard-input", Vstandard_input,
  5445                doc: /* Stream for read to get input from.
  5446 See documentation of `read' for possible values.  */);
  5447   Vstandard_input = Qt;
  5448 
  5449   DEFVAR_LISP ("read-circle", Vread_circle,
  5450                doc: /* Non-nil means read recursive structures using #N= and #N# syntax.  */);
  5451   Vread_circle = Qt;
  5452 
  5453   DEFVAR_LISP ("load-path", Vload_path,
  5454                doc: /* List of directories to search for files to load.
  5455 Each element is a string (directory file name) or nil (meaning
  5456 `default-directory').
  5457 This list is consulted by the `require' function.
  5458 Initialized during startup as described in Info node `(elisp)Library Search'.
  5459 Use `directory-file-name' when adding items to this path.  However, Lisp
  5460 programs that process this list should tolerate directories both with
  5461 and without trailing slashes.  */);
  5462 
  5463   DEFVAR_LISP ("load-suffixes", Vload_suffixes,
  5464                doc: /* List of suffixes for Emacs Lisp files and dynamic modules.
  5465 This list includes suffixes for both compiled and source Emacs Lisp files.
  5466 This list should not include the empty string.
  5467 `load' and related functions try to append these suffixes, in order,
  5468 to the specified file name if a suffix is allowed or required.  */);
  5469   Vload_suffixes = list2 (build_pure_c_string (".elc"),
  5470                           build_pure_c_string (".el"));
  5471 #ifdef HAVE_MODULES
  5472   Vload_suffixes = Fcons (build_pure_c_string (MODULES_SUFFIX), Vload_suffixes);
  5473 #ifdef MODULES_SECONDARY_SUFFIX
  5474   Vload_suffixes =
  5475     Fcons (build_pure_c_string (MODULES_SECONDARY_SUFFIX), Vload_suffixes);
  5476 #endif
  5477 #endif
  5478   DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix,
  5479                doc: /* Suffix of loadable module file, or nil if modules are not supported.  */);
  5480 #ifdef HAVE_MODULES
  5481   Vmodule_file_suffix = build_pure_c_string (MODULES_SUFFIX);
  5482 #else
  5483   Vmodule_file_suffix = Qnil;
  5484 #endif
  5485 
  5486   DEFVAR_LISP ("dynamic-library-suffixes", Vdynamic_library_suffixes,
  5487                doc: /* A list of suffixes for loadable dynamic libraries.  */);
  5488 
  5489 #ifndef MSDOS
  5490   Vdynamic_library_suffixes
  5491     = Fcons (build_pure_c_string (DYNAMIC_LIB_SECONDARY_SUFFIX), Qnil);
  5492   Vdynamic_library_suffixes
  5493     = Fcons (build_pure_c_string (DYNAMIC_LIB_SUFFIX),
  5494              Vdynamic_library_suffixes);
  5495 #else
  5496   Vdynamic_library_suffixes = Qnil;
  5497 #endif
  5498 
  5499   DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
  5500                doc: /* List of suffixes that indicate representations of \
  5501 the same file.
  5502 This list should normally start with the empty string.
  5503 
  5504 Enabling Auto Compression mode appends the suffixes in
  5505 `jka-compr-load-suffixes' to this list and disabling Auto Compression
  5506 mode removes them again.  `load' and related functions use this list to
  5507 determine whether they should look for compressed versions of a file
  5508 and, if so, which suffixes they should try to append to the file name
  5509 in order to do so.  However, if you want to customize which suffixes
  5510 the loading functions recognize as compression suffixes, you should
  5511 customize `jka-compr-load-suffixes' rather than the present variable.  */);
  5512   Vload_file_rep_suffixes = list1 (empty_unibyte_string);
  5513 
  5514   DEFVAR_BOOL ("load-in-progress", load_in_progress,
  5515                doc: /* Non-nil if inside of `load'.  */);
  5516   DEFSYM (Qload_in_progress, "load-in-progress");
  5517 
  5518   DEFVAR_LISP ("after-load-alist", Vafter_load_alist,
  5519                doc: /* An alist of functions to be evalled when particular files are loaded.
  5520 Each element looks like (REGEXP-OR-FEATURE FUNCS...).
  5521 
  5522 REGEXP-OR-FEATURE is either a regular expression to match file names, or
  5523 a symbol (a feature name).
  5524 
  5525 When `load' is run and the file-name argument matches an element's
  5526 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
  5527 REGEXP-OR-FEATURE, the FUNCS in the element are called.
  5528 
  5529 An error in FUNCS does not undo the load, but does prevent calling
  5530 the rest of the FUNCS.  */);
  5531   Vafter_load_alist = Qnil;
  5532 
  5533   DEFVAR_LISP ("load-history", Vload_history,
  5534                doc: /* Alist mapping loaded file names to symbols and features.
  5535 Each alist element should be a list (FILE-NAME ENTRIES...), where
  5536 FILE-NAME is the name of a file that has been loaded into Emacs.
  5537 The file name is absolute and true (i.e. it doesn't contain symlinks).
  5538 As an exception, one of the alist elements may have FILE-NAME nil,
  5539 for symbols and features not associated with any file.
  5540 
  5541 The remaining ENTRIES in the alist element describe the functions and
  5542 variables defined in that file, the features provided, and the
  5543 features required.  Each entry has the form `(provide . FEATURE)',
  5544 `(require . FEATURE)', `(defun . FUNCTION)', `(defface . SYMBOL)',
  5545  `(define-type . SYMBOL)', or `(cl-defmethod METHOD SPECIALIZERS)'.
  5546 In addition, entries may also be single symbols,
  5547 which means that symbol was defined by `defvar' or `defconst'.
  5548 
  5549 During preloading, the file name recorded is relative to the main Lisp
  5550 directory.  These file names are converted to absolute at startup.  */);
  5551   Vload_history = Qnil;
  5552 
  5553   DEFVAR_LISP ("load-file-name", Vload_file_name,
  5554                doc: /* Full name of file being loaded by `load'.
  5555 
  5556 In case of native code being loaded this is indicating the
  5557 corresponding bytecode filename.  Use `load-true-file-name' to obtain
  5558 the .eln filename.  */);
  5559   Vload_file_name = Qnil;
  5560 
  5561   DEFVAR_LISP ("load-true-file-name", Vload_true_file_name,
  5562                doc: /* Full name of file being loaded by `load'.  */);
  5563   Vload_true_file_name = Qnil;
  5564 
  5565   DEFVAR_LISP ("user-init-file", Vuser_init_file,
  5566                doc: /* File name, including directory, of user's initialization file.
  5567 If the file loaded had extension `.elc', and the corresponding source file
  5568 exists, this variable contains the name of source file, suitable for use
  5569 by functions like `custom-save-all' which edit the init file.
  5570 While Emacs loads and evaluates any init file, value is the real name
  5571 of the file, regardless of whether or not it has the `.elc' extension.  */);
  5572   Vuser_init_file = Qnil;
  5573 
  5574   DEFVAR_LISP ("current-load-list", Vcurrent_load_list,
  5575                doc: /* Used for internal purposes by `load'.  */);
  5576   Vcurrent_load_list = Qnil;
  5577 
  5578   DEFVAR_LISP ("load-read-function", Vload_read_function,
  5579                doc: /* Function used for reading expressions.
  5580 It is used by `load' and `eval-region'.
  5581 
  5582 Called with a single argument (the stream from which to read).
  5583 The default is to use the function `read'.  */);
  5584   DEFSYM (Qread, "read");
  5585   Vload_read_function = Qread;
  5586 
  5587   DEFVAR_LISP ("load-source-file-function", Vload_source_file_function,
  5588                doc: /* Function called in `load' to load an Emacs Lisp source file.
  5589 The value should be a function for doing code conversion before
  5590 reading a source file.  It can also be nil, in which case loading is
  5591 done without any code conversion.
  5592 
  5593 If the value is a function, it is called with four arguments,
  5594 FULLNAME, FILE, NOERROR, NOMESSAGE.  FULLNAME is the absolute name of
  5595 the file to load, FILE is the non-absolute name (for messages etc.),
  5596 and NOERROR and NOMESSAGE are the corresponding arguments passed to
  5597 `load'.  The function should return t if the file was loaded.  */);
  5598   Vload_source_file_function = Qnil;
  5599 
  5600   DEFVAR_BOOL ("load-force-doc-strings", load_force_doc_strings,
  5601                doc: /* Non-nil means `load' should force-load all dynamic doc strings.
  5602 This is useful when the file being loaded is a temporary copy.  */);
  5603   load_force_doc_strings = 0;
  5604 
  5605   DEFVAR_BOOL ("load-convert-to-unibyte", load_convert_to_unibyte,
  5606                doc: /* Non-nil means `read' converts strings to unibyte whenever possible.
  5607 This is normally bound by `load' and `eval-buffer' to control `read',
  5608 and is not meant for users to change.  */);
  5609   load_convert_to_unibyte = 0;
  5610 
  5611   DEFVAR_LISP ("source-directory", Vsource_directory,
  5612                doc: /* Directory in which Emacs sources were found when Emacs was built.
  5613 You cannot count on them to still be there!  */);
  5614   Vsource_directory
  5615     = Fexpand_file_name (build_string ("../"),
  5616                          Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0)));
  5617 
  5618   DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list,
  5619                doc: /* List of files that were preloaded (when dumping Emacs).  */);
  5620   Vpreloaded_file_list = Qnil;
  5621 
  5622   DEFVAR_LISP ("byte-boolean-vars", Vbyte_boolean_vars,
  5623                doc: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer.  */);
  5624   Vbyte_boolean_vars = Qnil;
  5625 
  5626   DEFVAR_BOOL ("load-dangerous-libraries", load_dangerous_libraries,
  5627                doc: /* Non-nil means load dangerous compiled Lisp files.
  5628 Some versions of XEmacs use different byte codes than Emacs.  These
  5629 incompatible byte codes can make Emacs crash when it tries to execute
  5630 them.  */);
  5631   load_dangerous_libraries = 0;
  5632 
  5633   DEFVAR_BOOL ("force-load-messages", force_load_messages,
  5634                doc: /* Non-nil means force printing messages when loading Lisp files.
  5635 This overrides the value of the NOMESSAGE argument to `load'.  */);
  5636   force_load_messages = 0;
  5637 
  5638   DEFVAR_LISP ("bytecomp-version-regexp", Vbytecomp_version_regexp,
  5639                doc: /* Regular expression matching safe to load compiled Lisp files.
  5640 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
  5641 from the file, and matches them against this regular expression.
  5642 When the regular expression matches, the file is considered to be safe
  5643 to load.  */);
  5644   Vbytecomp_version_regexp
  5645     = build_pure_c_string
  5646         ("^;;;.\\(?:in Emacs version\\|bytecomp version FSF\\)");
  5647 
  5648   DEFSYM (Qlexical_binding, "lexical-binding");
  5649   DEFVAR_LISP ("lexical-binding", Vlexical_binding,
  5650                doc: /* Whether to use lexical binding when evaluating code.
  5651 Non-nil means that the code in the current buffer should be evaluated
  5652 with lexical binding.
  5653 This variable is automatically set from the file variables of an
  5654 interpreted Lisp file read using `load'.  Unlike other file local
  5655 variables, this must be set in the first line of a file.  */);
  5656   Vlexical_binding = Qnil;
  5657   Fmake_variable_buffer_local (Qlexical_binding);
  5658 
  5659   DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list,
  5660                doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'.  */);
  5661   Veval_buffer_list = Qnil;
  5662 
  5663   DEFVAR_LISP ("lread--unescaped-character-literals",
  5664                Vlread_unescaped_character_literals,
  5665                doc: /* List of deprecated unescaped character literals encountered by `read'.
  5666 For internal use only.  */);
  5667   Vlread_unescaped_character_literals = Qnil;
  5668   DEFSYM (Qlread_unescaped_character_literals,
  5669           "lread--unescaped-character-literals");
  5670 
  5671   /* Defined in lisp/emacs-lisp/byte-run.el.  */
  5672   DEFSYM (Qbyte_run_unescaped_character_literals_warning,
  5673           "byte-run--unescaped-character-literals-warning");
  5674 
  5675   DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer,
  5676                doc: /* Non-nil means `load' prefers the newest version of a file.
  5677 This applies when a filename suffix is not explicitly specified and
  5678 `load' is trying various possible suffixes (see `load-suffixes' and
  5679 `load-file-rep-suffixes').  Normally, it stops at the first file
  5680 that exists unless you explicitly specify one or the other.  If this
  5681 option is non-nil, it checks all suffixes and uses whichever file is
  5682 newest.
  5683 Note that if you customize this, obviously it will not affect files
  5684 that are loaded before your customizations are read!  */);
  5685   load_prefer_newer = 0;
  5686 
  5687   DEFVAR_BOOL ("load-no-native", load_no_native,
  5688                doc: /* Non-nil means not to load a .eln file when a .elc was requested.  */);
  5689   load_no_native = false;
  5690 
  5691   /* Vsource_directory was initialized in init_lread.  */
  5692 
  5693   DEFSYM (Qcurrent_load_list, "current-load-list");
  5694   DEFSYM (Qstandard_input, "standard-input");
  5695   DEFSYM (Qread_char, "read-char");
  5696   DEFSYM (Qget_file_char, "get-file-char");
  5697 
  5698   /* Used instead of Qget_file_char while loading *.elc files compiled
  5699      by Emacs 21 or older.  */
  5700   DEFSYM (Qget_emacs_mule_file_char, "get-emacs-mule-file-char");
  5701 
  5702   DEFSYM (Qload_force_doc_strings, "load-force-doc-strings");
  5703 
  5704   DEFSYM (Qbackquote, "`");
  5705   DEFSYM (Qcomma, ",");
  5706   DEFSYM (Qcomma_at, ",@");
  5707 
  5708   DEFSYM (Qinhibit_file_name_operation, "inhibit-file-name-operation");
  5709   DEFSYM (Qascii_character, "ascii-character");
  5710   DEFSYM (Qfunction, "function");
  5711   DEFSYM (Qload, "load");
  5712   DEFSYM (Qload_file_name, "load-file-name");
  5713   DEFSYM (Qload_true_file_name, "load-true-file-name");
  5714   DEFSYM (Qeval_buffer_list, "eval-buffer-list");
  5715   DEFSYM (Qdir_ok, "dir-ok");
  5716   DEFSYM (Qdo_after_load_evaluation, "do-after-load-evaluation");
  5717 
  5718   staticpro (&read_objects_map);
  5719   read_objects_map = Qnil;
  5720   staticpro (&read_objects_completed);
  5721   read_objects_completed = Qnil;
  5722 
  5723   Vloads_in_progress = Qnil;
  5724   staticpro (&Vloads_in_progress);
  5725 
  5726   DEFSYM (Qhash_table, "hash-table");
  5727   DEFSYM (Qdata, "data");
  5728   DEFSYM (Qtest, "test");
  5729   DEFSYM (Qsize, "size");
  5730   DEFSYM (Qpurecopy, "purecopy");
  5731   DEFSYM (Qweakness, "weakness");
  5732   DEFSYM (Qrehash_size, "rehash-size");
  5733   DEFSYM (Qrehash_threshold, "rehash-threshold");
  5734 
  5735   DEFSYM (Qchar_from_name, "char-from-name");
  5736 
  5737   DEFVAR_LISP ("read-symbol-shorthands", Vread_symbol_shorthands,
  5738           doc: /* Alist of known symbol-name shorthands.
  5739 This variable's value can only be set via file-local variables.
  5740 See Info node `(elisp)Shorthands' for more details.  */);
  5741   Vread_symbol_shorthands = Qnil;
  5742   DEFSYM (Qobarray_cache, "obarray-cache");
  5743   DEFSYM (Qobarrayp, "obarrayp");
  5744 
  5745   DEFSYM (Qmacroexp__dynvars, "macroexp--dynvars");
  5746   DEFVAR_LISP ("macroexp--dynvars", Vmacroexp__dynvars,
  5747         doc:   /* List of variables declared dynamic in the current scope.
  5748 Only valid during macro-expansion.  Internal use only. */);
  5749   Vmacroexp__dynvars = Qnil;
  5750 }