root/src/lread.c

DEFINITIONS

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