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