1 /* Lisp parsing and input streams.
   2    Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995,
   3                  1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
   4                  2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, 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
  11 (at 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 <http://www.gnu.org/licenses/>.  */
  20 
  21 
  22 #include <config.h>
  23 #include <stdio.h>
  24 #include <sys/types.h>
  25 #include <sys/stat.h>
  26 #include <sys/file.h>
  27 #include <errno.h>
  28 #include <setjmp.h>
  29 #include "lisp.h"
  30 #include "intervals.h"
  31 #include "buffer.h"
  32 #include "character.h"
  33 #include "charset.h"
  34 #include "coding.h"
  35 #include <epaths.h>
  36 #include "commands.h"
  37 #include "keyboard.h"
  38 #include "frame.h"
  39 #include "termhooks.h"
  40 #include "coding.h"
  41 #include "blockinput.h"
  42 
  43 #ifdef MSDOS
  44 #include "msdos.h"
  45 #endif
  46 
  47 #ifdef HAVE_UNISTD_H
  48 #include <unistd.h>
  49 #endif
  50 
  51 #ifndef X_OK
  52 #define X_OK 01
  53 #endif
  54 
  55 #include <math.h>
  56 
  57 #ifdef HAVE_SETLOCALE
  58 #include <locale.h>
  59 #endif /* HAVE_SETLOCALE */
  60 
  61 #ifdef HAVE_FCNTL_H
  62 #include <fcntl.h>
  63 #endif
  64 #ifndef O_RDONLY
  65 #define O_RDONLY 0
  66 #endif
  67 
  68 #ifdef HAVE_FSEEKO
  69 #define file_offset off_t
  70 #define file_tell ftello
  71 #else
  72 #define file_offset long
  73 #define file_tell ftell
  74 #endif
  75 
  76 /* hash table read constants */
  77 Lisp_Object Qhash_table, Qdata;
  78 Lisp_Object Qtest, Qsize;
  79 Lisp_Object Qweakness;
  80 Lisp_Object Qrehash_size;
  81 Lisp_Object Qrehash_threshold;
  82 extern Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweakness;
  83 
  84 Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
  85 Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
  86 Lisp_Object Qascii_character, Qload, Qload_file_name;
  87 Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
  88 Lisp_Object Qinhibit_file_name_operation;
  89 Lisp_Object Qeval_buffer_list, Veval_buffer_list;
  90 Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
  91 
  92 /* Used instead of Qget_file_char while loading *.elc files compiled
  93    by Emacs 21 or older.  */
  94 static Lisp_Object Qget_emacs_mule_file_char;
  95 
  96 static Lisp_Object Qload_force_doc_strings;
  97 
  98 extern Lisp_Object Qevent_symbol_element_mask;
  99 extern Lisp_Object Qfile_exists_p;
 100 
 101 /* non-zero if inside `load' */
 102 int load_in_progress;
 103 static Lisp_Object Qload_in_progress;
 104 
 105 /* Directory in which the sources were found.  */
 106 Lisp_Object Vsource_directory;
 107 
 108 /* Search path and suffixes for files to be loaded. */
 109 Lisp_Object Vload_path, Vload_suffixes, Vload_file_rep_suffixes;
 110 
 111 /* File name of user's init file.  */
 112 Lisp_Object Vuser_init_file;
 113 
 114 /* This is the user-visible association list that maps features to
 115    lists of defs in their load files. */
 116 Lisp_Object Vload_history;
 117 
 118 /* This is used to build the load history. */
 119 Lisp_Object Vcurrent_load_list;
 120 
 121 /* List of files that were preloaded.  */
 122 Lisp_Object Vpreloaded_file_list;
 123 
 124 /* Name of file actually being read by `load'.  */
 125 Lisp_Object Vload_file_name;
 126 
 127 /* Function to use for reading, in `load' and friends.  */
 128 Lisp_Object Vload_read_function;
 129 
 130 /* Non-nil means read recursive structures using #n= and #n# syntax.  */
 131 Lisp_Object Vread_circle;
 132 
 133 /* The association list of objects read with the #n=object form.
 134    Each member of the list has the form (n . object), and is used to
 135    look up the object for the corresponding #n# construct.
 136    It must be set to nil before all top-level calls to read0.  */
 137 Lisp_Object read_objects;
 138 
 139 /* Nonzero means load should forcibly load all dynamic doc strings.  */
 140 static int load_force_doc_strings;
 141 
 142 /* Nonzero means read should convert strings to unibyte.  */
 143 static int load_convert_to_unibyte;
 144 
 145 /* Nonzero means READCHAR should read bytes one by one (not character)
 146    when READCHARFUN is Qget_file_char or Qget_emacs_mule_file_char.
 147    This is set to 1 by read1 temporarily while handling #@NUMBER.  */
 148 static int load_each_byte;
 149 
 150 /* Function to use for loading an Emacs Lisp source file (not
 151    compiled) instead of readevalloop.  */
 152 Lisp_Object Vload_source_file_function;
 153 
 154 /* List of all DEFVAR_BOOL variables.  Used by the byte optimizer.  */
 155 Lisp_Object Vbyte_boolean_vars;
 156 
 157 /* Whether or not to add a `read-positions' property to symbols
 158    read. */
 159 Lisp_Object Vread_with_symbol_positions;
 160 
 161 /* List of (SYMBOL . POSITION) accumulated so far. */
 162 Lisp_Object Vread_symbol_positions_list;
 163 
 164 /* List of descriptors now open for Fload.  */
 165 static Lisp_Object load_descriptor_list;
 166 
 167 /* File for get_file_char to read from.  Use by load.  */
 168 static FILE *instream;
 169 
 170 /* When nonzero, read conses in pure space */
 171 static int read_pure;
 172 
 173 /* For use within read-from-string (this reader is non-reentrant!!)  */
 174 static int read_from_string_index;
 175 static int read_from_string_index_byte;
 176 static int read_from_string_limit;
 177 
 178 /* Number of characters read in the current call to Fread or
 179    Fread_from_string. */
 180 static int readchar_count;
 181 
 182 /* This contains the last string skipped with #@.  */
 183 static char *saved_doc_string;
 184 /* Length of buffer allocated in saved_doc_string.  */
 185 static int saved_doc_string_size;
 186 /* Length of actual data in saved_doc_string.  */
 187 static int saved_doc_string_length;
 188 /* This is the file position that string came from.  */
 189 static file_offset saved_doc_string_position;
 190 
 191 /* This contains the previous string skipped with #@.
 192    We copy it from saved_doc_string when a new string
 193    is put in saved_doc_string.  */
 194 static char *prev_saved_doc_string;
 195 /* Length of buffer allocated in prev_saved_doc_string.  */
 196 static int prev_saved_doc_string_size;
 197 /* Length of actual data in prev_saved_doc_string.  */
 198 static int prev_saved_doc_string_length;
 199 /* This is the file position that string came from.  */
 200 static file_offset prev_saved_doc_string_position;
 201 
 202 /* Nonzero means inside a new-style backquote
 203    with no surrounding parentheses.
 204    Fread initializes this to zero, so we need not specbind it
 205    or worry about what happens to it when there is an error.  */
 206 static int new_backquote_flag;
 207 static Lisp_Object Vold_style_backquotes, Qold_style_backquotes;
 208 
 209 /* A list of file names for files being loaded in Fload.  Used to
 210    check for recursive loads.  */
 211 
 212 static Lisp_Object Vloads_in_progress;
 213 
 214 /* Non-zero means load dangerous compiled Lisp files.  */
 215 
 216 int load_dangerous_libraries;
 217 
 218 /* Non-zero means force printing messages when loading Lisp files.  */
 219 
 220 int force_load_messages;
 221 
 222 /* A regular expression used to detect files compiled with Emacs.  */
 223 
 224 static Lisp_Object Vbytecomp_version_regexp;
 225 
 226 static int read_emacs_mule_char P_ ((int, int (*) (int, Lisp_Object),
 227                                      Lisp_Object));
 228 
 229 static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,
 230                               Lisp_Object (*) (), int,
 231                               Lisp_Object, Lisp_Object,
 232                               Lisp_Object, Lisp_Object));
 233 static Lisp_Object load_unwind P_ ((Lisp_Object));
 234 static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));
 235 
 236 static void invalid_syntax P_ ((const char *, int)) NO_RETURN;
 237 static void end_of_file_error P_ (()) NO_RETURN;
 238 
 239 
 240 /* Functions that read one byte from the current source READCHARFUN
 241    or unreads one byte.  If the integer argument C is -1, it returns
 242    one read byte, or -1 when there's no more byte in the source.  If C
 243    is 0 or positive, it unreads C, and the return value is not
 244    interesting.  */
 245 
 246 static int readbyte_for_lambda P_ ((int, Lisp_Object));
 247 static int readbyte_from_file P_ ((int, Lisp_Object));
 248 static int readbyte_from_string P_ ((int, Lisp_Object));
 249 
 250 /* Handle unreading and rereading of characters.
 251    Write READCHAR to read a character,
 252    UNREAD(c) to unread c to be read again.
 253 
 254    These macros correctly read/unread multibyte characters.  */
 255 
 256 #define READCHAR readchar (readcharfun, NULL)
 257 #define UNREAD(c) unreadchar (readcharfun, c)
 258 
 259 /* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source.  */
 260 #define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)
 261 
 262 /* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
 263    Qlambda, or a cons, we use this to keep an unread character because
 264    a file stream can't handle multibyte-char unreading.  The value -1
 265    means that there's no unread character. */
 266 static int unread_char;
 267 
 268 static int
 269 readchar (readcharfun, multibyte)
 270      Lisp_Object readcharfun;
 271      int *multibyte;
 272 {
 273   Lisp_Object tem;
 274   register int c;
 275   int (*readbyte) P_ ((int, Lisp_Object));
 276   unsigned char buf[MAX_MULTIBYTE_LENGTH];
 277   int i, len;
 278   int emacs_mule_encoding = 0;
 279 
 280   if (multibyte)
 281     *multibyte = 0;
 282 
 283   readchar_count++;
 284 
 285   if (BUFFERP (readcharfun))
 286     {
 287       register struct buffer *inbuffer = XBUFFER (readcharfun);
 288 
 289       int pt_byte = BUF_PT_BYTE (inbuffer);
 290 
 291       if (pt_byte >= BUF_ZV_BYTE (inbuffer))
 292         return -1;
 293 
 294       if (! NILP (inbuffer->enable_multibyte_characters))
 295         {
 296           /* Fetch the character code from the buffer.  */
 297           unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
 298           BUF_INC_POS (inbuffer, pt_byte);
 299           c = STRING_CHAR (p);
 300           if (multibyte)
 301             *multibyte = 1;
 302         }
 303       else
 304         {
 305           c = BUF_FETCH_BYTE (inbuffer, pt_byte);
 306           if (! ASCII_BYTE_P (c))
 307             c = BYTE8_TO_CHAR (c);
 308           pt_byte++;
 309         }
 310       SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
 311 
 312       return c;
 313     }
 314   if (MARKERP (readcharfun))
 315     {
 316       register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
 317 
 318       int bytepos = marker_byte_position (readcharfun);
 319 
 320       if (bytepos >= BUF_ZV_BYTE (inbuffer))
 321         return -1;
 322 
 323       if (! NILP (inbuffer->enable_multibyte_characters))
 324         {
 325           /* Fetch the character code from the buffer.  */
 326           unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
 327           BUF_INC_POS (inbuffer, bytepos);
 328           c = STRING_CHAR (p);
 329           if (multibyte)
 330             *multibyte = 1;
 331         }
 332       else
 333         {
 334           c = BUF_FETCH_BYTE (inbuffer, bytepos);
 335           if (! ASCII_BYTE_P (c))
 336             c = BYTE8_TO_CHAR (c);
 337           bytepos++;
 338         }
 339 
 340       XMARKER (readcharfun)->bytepos = bytepos;
 341       XMARKER (readcharfun)->charpos++;
 342 
 343       return c;
 344     }
 345 
 346   if (EQ (readcharfun, Qlambda))
 347     {
 348       readbyte = readbyte_for_lambda;
 349       goto read_multibyte;
 350     }
 351 
 352   if (EQ (readcharfun, Qget_file_char))
 353     {
 354       readbyte = readbyte_from_file;
 355       goto read_multibyte;
 356     }
 357 
 358   if (STRINGP (readcharfun))
 359     {
 360       if (read_from_string_index >= read_from_string_limit)
 361         c = -1;
 362       else if (STRING_MULTIBYTE (readcharfun))
 363         {
 364           if (multibyte)
 365             *multibyte = 1;
 366           FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun,
 367                                               read_from_string_index,
 368                                               read_from_string_index_byte);
 369         }
 370       else
 371         {
 372           c = SREF (readcharfun, read_from_string_index_byte);
 373           read_from_string_index++;
 374           read_from_string_index_byte++;
 375         }
 376       return c;
 377     }
 378 
 379   if (CONSP (readcharfun))
 380     {
 381       /* This is the case that read_vector is reading from a unibyte
 382          string that contains a byte sequence previously skipped
 383          because of #@NUMBER.  The car part of readcharfun is that
 384          string, and the cdr part is a value of readcharfun given to
 385          read_vector.  */
 386       readbyte = readbyte_from_string;
 387       if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
 388         emacs_mule_encoding = 1;
 389       goto read_multibyte;
 390     }
 391 
 392   if (EQ (readcharfun, Qget_emacs_mule_file_char))
 393     {
 394       readbyte = readbyte_from_file;
 395       emacs_mule_encoding = 1;
 396       goto read_multibyte;
 397     }
 398 
 399   tem = call0 (readcharfun);
 400 
 401   if (NILP (tem))
 402     return -1;
 403   return XINT (tem);
 404 
 405  read_multibyte:
 406   if (unread_char >= 0)
 407     {
 408       c = unread_char;
 409       unread_char = -1;
 410       return c;
 411     }
 412   c = (*readbyte) (-1, readcharfun);
 413   if (c < 0 || load_each_byte)
 414     return c;
 415   if (multibyte)
 416     *multibyte = 1;
 417   if (ASCII_BYTE_P (c))
 418     return c;
 419   if (emacs_mule_encoding)
 420     return read_emacs_mule_char (c, readbyte, readcharfun);
 421   i = 0;
 422   buf[i++] = c;
 423   len = BYTES_BY_CHAR_HEAD (c);
 424   while (i < len)
 425     {
 426       c = (*readbyte) (-1, readcharfun);
 427       if (c < 0 || ! TRAILING_CODE_P (c))
 428         {
 429           while (--i > 1)
 430             (*readbyte) (buf[i], readcharfun);
 431           return BYTE8_TO_CHAR (buf[0]);
 432         }
 433       buf[i++] = c;
 434     }
 435   return STRING_CHAR (buf);
 436 }
 437 
 438 /* Unread the character C in the way appropriate for the stream READCHARFUN.
 439    If the stream is a user function, call it with the char as argument.  */
 440 
 441 static void
 442 unreadchar (readcharfun, c)
 443      Lisp_Object readcharfun;
 444      int c;
 445 {
 446   readchar_count--;
 447   if (c == -1)
 448     /* Don't back up the pointer if we're unreading the end-of-input mark,
 449        since readchar didn't advance it when we read it.  */
 450     ;
 451   else if (BUFFERP (readcharfun))
 452     {
 453       struct buffer *b = XBUFFER (readcharfun);
 454       int bytepos = BUF_PT_BYTE (b);
 455 
 456       BUF_PT (b)--;
 457       if (! NILP (b->enable_multibyte_characters))
 458         BUF_DEC_POS (b, bytepos);
 459       else
 460         bytepos--;
 461 
 462       BUF_PT_BYTE (b) = bytepos;
 463     }
 464   else if (MARKERP (readcharfun))
 465     {
 466       struct buffer *b = XMARKER (readcharfun)->buffer;
 467       int bytepos = XMARKER (readcharfun)->bytepos;
 468 
 469       XMARKER (readcharfun)->charpos--;
 470       if (! NILP (b->enable_multibyte_characters))
 471         BUF_DEC_POS (b, bytepos);
 472       else
 473         bytepos--;
 474 
 475       XMARKER (readcharfun)->bytepos = bytepos;
 476     }
 477   else if (STRINGP (readcharfun))
 478     {
 479       read_from_string_index--;
 480       read_from_string_index_byte
 481         = string_char_to_byte (readcharfun, read_from_string_index);
 482     }
 483   else if (CONSP (readcharfun))
 484     {
 485       unread_char = c;
 486     }
 487   else if (EQ (readcharfun, Qlambda))
 488     {
 489       unread_char = c;
 490     }
 491   else if (EQ (readcharfun, Qget_file_char)
 492            || EQ (readcharfun, Qget_emacs_mule_file_char))
 493     {
 494       if (load_each_byte)
 495         {
 496           BLOCK_INPUT;
 497           ungetc (c, instream);
 498           UNBLOCK_INPUT;
 499         }
 500       else
 501         unread_char = c;
 502     }
 503   else
 504     call1 (readcharfun, make_number (c));
 505 }
 506 
 507 static int
 508 readbyte_for_lambda (c, readcharfun)
 509      int c;
 510      Lisp_Object readcharfun;
 511 {
 512   return read_bytecode_char (c >= 0);
 513 }
 514 
 515 
 516 static int
 517 readbyte_from_file (c, readcharfun)
 518      int c;
 519      Lisp_Object readcharfun;
 520 {
 521   if (c >= 0)
 522     {
 523       BLOCK_INPUT;
 524       ungetc (c, instream);
 525       UNBLOCK_INPUT;
 526       return 0;
 527     }
 528 
 529   BLOCK_INPUT;
 530   c = getc (instream);
 531 
 532 #ifdef EINTR
 533   /* Interrupted reads have been observed while reading over the network */
 534   while (c == EOF && ferror (instream) && errno == EINTR)
 535     {
 536       UNBLOCK_INPUT;
 537       QUIT;
 538       BLOCK_INPUT;
 539       clearerr (instream);
 540       c = getc (instream);
 541     }
 542 #endif
 543 
 544   UNBLOCK_INPUT;
 545 
 546   return (c == EOF ? -1 : c);
 547 }
 548 
 549 static int
 550 readbyte_from_string (c, readcharfun)
 551      int c;
 552      Lisp_Object readcharfun;
 553 {
 554   Lisp_Object string = XCAR (readcharfun);
 555 
 556   if (c >= 0)
 557     {
 558       read_from_string_index--;
 559       read_from_string_index_byte
 560         = string_char_to_byte (string, read_from_string_index);
 561     }
 562 
 563   if (read_from_string_index >= read_from_string_limit)
 564     c = -1;
 565   else
 566     FETCH_STRING_CHAR_ADVANCE (c, string,
 567                                read_from_string_index,
 568                                read_from_string_index_byte);
 569   return c;
 570 }
 571 
 572 
 573 /* Read one non-ASCII character from INSTREAM.  The character is
 574    encoded in `emacs-mule' and the first byte is already read in
 575    C.  */
 576 
 577 extern char emacs_mule_bytes[256];
 578 
 579 static int
 580 read_emacs_mule_char (c, readbyte, readcharfun)
 581      int c;
 582      int (*readbyte) P_ ((int, Lisp_Object));
 583      Lisp_Object readcharfun;
 584 {
 585   /* Emacs-mule coding uses at most 4-byte for one character.  */
 586   unsigned char buf[4];
 587   int len = emacs_mule_bytes[c];
 588   struct charset *charset;
 589   int i;
 590   unsigned code;
 591 
 592   if (len == 1)
 593     /* C is not a valid leading-code of `emacs-mule'.  */
 594     return BYTE8_TO_CHAR (c);
 595 
 596   i = 0;
 597   buf[i++] = c;
 598   while (i < len)
 599     {
 600       c = (*readbyte) (-1, readcharfun);
 601       if (c < 0xA0)
 602         {
 603           while (--i > 1)
 604             (*readbyte) (buf[i], readcharfun);
 605           return BYTE8_TO_CHAR (buf[0]);
 606         }
 607       buf[i++] = c;
 608     }
 609 
 610   if (len == 2)
 611     {
 612       charset = emacs_mule_charset[buf[0]];
 613       code = buf[1] & 0x7F;
 614     }
 615   else if (len == 3)
 616     {
 617       if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
 618           || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
 619         {
 620           charset = emacs_mule_charset[buf[1]];
 621           code = buf[2] & 0x7F;
 622         }
 623       else
 624         {
 625           charset = emacs_mule_charset[buf[0]];
 626           code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
 627         }
 628     }
 629   else
 630     {
 631       charset = emacs_mule_charset[buf[1]];
 632       code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
 633     }
 634   c = DECODE_CHAR (charset, code);
 635   if (c < 0)
 636     Fsignal (Qinvalid_read_syntax,
 637              Fcons (build_string ("invalid multibyte form"), Qnil));
 638   return c;
 639 }
 640 
 641 
 642 static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,
 643                                             Lisp_Object));
 644 static Lisp_Object read0 P_ ((Lisp_Object));
 645 static Lisp_Object read1 P_ ((Lisp_Object, int *, int));
 646 
 647 static Lisp_Object read_list P_ ((int, Lisp_Object));
 648 static Lisp_Object read_vector P_ ((Lisp_Object, int));
 649 
 650 static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object,
 651                                                   Lisp_Object));
 652 static void substitute_object_in_subtree P_ ((Lisp_Object,
 653                                               Lisp_Object));
 654 static void substitute_in_interval P_ ((INTERVAL, Lisp_Object));
 655 
 656 
 657 /* Get a character from the tty.  */
 658 
 659 /* Read input events until we get one that's acceptable for our purposes.
 660 
 661    If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
 662    until we get a character we like, and then stuffed into
 663    unread_switch_frame.
 664 
 665    If ASCII_REQUIRED is non-zero, we check function key events to see
 666    if the unmodified version of the symbol has a Qascii_character
 667    property, and use that character, if present.
 668 
 669    If ERROR_NONASCII is non-zero, we signal an error if the input we
 670    get isn't an ASCII character with modifiers.  If it's zero but
 671    ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
 672    character.
 673 
 674    If INPUT_METHOD is nonzero, we invoke the current input method
 675    if the character warrants that.
 676 
 677    If SECONDS is a number, we wait that many seconds for input, and
 678    return Qnil if no input arrives within that time.  */
 679 
 680 Lisp_Object
 681 read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
 682                      input_method, seconds)
 683      int no_switch_frame, ascii_required, error_nonascii, input_method;
 684      Lisp_Object seconds;
 685 {
 686   Lisp_Object val, delayed_switch_frame;
 687   EMACS_TIME end_time;
 688 
 689 #ifdef HAVE_WINDOW_SYSTEM
 690   if (display_hourglass_p)
 691     cancel_hourglass ();
 692 #endif
 693 
 694   delayed_switch_frame = Qnil;
 695 
 696   /* Compute timeout.  */
 697   if (NUMBERP (seconds))
 698     {
 699       EMACS_TIME wait_time;
 700       int sec, usec;
 701       double duration = extract_float (seconds);
 702 
 703       sec  = (int) duration;
 704       usec = (duration - sec) * 1000000;
 705       EMACS_GET_TIME (end_time);
 706       EMACS_SET_SECS_USECS (wait_time, sec, usec);
 707       EMACS_ADD_TIME (end_time, end_time, wait_time);
 708     }
 709 
 710 /* Read until we get an acceptable event.  */
 711  retry:
 712   do
 713     val = read_char (0, 0, 0, (input_method ? Qnil : Qt), 0,
 714                      NUMBERP (seconds) ? &end_time : NULL);
 715   while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */
 716 
 717   if (BUFFERP (val))
 718     goto retry;
 719 
 720   /* switch-frame events are put off until after the next ASCII
 721      character.  This is better than signaling an error just because
 722      the last characters were typed to a separate minibuffer frame,
 723      for example.  Eventually, some code which can deal with
 724      switch-frame events will read it and process it.  */
 725   if (no_switch_frame
 726       && EVENT_HAS_PARAMETERS (val)
 727       && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
 728     {
 729       delayed_switch_frame = val;
 730       goto retry;
 731     }
 732 
 733   if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
 734     {
 735       /* Convert certain symbols to their ASCII equivalents.  */
 736       if (SYMBOLP (val))
 737         {
 738           Lisp_Object tem, tem1;
 739           tem = Fget (val, Qevent_symbol_element_mask);
 740           if (!NILP (tem))
 741             {
 742               tem1 = Fget (Fcar (tem), Qascii_character);
 743               /* Merge this symbol's modifier bits
 744                  with the ASCII equivalent of its basic code.  */
 745               if (!NILP (tem1))
 746                 XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
 747             }
 748         }
 749 
 750       /* If we don't have a character now, deal with it appropriately.  */
 751       if (!INTEGERP (val))
 752         {
 753           if (error_nonascii)
 754             {
 755               Vunread_command_events = Fcons (val, Qnil);
 756               error ("Non-character input-event");
 757             }
 758           else
 759             goto retry;
 760         }
 761     }
 762 
 763   if (! NILP (delayed_switch_frame))
 764     unread_switch_frame = delayed_switch_frame;
 765 
 766 #if 0
 767 
 768 #ifdef HAVE_WINDOW_SYSTEM
 769   if (display_hourglass_p)
 770     start_hourglass ();
 771 #endif
 772 
 773 #endif
 774 
 775   return val;
 776 }
 777 
 778 DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
 779        doc: /* Read a character from the command input (keyboard or macro).
 780 It is returned as a number.
 781 If the character has modifiers, they are resolved and reflected to the
 782 character code if possible (e.g. C-SPC -> 0).
 783 
 784 If the user generates an event which is not a character (i.e. a mouse
 785 click or function key event), `read-char' signals an error.  As an
 786 exception, switch-frame events are put off until non-character events
 787 can be read.
 788 If you want to read non-character events, or ignore them, call
 789 `read-event' or `read-char-exclusive' instead.
 790 
 791 If the optional argument PROMPT is non-nil, display that as a prompt.
 792 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
 793 input method is turned on in the current buffer, that input method
 794 is used for reading a character.
 795 If the optional argument SECONDS is non-nil, it should be a number
 796 specifying the maximum number of seconds to wait for input.  If no
 797 input arrives in that time, return nil.  SECONDS may be a
 798 floating-point value.  */)
 799      (prompt, inherit_input_method, seconds)
 800      Lisp_Object prompt, inherit_input_method, seconds;
 801 {
 802   Lisp_Object val;
 803 
 804   if (! NILP (prompt))
 805     message_with_string ("%s", prompt, 0);
 806   val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
 807 
 808   return (NILP (val) ? Qnil
 809           : make_number (char_resolve_modifier_mask (XINT (val))));
 810 }
 811 
 812 DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
 813        doc: /* Read an event object from the input stream.
 814 If the optional argument PROMPT is non-nil, display that as a prompt.
 815 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
 816 input method is turned on in the current buffer, that input method
 817 is used for reading a character.
 818 If the optional argument SECONDS is non-nil, it should be a number
 819 specifying the maximum number of seconds to wait for input.  If no
 820 input arrives in that time, return nil.  SECONDS may be a
 821 floating-point value.  */)
 822      (prompt, inherit_input_method, seconds)
 823      Lisp_Object prompt, inherit_input_method, seconds;
 824 {
 825   if (! NILP (prompt))
 826     message_with_string ("%s", prompt, 0);
 827   return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
 828 }
 829 
 830 DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
 831        doc: /* Read a character from the command input (keyboard or macro).
 832 It is returned as a number.  Non-character events are ignored.
 833 If the character has modifiers, they are resolved and reflected to the
 834 character code if possible (e.g. C-SPC -> 0).
 835 
 836 If the optional argument PROMPT is non-nil, display that as a prompt.
 837 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
 838 input method is turned on in the current buffer, that input method
 839 is used for reading a character.
 840 If the optional argument SECONDS is non-nil, it should be a number
 841 specifying the maximum number of seconds to wait for input.  If no
 842 input arrives in that time, return nil.  SECONDS may be a
 843 floating-point value.  */)
 844      (prompt, inherit_input_method, seconds)
 845      Lisp_Object prompt, inherit_input_method, seconds;
 846 {
 847   Lisp_Object val;
 848 
 849   if (! NILP (prompt))
 850     message_with_string ("%s", prompt, 0);
 851 
 852   val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
 853 
 854   return (NILP (val) ? Qnil
 855           : make_number (char_resolve_modifier_mask (XINT (val))));
 856 }
 857 
 858 DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
 859        doc: /* Don't use this yourself.  */)
 860      ()
 861 {
 862   register Lisp_Object val;
 863   BLOCK_INPUT;
 864   XSETINT (val, getc (instream));
 865   UNBLOCK_INPUT;
 866   return val;
 867 }
 868 
 869 
 870 
 871 /* Value is a version number of byte compiled code if the file
 872    associated with file descriptor FD is a compiled Lisp file that's
 873    safe to load.  Only files compiled with Emacs are safe to load.
 874    Files compiled with XEmacs can lead to a crash in Fbyte_code
 875    because of an incompatible change in the byte compiler.  */
 876 
 877 static int
 878 safe_to_load_p (fd)
 879      int fd;
 880 {
 881   char buf[512];
 882   int nbytes, i;
 883   int safe_p = 1;
 884   int version = 1;
 885 
 886   /* Read the first few bytes from the file, and look for a line
 887      specifying the byte compiler version used.  */
 888   nbytes = emacs_read (fd, buf, sizeof buf - 1);
 889   if (nbytes > 0)
 890     {
 891       buf[nbytes] = '\0';
 892 
 893       /* Skip to the next newline, skipping over the initial `ELC'
 894          with NUL bytes following it, but note the version.  */
 895       for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
 896         if (i == 4)
 897           version = buf[i];
 898 
 899       if (i == nbytes
 900           || fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
 901                                               buf + i) < 0)
 902         safe_p = 0;
 903     }
 904   if (safe_p)
 905     safe_p = version;
 906 
 907   lseek (fd, 0, SEEK_SET);
 908   return safe_p;
 909 }
 910 
 911 
 912 /* Callback for record_unwind_protect.  Restore the old load list OLD,
 913    after loading a file successfully.  */
 914 
 915 static Lisp_Object
 916 record_load_unwind (old)
 917      Lisp_Object old;
 918 {
 919   return Vloads_in_progress = old;
 920 }
 921 
 922 /* This handler function is used via internal_condition_case_1.  */
 923 
 924 static Lisp_Object
 925 load_error_handler (data)
 926      Lisp_Object data;
 927 {
 928   return Qnil;
 929 }
 930 
 931 static Lisp_Object
 932 load_warn_old_style_backquotes (file)
 933      Lisp_Object file;
 934 {
 935   if (!NILP (Vold_style_backquotes))
 936     {
 937       Lisp_Object args[2];
 938       args[0] = build_string ("Loading `%s': old-style backquotes detected!");
 939       args[1] = file;
 940       Fmessage (2, args);
 941     }
 942   return Qnil;
 943 }
 944 
 945 DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
 946        doc: /* Return the suffixes that `load' should try if a suffix is \
 947 required.
 948 This uses the variables `load-suffixes' and `load-file-rep-suffixes'.  */)
 949      ()
 950 {
 951   Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext;
 952   while (CONSP (suffixes))
 953     {
 954       Lisp_Object exts = Vload_file_rep_suffixes;
 955       suffix = XCAR (suffixes);
 956       suffixes = XCDR (suffixes);
 957       while (CONSP (exts))
 958         {
 959           ext = XCAR (exts);
 960           exts = XCDR (exts);
 961           lst = Fcons (concat2 (suffix, ext), lst);
 962         }
 963     }
 964   return Fnreverse (lst);
 965 }
 966 
 967 DEFUN ("load", Fload, Sload, 1, 5, 0,
 968        doc: /* Execute a file of Lisp code named FILE.
 969 First try FILE with `.elc' appended, then try with `.el',
 970 then try FILE unmodified (the exact suffixes in the exact order are
 971 determined by `load-suffixes').  Environment variable references in
 972 FILE are replaced with their values by calling `substitute-in-file-name'.
 973 This function searches the directories in `load-path'.
 974 
 975 If optional second arg NOERROR is non-nil,
 976 report no error if FILE doesn't exist.
 977 Print messages at start and end of loading unless
 978 optional third arg NOMESSAGE is non-nil (but `force-load-messages'
 979 overrides that).
 980 If optional fourth arg NOSUFFIX is non-nil, don't try adding
 981 suffixes `.elc' or `.el' to the specified name FILE.
 982 If optional fifth arg MUST-SUFFIX is non-nil, insist on
 983 the suffix `.elc' or `.el'; don't accept just FILE unless
 984 it ends in one of those suffixes or includes a directory name.
 985 
 986 If this function fails to find a file, it may look for different
 987 representations of that file before trying another file.
 988 It does so by adding the non-empty suffixes in `load-file-rep-suffixes'
 989 to the file name.  Emacs uses this feature mainly to find compressed
 990 versions of files when Auto Compression mode is enabled.
 991 
 992 The exact suffixes that this function tries out, in the exact order,
 993 are given by the value of the variable `load-file-rep-suffixes' if
 994 NOSUFFIX is non-nil and by the return value of the function
 995 `get-load-suffixes' if MUST-SUFFIX is non-nil.  If both NOSUFFIX and
 996 MUST-SUFFIX are nil, this function first tries out the latter suffixes
 997 and then the former.
 998 
 999 Loading a file records its definitions, and its `provide' and
1000 `require' calls, in an element of `load-history' whose
1001 car is the file name loaded.  See `load-history'.
1002 
1003 Return t if the file exists and loads successfully.  */)
1004      (file, noerror, nomessage, nosuffix, must_suffix)
1005      Lisp_Object file, noerror, nomessage, nosuffix, must_suffix;
1006 {
1007   register FILE *stream;
1008   register int fd = -1;
1009   int count = SPECPDL_INDEX ();
1010   struct gcpro gcpro1, gcpro2, gcpro3;
1011   Lisp_Object found, efound, hist_file_name;
1012   /* 1 means we printed the ".el is newer" message.  */
1013   int newer = 0;
1014   /* 1 means we are loading a compiled file.  */
1015   int compiled = 0;
1016   Lisp_Object handler;
1017   int safe_p = 1;
1018   char *fmode = "r";
1019   Lisp_Object tmp[2];
1020   int version;
1021 
1022 #ifdef DOS_NT
1023   fmode = "rt";
1024 #endif /* DOS_NT */
1025 
1026   CHECK_STRING (file);
1027 
1028   /* If file name is magic, call the handler.  */
1029   /* This shouldn't be necessary any more now that `openp' handles it right.
1030     handler = Ffind_file_name_handler (file, Qload);
1031     if (!NILP (handler))
1032       return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
1033 
1034   /* Do this after the handler to avoid
1035      the need to gcpro noerror, nomessage and nosuffix.
1036      (Below here, we care only whether they are nil or not.)
1037      The presence of this call is the result of a historical accident:
1038      it used to be in every file-operation and when it got removed
1039      everywhere, it accidentally stayed here.  Since then, enough people
1040      supposedly have things like (load "$PROJECT/foo.el") in their .emacs
1041      that it seemed risky to remove.  */
1042   if (! NILP (noerror))
1043     {
1044       file = internal_condition_case_1 (Fsubstitute_in_file_name, file,
1045                                         Qt, load_error_handler);
1046       if (NILP (file))
1047         return Qnil;
1048     }
1049   else
1050     file = Fsubstitute_in_file_name (file);
1051 
1052 
1053   /* Avoid weird lossage with null string as arg,
1054      since it would try to load a directory as a Lisp file */
1055   if (SCHARS (file) > 0)
1056     {
1057       int size = SBYTES (file);
1058 
1059       found = Qnil;
1060       GCPRO2 (file, found);
1061 
1062       if (! NILP (must_suffix))
1063         {
1064           /* Don't insist on adding a suffix if FILE already ends with one.  */
1065           if (size > 3
1066               && !strcmp (SDATA (file) + size - 3, ".el"))
1067             must_suffix = Qnil;
1068           else if (size > 4
1069                    && !strcmp (SDATA (file) + size - 4, ".elc"))
1070             must_suffix = Qnil;
1071           /* Don't insist on adding a suffix
1072              if the argument includes a directory name.  */
1073           else if (! NILP (Ffile_name_directory (file)))
1074             must_suffix = Qnil;
1075         }
1076 
1077       fd = openp (Vload_path, file,
1078                   (!NILP (nosuffix) ? Qnil
1079                    : !NILP (must_suffix) ? Fget_load_suffixes ()
1080                    : Fappend (2, (tmp[0] = Fget_load_suffixes (),
1081                                   tmp[1] = Vload_file_rep_suffixes,
1082                                   tmp))),
1083                   &found, Qnil);
1084       UNGCPRO;
1085     }
1086 
1087   if (fd == -1)
1088     {
1089       if (NILP (noerror))
1090         xsignal2 (Qfile_error, build_string ("Cannot open load file"), file);
1091       return Qnil;
1092     }
1093 
1094   /* Tell startup.el whether or not we found the user's init file.  */
1095   if (EQ (Qt, Vuser_init_file))
1096     Vuser_init_file = found;
1097 
1098   /* If FD is -2, that means openp found a magic file.  */
1099   if (fd == -2)
1100     {
1101       if (NILP (Fequal (found, file)))
1102         /* If FOUND is a different file name from FILE,
1103            find its handler even if we have already inhibited
1104            the `load' operation on FILE.  */
1105         handler = Ffind_file_name_handler (found, Qt);
1106       else
1107         handler = Ffind_file_name_handler (found, Qload);
1108       if (! NILP (handler))
1109         return call5 (handler, Qload, found, noerror, nomessage, Qt);
1110     }
1111 
1112   /* Check if we're stuck in a recursive load cycle.
1113 
1114      2000-09-21: It's not possible to just check for the file loaded
1115      being a member of Vloads_in_progress.  This fails because of the
1116      way the byte compiler currently works; `provide's are not
1117      evaluated, see font-lock.el/jit-lock.el as an example.  This
1118      leads to a certain amount of ``normal'' recursion.
1119 
1120      Also, just loading a file recursively is not always an error in
1121      the general case; the second load may do something different.  */
1122   {
1123     int count = 0;
1124     Lisp_Object tem;
1125     for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
1126       if (!NILP (Fequal (found, XCAR (tem))) && (++count > 3))
1127         {
1128           if (fd >= 0)
1129             emacs_close (fd);
1130           signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
1131         }
1132     record_unwind_protect (record_load_unwind, Vloads_in_progress);
1133     Vloads_in_progress = Fcons (found, Vloads_in_progress);
1134   }
1135 
1136   /* Get the name for load-history. */
1137   hist_file_name = (! NILP (Vpurify_flag)
1138                     ? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
1139                                    tmp[1] = Ffile_name_nondirectory (found),
1140                                    tmp))
1141                     : found) ;
1142 
1143   version = -1;
1144 
1145   /* Check for the presence of old-style quotes and warn about them.  */
1146   specbind (Qold_style_backquotes, Qnil);
1147   record_unwind_protect (load_warn_old_style_backquotes, file);
1148 
1149   if (!bcmp (SDATA (found) + SBYTES (found) - 4,
1150              ".elc", 4)
1151       || (fd >= 0 && (version = safe_to_load_p (fd)) > 0))
1152     /* Load .elc files directly, but not when they are
1153        remote and have no handler!  */
1154     {
1155       if (fd != -2)
1156         {
1157           struct stat s1, s2;
1158           int result;
1159 
1160           GCPRO3 (file, found, hist_file_name);
1161 
1162           if (version < 0
1163               && ! (version = safe_to_load_p (fd)))
1164             {
1165               safe_p = 0;
1166               if (!load_dangerous_libraries)
1167                 {
1168                   if (fd >= 0)
1169                     emacs_close (fd);
1170                   error ("File `%s' was not compiled in Emacs",
1171                          SDATA (found));
1172                 }
1173               else if (!NILP (nomessage) && !force_load_messages)
1174                 message_with_string ("File `%s' not compiled in Emacs", found, 1);
1175             }
1176 
1177           compiled = 1;
1178 
1179           efound = ENCODE_FILE (found);
1180 
1181 #ifdef DOS_NT
1182           fmode = "rb";
1183 #endif /* DOS_NT */
1184           stat ((char *)SDATA (efound), &s1);
1185           SSET (efound, SBYTES (efound) - 1, 0);
1186           result = stat ((char *)SDATA (efound), &s2);
1187           SSET (efound, SBYTES (efound) - 1, 'c');
1188 
1189           if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
1190             {
1191               /* Make the progress messages mention that source is newer.  */
1192               newer = 1;
1193 
1194               /* If we won't print another message, mention this anyway.  */
1195               if (!NILP (nomessage) && !force_load_messages)
1196                 {
1197                   Lisp_Object msg_file;
1198                   msg_file = Fsubstring (found, make_number (0), make_number (-1));
1199                   message_with_string ("Source file `%s' newer than byte-compiled file",
1200                                        msg_file, 1);
1201                 }
1202             }
1203           UNGCPRO;
1204         }
1205     }
1206   else
1207     {
1208       /* We are loading a source file (*.el).  */
1209       if (!NILP (Vload_source_file_function))
1210         {
1211           Lisp_Object val;
1212 
1213           if (fd >= 0)
1214             emacs_close (fd);
1215           val = call4 (Vload_source_file_function, found, hist_file_name,
1216                        NILP (noerror) ? Qnil : Qt,
1217                        (NILP (nomessage) || force_load_messages) ? Qnil : Qt);
1218           return unbind_to (count, val);
1219         }
1220     }
1221 
1222   GCPRO3 (file, found, hist_file_name);
1223 
1224 #ifdef WINDOWSNT
1225   emacs_close (fd);
1226   efound = ENCODE_FILE (found);
1227   stream = fopen ((char *) SDATA (efound), fmode);
1228 #else  /* not WINDOWSNT */
1229   stream = fdopen (fd, fmode);
1230 #endif /* not WINDOWSNT */
1231   if (stream == 0)
1232     {
1233       emacs_close (fd);
1234       error ("Failure to create stdio stream for %s", SDATA (file));
1235     }
1236 
1237   if (! NILP (Vpurify_flag))
1238     Vpreloaded_file_list = Fcons (Fpurecopy(file), Vpreloaded_file_list);
1239 
1240   if (NILP (nomessage) || force_load_messages)
1241     {
1242       if (!safe_p)
1243         message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
1244                  file, 1);
1245       else if (!compiled)
1246         message_with_string ("Loading %s (source)...", file, 1);
1247       else if (newer)
1248         message_with_string ("Loading %s (compiled; note, source file is newer)...",
1249                  file, 1);
1250       else /* The typical case; compiled file newer than source file.  */
1251         message_with_string ("Loading %s...", file, 1);
1252     }
1253 
1254   record_unwind_protect (load_unwind, make_save_value (stream, 0));
1255   record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
1256   specbind (Qload_file_name, found);
1257   specbind (Qinhibit_file_name_operation, Qnil);
1258   load_descriptor_list
1259     = Fcons (make_number (fileno (stream)), load_descriptor_list);
1260   specbind (Qload_in_progress, Qt);
1261   if (! version || version >= 22)
1262     readevalloop (Qget_file_char, stream, hist_file_name,
1263                   Feval, 0, Qnil, Qnil, Qnil, Qnil);
1264   else
1265     {
1266       /* We can't handle a file which was compiled with
1267          byte-compile-dynamic by older version of Emacs.  */
1268       specbind (Qload_force_doc_strings, Qt);
1269       readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, Feval,
1270                     0, Qnil, Qnil, Qnil, Qnil);
1271     }
1272   unbind_to (count, Qnil);
1273 
1274   /* Run any eval-after-load forms for this file */
1275   if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
1276     call1 (Qdo_after_load_evaluation, hist_file_name) ;
1277 
1278   UNGCPRO;
1279 
1280   xfree (saved_doc_string);
1281   saved_doc_string = 0;
1282   saved_doc_string_size = 0;
1283 
1284   xfree (prev_saved_doc_string);
1285   prev_saved_doc_string = 0;
1286   prev_saved_doc_string_size = 0;
1287 
1288   if (!noninteractive && (NILP (nomessage) || force_load_messages))
1289     {
1290       if (!safe_p)
1291         message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
1292                  file, 1);
1293       else if (!compiled)
1294         message_with_string ("Loading %s (source)...done", file, 1);
1295       else if (newer)
1296         message_with_string ("Loading %s (compiled; note, source file is newer)...done",
1297                  file, 1);
1298       else /* The typical case; compiled file newer than source file.  */
1299         message_with_string ("Loading %s...done", file, 1);
1300     }
1301 
1302   return Qt;
1303 }
1304 
1305 static Lisp_Object
1306 load_unwind (arg)  /* used as unwind-protect function in load */
1307      Lisp_Object arg;
1308 {
1309   FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
1310   if (stream != NULL)
1311     {
1312       BLOCK_INPUT;
1313       fclose (stream);
1314       UNBLOCK_INPUT;
1315     }
1316   return Qnil;
1317 }
1318 
1319 static Lisp_Object
1320 load_descriptor_unwind (oldlist)
1321      Lisp_Object oldlist;
1322 {
1323   load_descriptor_list = oldlist;
1324   return Qnil;
1325 }
1326 
1327 /* Close all descriptors in use for Floads.
1328    This is used when starting a subprocess.  */
1329 
1330 void
1331 close_load_descs ()
1332 {
1333 #ifndef WINDOWSNT
1334   Lisp_Object tail;
1335   for (tail = load_descriptor_list; CONSP (tail); tail = XCDR (tail))
1336     emacs_close (XFASTINT (XCAR (tail)));
1337 #endif
1338 }
1339 
1340 static int
1341 complete_filename_p (pathname)
1342      Lisp_Object pathname;
1343 {
1344   register const unsigned char *s = SDATA (pathname);
1345   return (IS_DIRECTORY_SEP (s[0])
1346           || (SCHARS (pathname) > 2
1347               && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2])));
1348 }
1349 
1350 DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
1351        doc: /* Search for FILENAME through PATH.
1352 Returns the file's name in absolute form, or nil if not found.
1353 If SUFFIXES is non-nil, it should be a list of suffixes to append to
1354 file name when searching.
1355 If non-nil, PREDICATE is used instead of `file-readable-p'.
1356 PREDICATE can also be an integer to pass to the access(2) function,
1357 in which case file-name-handlers are ignored.  */)
1358      (filename, path, suffixes, predicate)
1359      Lisp_Object filename, path, suffixes, predicate;
1360 {
1361   Lisp_Object file;
1362   int fd = openp (path, filename, suffixes, &file, predicate);
1363   if (NILP (predicate) && fd > 0)
1364     close (fd);
1365   return file;
1366 }
1367 
1368 
1369 /* Search for a file whose name is STR, looking in directories
1370    in the Lisp list PATH, and trying suffixes from SUFFIX.
1371    On success, returns a file descriptor.  On failure, returns -1.
1372 
1373    SUFFIXES is a list of strings containing possible suffixes.
1374    The empty suffix is automatically added if the list is empty.
1375 
1376    PREDICATE non-nil means don't open the files,
1377    just look for one that satisfies the predicate.  In this case,
1378    returns 1 on success.  The predicate can be a lisp function or
1379    an integer to pass to `access' (in which case file-name-handlers
1380    are ignored).
1381 
1382    If STOREPTR is nonzero, it points to a slot where the name of
1383    the file actually found should be stored as a Lisp string.
1384    nil is stored there on failure.
1385 
1386    If the file we find is remote, return -2
1387    but store the found remote file name in *STOREPTR.  */
1388 
1389 int
1390 openp (path, str, suffixes, storeptr, predicate)
1391      Lisp_Object path, str;
1392      Lisp_Object suffixes;
1393      Lisp_Object *storeptr;
1394      Lisp_Object predicate;
1395 {
1396   register int fd;
1397   int fn_size = 100;
1398   char buf[100];
1399   register char *fn = buf;
1400   int absolute = 0;
1401   int want_size;
1402   Lisp_Object filename;
1403   struct stat st;
1404   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1405   Lisp_Object string, tail, encoded_fn;
1406   int max_suffix_len = 0;
1407 
1408   CHECK_STRING (str);
1409 
1410   for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
1411     {
1412       CHECK_STRING_CAR (tail);
1413       max_suffix_len = max (max_suffix_len,
1414                             SBYTES (XCAR (tail)));
1415     }
1416 
1417   string = filename = encoded_fn = Qnil;
1418   GCPRO6 (str, string, filename, path, suffixes, encoded_fn);
1419 
1420   if (storeptr)
1421     *storeptr = Qnil;
1422 
1423   if (complete_filename_p (str))
1424     absolute = 1;
1425 
1426   for (; CONSP (path); path = XCDR (path))
1427     {
1428       filename = Fexpand_file_name (str, XCAR (path));
1429       if (!complete_filename_p (filename))
1430         /* If there are non-absolute elts in PATH (eg ".") */
1431         /* Of course, this could conceivably lose if luser sets
1432            default-directory to be something non-absolute... */
1433         {
1434           filename = Fexpand_file_name (filename, current_buffer->directory);
1435           if (!complete_filename_p (filename))
1436             /* Give up on this path element! */
1437             continue;
1438         }
1439 
1440       /* Calculate maximum size of any filename made from
1441          this path element/specified file name and any possible suffix.  */
1442       want_size = max_suffix_len + SBYTES (filename) + 1;
1443       if (fn_size < want_size)
1444         fn = (char *) alloca (fn_size = 100 + want_size);
1445 
1446       /* Loop over suffixes.  */
1447       for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes;
1448            CONSP (tail); tail = XCDR (tail))
1449         {
1450           int lsuffix = SBYTES (XCAR (tail));
1451           Lisp_Object handler;
1452           int exists;
1453 
1454           /* Concatenate path element/specified name with the suffix.
1455              If the directory starts with /:, remove that.  */
1456           if (SCHARS (filename) > 2
1457               && SREF (filename, 0) == '/'
1458               && SREF (filename, 1) == ':')
1459             {
1460               strncpy (fn, SDATA (filename) + 2,
1461                        SBYTES (filename) - 2);
1462               fn[SBYTES (filename) - 2] = 0;
1463             }
1464           else
1465             {
1466               strncpy (fn, SDATA (filename),
1467                        SBYTES (filename));
1468               fn[SBYTES (filename)] = 0;
1469             }
1470 
1471           if (lsuffix != 0)  /* Bug happens on CCI if lsuffix is 0.  */
1472             strncat (fn, SDATA (XCAR (tail)), lsuffix);
1473 
1474           /* Check that the file exists and is not a directory.  */
1475           /* We used to only check for handlers on non-absolute file names:
1476                 if (absolute)
1477                   handler = Qnil;
1478                 else
1479                   handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1480              It's not clear why that was the case and it breaks things like
1481              (load "/bar.el") where the file is actually "/bar.el.gz".  */
1482           string = build_string (fn);
1483           handler = Ffind_file_name_handler (string, Qfile_exists_p);
1484           if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
1485             {
1486               if (NILP (predicate))
1487                 exists = !NILP (Ffile_readable_p (string));
1488               else
1489                 exists = !NILP (call1 (predicate, string));
1490               if (exists && !NILP (Ffile_directory_p (string)))
1491                 exists = 0;
1492 
1493               if (exists)
1494                 {
1495                   /* We succeeded; return this descriptor and filename.  */
1496                   if (storeptr)
1497                     *storeptr = string;
1498                   UNGCPRO;
1499                   return -2;
1500                 }
1501             }
1502           else
1503             {
1504               const char *pfn;
1505 
1506               encoded_fn = ENCODE_FILE (string);
1507               pfn = SDATA (encoded_fn);
1508               exists = (stat (pfn, &st) >= 0
1509                         && (st.st_mode & S_IFMT) != S_IFDIR);
1510               if (exists)
1511                 {
1512                   /* Check that we can access or open it.  */
1513                   if (NATNUMP (predicate))
1514                     fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
1515                   else
1516                     fd = emacs_open (pfn, O_RDONLY, 0);
1517 
1518                   if (fd >= 0)
1519                     {
1520                       /* We succeeded; return this descriptor and filename.  */
1521                       if (storeptr)
1522                         *storeptr = string;
1523                       UNGCPRO;
1524                       return fd;
1525                     }
1526                 }
1527             }
1528         }
1529       if (absolute)
1530         break;
1531     }
1532 
1533   UNGCPRO;
1534   return -1;
1535 }
1536 
1537 
1538 /* Merge the list we've accumulated of globals from the current input source
1539    into the load_history variable.  The details depend on whether
1540    the source has an associated file name or not.
1541 
1542    FILENAME is the file name that we are loading from.
1543    ENTIRE is 1 if loading that entire file, 0 if evaluating part of it.  */
1544 
1545 static void
1546 build_load_history (filename, entire)
1547      Lisp_Object filename;
1548      int entire;
1549 {
1550   register Lisp_Object tail, prev, newelt;
1551   register Lisp_Object tem, tem2;
1552   register int foundit = 0;
1553 
1554   tail = Vload_history;
1555   prev = Qnil;
1556 
1557   while (CONSP (tail))
1558     {
1559       tem = XCAR (tail);
1560 
1561       /* Find the feature's previous assoc list... */
1562       if (!NILP (Fequal (filename, Fcar (tem))))
1563         {
1564           foundit = 1;
1565 
1566           /*  If we're loading the entire file, remove old data. */
1567           if (entire)
1568             {
1569               if (NILP (prev))
1570                 Vload_history = XCDR (tail);
1571               else
1572                 Fsetcdr (prev, XCDR (tail));
1573             }
1574 
1575           /*  Otherwise, cons on new symbols that are not already members.  */
1576           else
1577             {
1578               tem2 = Vcurrent_load_list;
1579 
1580               while (CONSP (tem2))
1581                 {
1582                   newelt = XCAR (tem2);
1583 
1584                   if (NILP (Fmember (newelt, tem)))
1585                     Fsetcar (tail, Fcons (XCAR (tem),
1586                                           Fcons (newelt, XCDR (tem))));
1587 
1588                   tem2 = XCDR (tem2);
1589                   QUIT;
1590                 }
1591             }
1592         }
1593       else
1594         prev = tail;
1595       tail = XCDR (tail);
1596       QUIT;
1597     }
1598 
1599   /* If we're loading an entire file, cons the new assoc onto the
1600      front of load-history, the most-recently-loaded position.  Also
1601      do this if we didn't find an existing member for the file.  */
1602   if (entire || !foundit)
1603     Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
1604                            Vload_history);
1605 }
1606 
1607 Lisp_Object
1608 unreadpure (junk) /* Used as unwind-protect function in readevalloop */
1609      Lisp_Object junk;
1610 {
1611   read_pure = 0;
1612   return Qnil;
1613 }
1614 
1615 static Lisp_Object
1616 readevalloop_1 (old)
1617      Lisp_Object old;
1618 {
1619   load_convert_to_unibyte = ! NILP (old);
1620   return Qnil;
1621 }
1622 
1623 /* Signal an `end-of-file' error, if possible with file name
1624    information.  */
1625 
1626 static void
1627 end_of_file_error ()
1628 {
1629   if (STRINGP (Vload_file_name))
1630     xsignal1 (Qend_of_file, Vload_file_name);
1631 
1632   xsignal0 (Qend_of_file);
1633 }
1634 
1635 /* UNIBYTE specifies how to set load_convert_to_unibyte
1636    for this invocation.
1637    READFUN, if non-nil, is used instead of `read'.
1638 
1639    START, END specify region to read in current buffer (from eval-region).
1640    If the input is not from a buffer, they must be nil.  */
1641 
1642 static void
1643 readevalloop (readcharfun, stream, sourcename, evalfun,
1644               printflag, unibyte, readfun, start, end)
1645      Lisp_Object readcharfun;
1646      FILE *stream;
1647      Lisp_Object sourcename;
1648      Lisp_Object (*evalfun) ();
1649      int printflag;
1650      Lisp_Object unibyte, readfun;
1651      Lisp_Object start, end;
1652 {
1653   register int c;
1654   register Lisp_Object val;
1655   int count = SPECPDL_INDEX ();
1656   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1657   struct buffer *b = 0;
1658   int continue_reading_p;
1659   /* Nonzero if reading an entire buffer.  */
1660   int whole_buffer = 0;
1661   /* 1 on the first time around.  */
1662   int first_sexp = 1;
1663 
1664   if (MARKERP (readcharfun))
1665     {
1666       if (NILP (start))
1667         start = readcharfun;
1668     }
1669 
1670   if (BUFFERP (readcharfun))
1671     b = XBUFFER (readcharfun);
1672   else if (MARKERP (readcharfun))
1673     b = XMARKER (readcharfun)->buffer;
1674 
1675   /* We assume START is nil when input is not from a buffer.  */
1676   if (! NILP (start) && !b)
1677     abort ();
1678 
1679   specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun.  */
1680   specbind (Qcurrent_load_list, Qnil);
1681   record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
1682   load_convert_to_unibyte = !NILP (unibyte);
1683 
1684   GCPRO4 (sourcename, readfun, start, end);
1685 
1686   /* Try to ensure sourcename is a truename, except whilst preloading. */
1687   if (NILP (Vpurify_flag)
1688       && !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))
1689       && !NILP (Ffboundp (Qfile_truename)))
1690     sourcename = call1 (Qfile_truename, sourcename) ;
1691 
1692   LOADHIST_ATTACH (sourcename);
1693 
1694   continue_reading_p = 1;
1695   while (continue_reading_p)
1696     {
1697       int count1 = SPECPDL_INDEX ();
1698 
1699       if (b != 0 && NILP (b->name))
1700         error ("Reading from killed buffer");
1701 
1702       if (!NILP (start))
1703         {
1704           /* Switch to the buffer we are reading from.  */
1705           record_unwind_protect (save_excursion_restore, save_excursion_save ());
1706           set_buffer_internal (b);
1707 
1708           /* Save point in it.  */
1709           record_unwind_protect (save_excursion_restore, save_excursion_save ());
1710           /* Save ZV in it.  */
1711           record_unwind_protect (save_restriction_restore, save_restriction_save ());
1712           /* Those get unbound after we read one expression.  */
1713 
1714           /* Set point and ZV around stuff to be read.  */
1715           Fgoto_char (start);
1716           if (!NILP (end))
1717             Fnarrow_to_region (make_number (BEGV), end);
1718 
1719           /* Just for cleanliness, convert END to a marker
1720              if it is an integer.  */
1721           if (INTEGERP (end))
1722             end = Fpoint_max_marker ();
1723         }
1724 
1725       /* On the first cycle, we can easily test here
1726          whether we are reading the whole buffer.  */
1727       if (b && first_sexp)
1728         whole_buffer = (PT == BEG && ZV == Z);
1729 
1730       instream = stream;
1731     read_next:
1732       c = READCHAR;
1733       if (c == ';')
1734         {
1735           while ((c = READCHAR) != '\n' && c != -1);
1736           goto read_next;
1737         }
1738       if (c < 0)
1739         {
1740           unbind_to (count1, Qnil);
1741           break;
1742         }
1743 
1744       /* Ignore whitespace here, so we can detect eof.  */
1745       if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r'
1746           || c == 0x8a0)  /* NBSP */
1747         goto read_next;
1748 
1749       if (!NILP (Vpurify_flag) && c == '(')
1750         {
1751           record_unwind_protect (unreadpure, Qnil);
1752           val = read_list (-1, readcharfun);
1753         }
1754       else
1755         {
1756           UNREAD (c);
1757           read_objects = Qnil;
1758           if (!NILP (readfun))
1759             {
1760               val = call1 (readfun, readcharfun);
1761 
1762               /* If READCHARFUN has set point to ZV, we should
1763                  stop reading, even if the form read sets point
1764                  to a different value when evaluated.  */
1765               if (BUFFERP (readcharfun))
1766                 {
1767                   struct buffer *b = XBUFFER (readcharfun);
1768                   if (BUF_PT (b) == BUF_ZV (b))
1769                     continue_reading_p = 0;
1770                 }
1771             }
1772           else if (! NILP (Vload_read_function))
1773             val = call1 (Vload_read_function, readcharfun);
1774           else
1775             val = read_internal_start (readcharfun, Qnil, Qnil);
1776         }
1777 
1778       if (!NILP (start) && continue_reading_p)
1779         start = Fpoint_marker ();
1780 
1781       /* Restore saved point and BEGV.  */
1782       unbind_to (count1, Qnil);
1783 
1784       /* Now eval what we just read.  */
1785       val = (*evalfun) (val);
1786 
1787       if (printflag)
1788         {
1789           Vvalues = Fcons (val, Vvalues);
1790           if (EQ (Vstandard_output, Qt))
1791             Fprin1 (val, Qnil);
1792           else
1793             Fprint (val, Qnil);
1794         }
1795 
1796       first_sexp = 0;
1797     }
1798 
1799   build_load_history (sourcename,
1800                       stream || whole_buffer);
1801 
1802   UNGCPRO;
1803 
1804   unbind_to (count, Qnil);
1805 }
1806 
1807 DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
1808        doc: /* Execute the current buffer as Lisp code.
1809 When called from a Lisp program (i.e., not interactively), this
1810 function accepts up to five optional arguments:
1811 BUFFER is the buffer to evaluate (nil means use current buffer).
1812 PRINTFLAG controls printing of output:
1813  A value of nil means discard it; anything else is stream for print.
1814 FILENAME specifies the file name to use for `load-history'.
1815 UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
1816  invocation.
1817 DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
1818  functions should work normally even if PRINTFLAG is nil.
1819 
1820 This function preserves the position of point.  */)
1821      (buffer, printflag, filename, unibyte, do_allow_print)
1822      Lisp_Object buffer, printflag, filename, unibyte, do_allow_print;
1823 {
1824   int count = SPECPDL_INDEX ();
1825   Lisp_Object tem, buf;
1826 
1827   if (NILP (buffer))
1828     buf = Fcurrent_buffer ();
1829   else
1830     buf = Fget_buffer (buffer);
1831   if (NILP (buf))
1832     error ("No such buffer");
1833 
1834   if (NILP (printflag) && NILP (do_allow_print))
1835     tem = Qsymbolp;
1836   else
1837     tem = printflag;
1838 
1839   if (NILP (filename))
1840     filename = XBUFFER (buf)->filename;
1841 
1842   specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
1843   specbind (Qstandard_output, tem);
1844   record_unwind_protect (save_excursion_restore, save_excursion_save ());
1845   BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
1846   readevalloop (buf, 0, filename, Feval,
1847                 !NILP (printflag), unibyte, Qnil, Qnil, Qnil);
1848   unbind_to (count, Qnil);
1849 
1850   return Qnil;
1851 }
1852 
1853 DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r",
1854        doc: /* Execute the region as Lisp code.
1855 When called from programs, expects two arguments,
1856 giving starting and ending indices in the current buffer
1857 of the text to be executed.
1858 Programs can pass third argument PRINTFLAG which controls output:
1859 A value of nil means discard it; anything else is stream for printing it.
1860 Also the fourth argument READ-FUNCTION, if non-nil, is used
1861 instead of `read' to read each expression.  It gets one argument
1862 which is the input stream for reading characters.
1863 
1864 This function does not move point.  */)
1865      (start, end, printflag, read_function)
1866      Lisp_Object start, end, printflag, read_function;
1867 {
1868   int count = SPECPDL_INDEX ();
1869   Lisp_Object tem, cbuf;
1870 
1871   cbuf = Fcurrent_buffer ();
1872 
1873   if (NILP (printflag))
1874     tem = Qsymbolp;
1875   else
1876     tem = printflag;
1877   specbind (Qstandard_output, tem);
1878   specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
1879 
1880   /* readevalloop calls functions which check the type of start and end.  */
1881   readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval,
1882                 !NILP (printflag), Qnil, read_function,
1883                 start, end);
1884 
1885   return unbind_to (count, Qnil);
1886 }
1887 
1888 
1889 DEFUN ("read", Fread, Sread, 0, 1, 0,
1890        doc: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1891 If STREAM is nil, use the value of `standard-input' (which see).
1892 STREAM or the value of `standard-input' may be:
1893  a buffer (read from point and advance it)
1894  a marker (read from where it points and advance it)
1895  a function (call it with no arguments for each character,
1896      call it with a char as argument to push a char back)
1897  a string (takes text from string, starting at the beginning)
1898  t (read text line using minibuffer and use it, or read from
1899     standard input in batch mode).  */)
1900      (stream)
1901      Lisp_Object stream;
1902 {
1903   if (NILP (stream))
1904     stream = Vstandard_input;
1905   if (EQ (stream, Qt))
1906     stream = Qread_char;
1907   if (EQ (stream, Qread_char))
1908     return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
1909 
1910   return read_internal_start (stream, Qnil, Qnil);
1911 }
1912 
1913 DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
1914        doc: /* Read one Lisp expression which is represented as text by STRING.
1915 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1916 START and END optionally delimit a substring of STRING from which to read;
1917  they default to 0 and (length STRING) respectively.  */)
1918      (string, start, end)
1919      Lisp_Object string, start, end;
1920 {
1921   Lisp_Object ret;
1922   CHECK_STRING (string);
1923   /* read_internal_start sets read_from_string_index. */
1924   ret = read_internal_start (string, start, end);
1925   return Fcons (ret, make_number (read_from_string_index));
1926 }
1927 
1928 /* Function to set up the global context we need in toplevel read
1929    calls. */
1930 static Lisp_Object
1931 read_internal_start (stream, start, end)
1932      Lisp_Object stream;
1933      Lisp_Object start; /* Only used when stream is a string. */
1934      Lisp_Object end; /* Only used when stream is a string. */
1935 {
1936   Lisp_Object retval;
1937 
1938   readchar_count = 0;
1939   new_backquote_flag = 0;
1940   read_objects = Qnil;
1941   if (EQ (Vread_with_symbol_positions, Qt)
1942       || EQ (Vread_with_symbol_positions, stream))
1943     Vread_symbol_positions_list = Qnil;
1944 
1945   if (STRINGP (stream)
1946       || ((CONSP (stream) && STRINGP (XCAR (stream)))))
1947     {
1948       int startval, endval;
1949       Lisp_Object string;
1950 
1951       if (STRINGP (stream))
1952         string = stream;
1953       else
1954         string = XCAR (stream);
1955 
1956       if (NILP (end))
1957         endval = SCHARS (string);
1958       else
1959         {
1960           CHECK_NUMBER (end);
1961           endval = XINT (end);
1962           if (endval < 0 || endval > SCHARS (string))
1963             args_out_of_range (string, end);
1964         }
1965 
1966       if (NILP (start))
1967         startval = 0;
1968       else
1969         {
1970           CHECK_NUMBER (start);
1971           startval = XINT (start);
1972           if (startval < 0 || startval > endval)
1973             args_out_of_range (string, start);
1974         }
1975       read_from_string_index = startval;
1976       read_from_string_index_byte = string_char_to_byte (string, startval);
1977       read_from_string_limit = endval;
1978     }
1979 
1980   retval = read0 (stream);
1981   if (EQ (Vread_with_symbol_positions, Qt)
1982       || EQ (Vread_with_symbol_positions, stream))
1983     Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
1984   return retval;
1985 }
1986 
1987 
1988 /* Signal Qinvalid_read_syntax error.
1989    S is error string of length N (if > 0)  */
1990 
1991 static void
1992 invalid_syntax (s, n)
1993      const char *s;
1994      int n;
1995 {
1996   if (!n)
1997     n = strlen (s);
1998   xsignal1 (Qinvalid_read_syntax, make_string (s, n));
1999 }
2000 
2001 
2002 /* Use this for recursive reads, in contexts where internal tokens
2003    are not allowed. */
2004 
2005 static Lisp_Object
2006 read0 (readcharfun)
2007      Lisp_Object readcharfun;
2008 {
2009   register Lisp_Object val;
2010   int c;
2011 
2012   val = read1 (readcharfun, &c, 0);
2013   if (!c)
2014     return val;
2015 
2016   xsignal1 (Qinvalid_read_syntax,
2017             Fmake_string (make_number (1), make_number (c)));
2018 }
2019 
2020 static int read_buffer_size;
2021 static char *read_buffer;
2022 
2023 /* Read a \-escape sequence, assuming we already read the `\'.
2024    If the escape sequence forces unibyte, return eight-bit char.  */
2025 
2026 static int
2027 read_escape (readcharfun, stringp)
2028      Lisp_Object readcharfun;
2029      int stringp;
2030 {
2031   register int c = READCHAR;
2032   /* \u allows up to four hex digits, \U up to eight.  Default to the
2033      behavior for \u, and change this value in the case that \U is seen. */
2034   int unicode_hex_count = 4;
2035 
2036   switch (c)
2037     {
2038     case -1:
2039       end_of_file_error ();
2040 
2041     case 'a':
2042       return '\007';
2043     case 'b':
2044       return '\b';
2045     case 'd':
2046       return 0177;
2047     case 'e':
2048       return 033;
2049     case 'f':
2050       return '\f';
2051     case 'n':
2052       return '\n';
2053     case 'r':
2054       return '\r';
2055     case 't':
2056       return '\t';
2057     case 'v':
2058       return '\v';
2059     case '\n':
2060       return -1;
2061     case ' ':
2062       if (stringp)
2063         return -1;
2064       return ' ';
2065 
2066     case 'M':
2067       c = READCHAR;
2068       if (c != '-')
2069         error ("Invalid escape character syntax");
2070       c = READCHAR;
2071       if (c == '\\')
2072         c = read_escape (readcharfun, 0);
2073       return c | meta_modifier;
2074 
2075     case 'S':
2076       c = READCHAR;
2077       if (c != '-')
2078         error ("Invalid escape character syntax");
2079       c = READCHAR;
2080       if (c == '\\')
2081         c = read_escape (readcharfun, 0);
2082       return c | shift_modifier;
2083 
2084     case 'H':
2085       c = READCHAR;
2086       if (c != '-')
2087         error ("Invalid escape character syntax");
2088       c = READCHAR;
2089       if (c == '\\')
2090         c = read_escape (readcharfun, 0);
2091       return c | hyper_modifier;
2092 
2093     case 'A':
2094       c = READCHAR;
2095       if (c != '-')
2096         error ("Invalid escape character syntax");
2097       c = READCHAR;
2098       if (c == '\\')
2099         c = read_escape (readcharfun, 0);
2100       return c | alt_modifier;
2101 
2102     case 's':
2103       c = READCHAR;
2104       if (stringp || c != '-')
2105         {
2106           UNREAD (c);
2107           return ' ';
2108         }
2109       c = READCHAR;
2110       if (c == '\\')
2111         c = read_escape (readcharfun, 0);
2112       return c | super_modifier;
2113 
2114     case 'C':
2115       c = READCHAR;
2116       if (c != '-')
2117         error ("Invalid escape character syntax");
2118     case '^':
2119       c = READCHAR;
2120       if (c == '\\')
2121         c = read_escape (readcharfun, 0);
2122       if ((c & ~CHAR_MODIFIER_MASK) == '?')
2123         return 0177 | (c & CHAR_MODIFIER_MASK);
2124       else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
2125         return c | ctrl_modifier;
2126       /* ASCII control chars are made from letters (both cases),
2127          as well as the non-letters within 0100...0137.  */
2128       else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
2129         return (c & (037 | ~0177));
2130       else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
2131         return (c & (037 | ~0177));
2132       else
2133         return c | ctrl_modifier;
2134 
2135     case '0':
2136     case '1':
2137     case '2':
2138     case '3':
2139     case '4':
2140     case '5':
2141     case '6':
2142     case '7':
2143       /* An octal escape, as in ANSI C.  */
2144       {
2145         register int i = c - '0';
2146         register int count = 0;
2147         while (++count < 3)
2148           {
2149             if ((c = READCHAR) >= '0' && c <= '7')
2150               {
2151                 i *= 8;
2152                 i += c - '0';
2153               }
2154             else
2155               {
2156                 UNREAD (c);
2157                 break;
2158               }
2159           }
2160 
2161         if (i >= 0x80 && i < 0x100)
2162           i = BYTE8_TO_CHAR (i);
2163         return i;
2164       }
2165 
2166     case 'x':
2167       /* A hex escape, as in ANSI C.  */
2168       {
2169         int i = 0;
2170         int count = 0;
2171         while (1)
2172           {
2173             c = READCHAR;
2174             if (c >= '0' && c <= '9')
2175               {
2176                 i *= 16;
2177                 i += c - '0';
2178               }
2179             else if ((c >= 'a' && c <= 'f')
2180                      || (c >= 'A' && c <= 'F'))
2181               {
2182                 i *= 16;
2183                 if (c >= 'a' && c <= 'f')
2184                   i += c - 'a' + 10;
2185                 else
2186                   i += c - 'A' + 10;
2187               }
2188             else
2189               {
2190                 UNREAD (c);
2191                 break;
2192               }
2193             count++;
2194           }
2195 
2196         if (count < 3 && i >= 0x80)
2197           return BYTE8_TO_CHAR (i);
2198         return i;
2199       }
2200 
2201     case 'U':
2202       /* Post-Unicode-2.0: Up to eight hex chars.  */
2203       unicode_hex_count = 8;
2204     case 'u':
2205 
2206       /* A Unicode escape.  We only permit them in strings and characters,
2207          not arbitrarily in the source code, as in some other languages.  */
2208       {
2209         unsigned int i = 0;
2210         int count = 0;
2211 
2212         while (++count <= unicode_hex_count)
2213           {
2214             c = READCHAR;
2215             /* isdigit and isalpha may be locale-specific, which we don't
2216                want. */
2217             if      (c >= '0' && c <= '9')  i = (i << 4) + (c - '0');
2218             else if (c >= 'a' && c <= 'f')  i = (i << 4) + (c - 'a') + 10;
2219             else if (c >= 'A' && c <= 'F')  i = (i << 4) + (c - 'A') + 10;
2220             else
2221               {
2222                 error ("Non-hex digit used for Unicode escape");
2223                 break;
2224               }
2225           }
2226         if (i > 0x10FFFF)
2227           error ("Non-Unicode character: 0x%x", i);
2228         return i;
2229       }
2230 
2231     default:
2232       return c;
2233     }
2234 }
2235 
2236 /* Read an integer in radix RADIX using READCHARFUN to read
2237    characters.  RADIX must be in the interval [2..36]; if it isn't, a
2238    read error is signaled .  Value is the integer read.  Signals an
2239    error if encountering invalid read syntax or if RADIX is out of
2240    range.  */
2241 
2242 static Lisp_Object
2243 read_integer (readcharfun, radix)
2244      Lisp_Object readcharfun;
2245      int radix;
2246 {
2247   int ndigits = 0, invalid_p, c, sign = 0;
2248   /* We use a floating point number because  */
2249   double number = 0;
2250 
2251   if (radix < 2 || radix > 36)
2252     invalid_p = 1;
2253   else
2254     {
2255       number = ndigits = invalid_p = 0;
2256       sign = 1;
2257 
2258       c = READCHAR;
2259       if (c == '-')
2260         {
2261           c = READCHAR;
2262           sign = -1;
2263         }
2264       else if (c == '+')
2265         c = READCHAR;
2266 
2267       while (c >= 0)
2268         {
2269           int digit;
2270 
2271           if (c >= '0' && c <= '9')
2272             digit = c - '0';
2273           else if (c >= 'a' && c <= 'z')
2274             digit = c - 'a' + 10;
2275           else if (c >= 'A' && c <= 'Z')
2276             digit = c - 'A' + 10;
2277           else
2278             {
2279               UNREAD (c);
2280               break;
2281             }
2282 
2283           if (digit < 0 || digit >= radix)
2284             invalid_p = 1;
2285 
2286           number = radix * number + digit;
2287           ++ndigits;
2288           c = READCHAR;
2289         }
2290     }
2291 
2292   if (ndigits == 0 || invalid_p)
2293     {
2294       char buf[50];
2295       sprintf (buf, "integer, radix %d", radix);
2296       invalid_syntax (buf, 0);
2297     }
2298 
2299   return make_fixnum_or_float (sign * number);
2300 }
2301 
2302 
2303 /* If the next token is ')' or ']' or '.', we store that character
2304    in *PCH and the return value is not interesting.  Else, we store
2305    zero in *PCH and we read and return one lisp object.
2306 
2307    FIRST_IN_LIST is nonzero if this is the first element of a list.  */
2308 
2309 static Lisp_Object
2310 read1 (readcharfun, pch, first_in_list)
2311      register Lisp_Object readcharfun;
2312      int *pch;
2313      int first_in_list;
2314 {
2315   register int c;
2316   int uninterned_symbol = 0;
2317   int multibyte;
2318 
2319   *pch = 0;
2320   load_each_byte = 0;
2321 
2322  retry:
2323 
2324   c = READCHAR_REPORT_MULTIBYTE (&multibyte);
2325   if (c < 0)
2326     end_of_file_error ();
2327 
2328   switch (c)
2329     {
2330     case '(':
2331       return read_list (0, readcharfun);
2332 
2333     case '[':
2334       return read_vector (readcharfun, 0);
2335 
2336     case ')':
2337     case ']':
2338       {
2339         *pch = c;
2340         return Qnil;
2341       }
2342 
2343     case '#':
2344       c = READCHAR;
2345       if (c == 's')
2346         {
2347           c = READCHAR;
2348           if (c == '(')
2349             {
2350               /* Accept extended format for hashtables (extensible to
2351                  other types), e.g.
2352                  #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
2353               Lisp_Object tmp = read_list (0, readcharfun);
2354               Lisp_Object head = CAR_SAFE (tmp);
2355               Lisp_Object data = Qnil;
2356               Lisp_Object val = Qnil;
2357               /* The size is 2 * number of allowed keywords to
2358                  make-hash-table. */
2359               Lisp_Object params[10];
2360               Lisp_Object ht;
2361               Lisp_Object key = Qnil;
2362               int param_count = 0;
2363 
2364               if (!EQ (head, Qhash_table))
2365                 error ("Invalid extended read marker at head of #s list "
2366                        "(only hash-table allowed)");
2367 
2368               tmp = CDR_SAFE (tmp);
2369 
2370               /* This is repetitive but fast and simple. */
2371               params[param_count] = QCsize;
2372               params[param_count+1] = Fplist_get (tmp, Qsize);
2373               if (!NILP (params[param_count+1]))
2374                 param_count+=2;
2375 
2376               params[param_count] = QCtest;
2377               params[param_count+1] = Fplist_get (tmp, Qtest);
2378               if (!NILP (params[param_count+1]))
2379                 param_count+=2;
2380 
2381               params[param_count] = QCweakness;
2382               params[param_count+1] = Fplist_get (tmp, Qweakness);
2383               if (!NILP (params[param_count+1]))
2384                 param_count+=2;
2385 
2386               params[param_count] = QCrehash_size;
2387               params[param_count+1] = Fplist_get (tmp, Qrehash_size);
2388               if (!NILP (params[param_count+1]))
2389                 param_count+=2;
2390 
2391               params[param_count] = QCrehash_threshold;
2392               params[param_count+1] = Fplist_get (tmp, Qrehash_threshold);
2393               if (!NILP (params[param_count+1]))
2394                 param_count+=2;
2395 
2396               /* This is the hashtable data. */
2397               data = Fplist_get (tmp, Qdata);
2398 
2399               /* Now use params to make a new hashtable and fill it. */
2400               ht = Fmake_hash_table (param_count, params);
2401 
2402               while (CONSP (data))
2403                 {
2404                   key = XCAR (data);
2405                   data = XCDR (data);
2406                   if (!CONSP (data))
2407                     error ("Odd number of elements in hashtable data");
2408                   val = XCAR (data);
2409                   data = XCDR (data);
2410                   Fputhash (key, val, ht);
2411                 }
2412 
2413               return ht;
2414             }
2415         }
2416       if (c == '^')
2417         {
2418           c = READCHAR;
2419           if (c == '[')
2420             {
2421               Lisp_Object tmp;
2422               tmp = read_vector (readcharfun, 0);
2423               if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS)
2424                 error ("Invalid size char-table");
2425               XSETPVECTYPE (XVECTOR (tmp), PVEC_CHAR_TABLE);
2426               return tmp;
2427             }
2428           else if (c == '^')
2429             {
2430               c = READCHAR;
2431               if (c == '[')
2432                 {
2433                   Lisp_Object tmp;
2434                   int depth, size;
2435 
2436                   tmp = read_vector (readcharfun, 0);
2437                   if (!INTEGERP (AREF (tmp, 0)))
2438                     error ("Invalid depth in char-table");
2439                   depth = XINT (AREF (tmp, 0));
2440                   if (depth < 1 || depth > 3)
2441                     error ("Invalid depth in char-table");
2442                   size = XVECTOR (tmp)->size - 2;
2443                   if (chartab_size [depth] != size)
2444                     error ("Invalid size char-table");
2445                   XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
2446                   return tmp;
2447                 }
2448               invalid_syntax ("#^^", 3);
2449             }
2450           invalid_syntax ("#^", 2);
2451         }
2452       if (c == '&')
2453         {
2454           Lisp_Object length;
2455           length = read1 (readcharfun, pch, first_in_list);
2456           c = READCHAR;
2457           if (c == '"')
2458             {
2459               Lisp_Object tmp, val;
2460               int size_in_chars
2461                 = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
2462                    / BOOL_VECTOR_BITS_PER_CHAR);
2463 
2464               UNREAD (c);
2465               tmp = read1 (readcharfun, pch, first_in_list);
2466               if (STRING_MULTIBYTE (tmp)
2467                   || (size_in_chars != SCHARS (tmp)
2468                       /* We used to print 1 char too many
2469                          when the number of bits was a multiple of 8.
2470                          Accept such input in case it came from an old
2471                          version.  */
2472                       && ! (XFASTINT (length)
2473                             == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)))
2474                 invalid_syntax ("#&...", 5);
2475 
2476               val = Fmake_bool_vector (length, Qnil);
2477               bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data,
2478                      size_in_chars);
2479               /* Clear the extraneous bits in the last byte.  */
2480               if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
2481                 XBOOL_VECTOR (val)->data[size_in_chars - 1]
2482                   &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
2483               return val;
2484             }
2485           invalid_syntax ("#&...", 5);
2486         }
2487       if (c == '[')
2488         {
2489           /* Accept compiled functions at read-time so that we don't have to
2490              build them using function calls.  */
2491           Lisp_Object tmp;
2492           tmp = read_vector (readcharfun, 1);
2493           return Fmake_byte_code (XVECTOR (tmp)->size,
2494                                   XVECTOR (tmp)->contents);
2495         }
2496       if (c == '(')
2497         {
2498           Lisp_Object tmp;
2499           struct gcpro gcpro1;
2500           int ch;
2501 
2502           /* Read the string itself.  */
2503           tmp = read1 (readcharfun, &ch, 0);
2504           if (ch != 0 || !STRINGP (tmp))
2505             invalid_syntax ("#", 1);
2506           GCPRO1 (tmp);
2507           /* Read the intervals and their properties.  */
2508           while (1)
2509             {
2510               Lisp_Object beg, end, plist;
2511 
2512               beg = read1 (readcharfun, &ch, 0);
2513               end = plist = Qnil;
2514               if (ch == ')')
2515                 break;
2516               if (ch == 0)
2517                 end = read1 (readcharfun, &ch, 0);
2518               if (ch == 0)
2519                 plist = read1 (readcharfun, &ch, 0);
2520               if (ch)
2521                 invalid_syntax ("Invalid string property list", 0);
2522               Fset_text_properties (beg, end, plist, tmp);
2523             }
2524           UNGCPRO;
2525           return tmp;
2526         }
2527 
2528       /* #@NUMBER is used to skip NUMBER following characters.
2529          That's used in .elc files to skip over doc strings
2530          and function definitions.  */
2531       if (c == '@')
2532         {
2533           int i, nskip = 0;
2534 
2535           load_each_byte = 1;
2536           /* Read a decimal integer.  */
2537           while ((c = READCHAR) >= 0
2538                  && c >= '0' && c <= '9')
2539             {
2540               nskip *= 10;
2541               nskip += c - '0';
2542             }
2543           if (c >= 0)
2544             UNREAD (c);
2545 
2546           if (load_force_doc_strings
2547               && (EQ (readcharfun, Qget_file_char)
2548                   || EQ (readcharfun, Qget_emacs_mule_file_char)))
2549             {
2550               /* If we are supposed to force doc strings into core right now,
2551                  record the last string that we skipped,
2552                  and record where in the file it comes from.  */
2553 
2554               /* But first exchange saved_doc_string
2555                  with prev_saved_doc_string, so we save two strings.  */
2556               {
2557                 char *temp = saved_doc_string;
2558                 int temp_size = saved_doc_string_size;
2559                 file_offset temp_pos = saved_doc_string_position;
2560                 int temp_len = saved_doc_string_length;
2561 
2562                 saved_doc_string = prev_saved_doc_string;
2563                 saved_doc_string_size = prev_saved_doc_string_size;
2564                 saved_doc_string_position = prev_saved_doc_string_position;
2565                 saved_doc_string_length = prev_saved_doc_string_length;
2566 
2567                 prev_saved_doc_string = temp;
2568                 prev_saved_doc_string_size = temp_size;
2569                 prev_saved_doc_string_position = temp_pos;
2570                 prev_saved_doc_string_length = temp_len;
2571               }
2572 
2573               if (saved_doc_string_size == 0)
2574                 {
2575                   saved_doc_string_size = nskip + 100;
2576                   saved_doc_string = (char *) xmalloc (saved_doc_string_size);
2577                 }
2578               if (nskip > saved_doc_string_size)
2579                 {
2580                   saved_doc_string_size = nskip + 100;
2581                   saved_doc_string = (char *) xrealloc (saved_doc_string,
2582                                                         saved_doc_string_size);
2583                 }
2584 
2585               saved_doc_string_position = file_tell (instream);
2586 
2587               /* Copy that many characters into saved_doc_string.  */
2588               for (i = 0; i < nskip && c >= 0; i++)
2589                 saved_doc_string[i] = c = READCHAR;
2590 
2591               saved_doc_string_length = i;
2592             }
2593           else
2594             {
2595               /* Skip that many characters.  */
2596               for (i = 0; i < nskip && c >= 0; i++)
2597                 c = READCHAR;
2598             }
2599 
2600           load_each_byte = 0;
2601           goto retry;
2602         }
2603       if (c == '!')
2604         {
2605           /* #! appears at the beginning of an executable file.
2606              Skip the first line.  */
2607           while (c != '\n' && c >= 0)
2608             c = READCHAR;
2609           goto retry;
2610         }
2611       if (c == '$')
2612         return Vload_file_name;
2613       if (c == '\'')
2614         return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil));
2615       /* #:foo is the uninterned symbol named foo.  */
2616       if (c == ':')
2617         {
2618           uninterned_symbol = 1;
2619           c = READCHAR;
2620           goto default_label;
2621         }
2622       /* Reader forms that can reuse previously read objects.  */
2623       if (c >= '0' && c <= '9')
2624         {
2625           int n = 0;
2626           Lisp_Object tem;
2627 
2628           /* Read a non-negative integer.  */
2629           while (c >= '0' && c <= '9')
2630             {
2631               n *= 10;
2632               n += c - '0';
2633               c = READCHAR;
2634             }
2635           /* #n=object returns object, but associates it with n for #n#.  */
2636           if (c == '=' && !NILP (Vread_circle))
2637             {
2638               /* Make a placeholder for #n# to use temporarily */
2639               Lisp_Object placeholder;
2640               Lisp_Object cell;
2641 
2642               placeholder = Fcons (Qnil, Qnil);
2643               cell = Fcons (make_number (n), placeholder);
2644               read_objects = Fcons (cell, read_objects);
2645 
2646               /* Read the object itself. */
2647               tem = read0 (readcharfun);
2648 
2649               /* Now put it everywhere the placeholder was... */
2650               substitute_object_in_subtree (tem, placeholder);
2651 
2652               /* ...and #n# will use the real value from now on.  */
2653               Fsetcdr (cell, tem);
2654 
2655               return tem;
2656             }
2657           /* #n# returns a previously read object.  */
2658           if (c == '#' && !NILP (Vread_circle))
2659             {
2660               tem = Fassq (make_number (n), read_objects);
2661               if (CONSP (tem))
2662                 return XCDR (tem);
2663               /* Fall through to error message.  */
2664             }
2665           else if (c == 'r' ||  c == 'R')
2666             return read_integer (readcharfun, n);
2667 
2668           /* Fall through to error message.  */
2669         }
2670       else if (c == 'x' || c == 'X')
2671         return read_integer (readcharfun, 16);
2672       else if (c == 'o' || c == 'O')
2673         return read_integer (readcharfun, 8);
2674       else if (c == 'b' || c == 'B')
2675         return read_integer (readcharfun, 2);
2676 
2677       UNREAD (c);
2678       invalid_syntax ("#", 1);
2679 
2680     case ';':
2681       while ((c = READCHAR) >= 0 && c != '\n');
2682       goto retry;
2683 
2684     case '\'':
2685       {
2686         return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
2687       }
2688 
2689     case '`':
2690       if (first_in_list)
2691         {
2692           Vold_style_backquotes = Qt;
2693           goto default_label;
2694         }
2695       else
2696         {
2697           Lisp_Object value;
2698 
2699           new_backquote_flag++;
2700           value = read0 (readcharfun);
2701           new_backquote_flag--;
2702 
2703           return Fcons (Qbackquote, Fcons (value, Qnil));
2704         }
2705 
2706     case ',':
2707       if (new_backquote_flag)
2708         {
2709           Lisp_Object comma_type = Qnil;
2710           Lisp_Object value;
2711           int ch = READCHAR;
2712 
2713           if (ch == '@')
2714             comma_type = Qcomma_at;
2715           else if (ch == '.')
2716             comma_type = Qcomma_dot;
2717           else
2718             {
2719               if (ch >= 0) UNREAD (ch);
2720               comma_type = Qcomma;
2721             }
2722 
2723           new_backquote_flag--;
2724           value = read0 (readcharfun);
2725           new_backquote_flag++;
2726           return Fcons (comma_type, Fcons (value, Qnil));
2727         }
2728       else
2729         {
2730           Vold_style_backquotes = Qt;
2731           goto default_label;
2732         }
2733 
2734     case '?':
2735       {
2736         int modifiers;
2737         int next_char;
2738         int ok;
2739 
2740         c = READCHAR;
2741         if (c < 0)
2742           end_of_file_error ();
2743 
2744         /* Accept `single space' syntax like (list ? x) where the
2745            whitespace character is SPC or TAB.
2746            Other literal whitespace like NL, CR, and FF are not accepted,
2747            as there are well-established escape sequences for these.  */
2748         if (c == ' ' || c == '\t')
2749           return make_number (c);
2750 
2751         if (c == '\\')
2752           c = read_escape (readcharfun, 0);
2753         modifiers = c & CHAR_MODIFIER_MASK;
2754         c &= ~CHAR_MODIFIER_MASK;
2755         if (CHAR_BYTE8_P (c))
2756           c = CHAR_TO_BYTE8 (c);
2757         c |= modifiers;
2758 
2759         next_char = READCHAR;
2760         if (next_char == '.')
2761           {
2762             /* Only a dotted-pair dot is valid after a char constant.  */
2763             int next_next_char = READCHAR;
2764             UNREAD (next_next_char);
2765 
2766             ok = (next_next_char <= 040
2767                   || (next_next_char < 0200
2768                       && (index ("\"';([#?", next_next_char)
2769                           || (!first_in_list && next_next_char == '`')
2770                           || (new_backquote_flag && next_next_char == ','))));
2771           }
2772         else
2773           {
2774             ok = (next_char <= 040
2775                   || (next_char < 0200
2776                       && (index ("\"';()[]#?", next_char)
2777                           || (!first_in_list && next_char == '`')
2778                           || (new_backquote_flag && next_char == ','))));
2779           }
2780         UNREAD (next_char);
2781         if (ok)
2782           return make_number (c);
2783 
2784         invalid_syntax ("?", 1);
2785       }
2786 
2787     case '"':
2788       {
2789         char *p = read_buffer;
2790         char *end = read_buffer + read_buffer_size;
2791         register int c;
2792         /* Nonzero if we saw an escape sequence specifying
2793            a multibyte character.  */
2794         int force_multibyte = 0;
2795         /* Nonzero if we saw an escape sequence specifying
2796            a single-byte character.  */
2797         int force_singlebyte = 0;
2798         int cancel = 0;
2799         int nchars = 0;
2800 
2801         while ((c = READCHAR) >= 0
2802                && c != '\"')
2803           {
2804             if (end - p < MAX_MULTIBYTE_LENGTH)
2805               {
2806                 int offset = p - read_buffer;
2807                 read_buffer = (char *) xrealloc (read_buffer,
2808                                                  read_buffer_size *= 2);
2809                 p = read_buffer + offset;
2810                 end = read_buffer + read_buffer_size;
2811               }
2812 
2813             if (c == '\\')
2814               {
2815                 int modifiers;
2816 
2817                 c = read_escape (readcharfun, 1);
2818 
2819                 /* C is -1 if \ newline has just been seen */
2820                 if (c == -1)
2821                   {
2822                     if (p == read_buffer)
2823                       cancel = 1;
2824                     continue;
2825                   }
2826 
2827                 modifiers = c & CHAR_MODIFIER_MASK;
2828                 c = c & ~CHAR_MODIFIER_MASK;
2829 
2830                 if (CHAR_BYTE8_P (c))
2831                   force_singlebyte = 1;
2832                 else if (! ASCII_CHAR_P (c))
2833                   force_multibyte = 1;
2834                 else            /* i.e. ASCII_CHAR_P (c) */
2835                   {
2836                     /* Allow `\C- ' and `\C-?'.  */
2837                     if (modifiers == CHAR_CTL)
2838                       {
2839                         if (c == ' ')
2840                           c = 0, modifiers = 0;
2841                         else if (c == '?')
2842                           c = 127, modifiers = 0;
2843                       }
2844                     if (modifiers & CHAR_SHIFT)
2845                       {
2846                         /* Shift modifier is valid only with [A-Za-z].  */
2847                         if (c >= 'A' && c <= 'Z')
2848                           modifiers &= ~CHAR_SHIFT;
2849                         else if (c >= 'a' && c <= 'z')
2850                           c -= ('a' - 'A'), modifiers &= ~CHAR_SHIFT;
2851                       }
2852 
2853                     if (modifiers & CHAR_META)
2854                       {
2855                         /* Move the meta bit to the right place for a
2856                            string.  */
2857                         modifiers &= ~CHAR_META;
2858                         c = BYTE8_TO_CHAR (c | 0x80);
2859                         force_singlebyte = 1;
2860                       }
2861                   }
2862 
2863                 /* Any modifiers remaining are invalid.  */
2864                 if (modifiers)
2865                   error ("Invalid modifier in string");
2866                 p += CHAR_STRING (c, (unsigned char *) p);
2867               }
2868             else
2869               {
2870                 p += CHAR_STRING (c, (unsigned char *) p);
2871                 if (CHAR_BYTE8_P (c))
2872                   force_singlebyte = 1;
2873                 else if (! ASCII_CHAR_P (c))
2874                   force_multibyte = 1;
2875               }
2876             nchars++;
2877           }
2878 
2879         if (c < 0)
2880           end_of_file_error ();
2881 
2882         /* If purifying, and string starts with \ newline,
2883            return zero instead.  This is for doc strings
2884            that we are really going to find in etc/DOC.nn.nn  */
2885         if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
2886           return make_number (0);
2887 
2888         if (force_multibyte)
2889           /* READ_BUFFER already contains valid multibyte forms.  */
2890           ;
2891         else if (force_singlebyte)
2892           {
2893             nchars = str_as_unibyte (read_buffer, p - read_buffer);
2894             p = read_buffer + nchars;
2895           }
2896         else
2897           /* Otherwise, READ_BUFFER contains only ASCII.  */
2898           ;
2899 
2900         /* We want readchar_count to be the number of characters, not
2901            bytes.  Hence we adjust for multibyte characters in the
2902            string.  ... But it doesn't seem to be necessary, because
2903            READCHAR *does* read multibyte characters from buffers. */
2904         /* readchar_count -= (p - read_buffer) - nchars; */
2905         if (read_pure)
2906           return make_pure_string (read_buffer, nchars, p - read_buffer,
2907                                    (force_multibyte
2908                                     || (p - read_buffer != nchars)));
2909         return make_specified_string (read_buffer, nchars, p - read_buffer,
2910                                       (force_multibyte
2911                                        || (p - read_buffer != nchars)));
2912       }
2913 
2914     case '.':
2915       {
2916         int next_char = READCHAR;
2917         UNREAD (next_char);
2918 
2919         if (next_char <= 040
2920             || (next_char < 0200
2921                 && (index ("\"';([#?", next_char)
2922                     || (!first_in_list && next_char == '`')
2923                     || (new_backquote_flag && next_char == ','))))
2924           {
2925             *pch = c;
2926             return Qnil;
2927           }
2928 
2929         /* Otherwise, we fall through!  Note that the atom-reading loop
2930            below will now loop at least once, assuring that we will not
2931            try to UNREAD two characters in a row.  */
2932       }
2933     default:
2934     default_label:
2935       if (c <= 040) goto retry;
2936       if (c == 0x8a0) /* NBSP */
2937         goto retry;
2938       {
2939         char *p = read_buffer;
2940         int quoted = 0;
2941 
2942         {
2943           char *end = read_buffer + read_buffer_size;
2944 
2945           while (c > 040
2946                  && c != 0x8a0 /* NBSP */
2947                  && (c >= 0200
2948                      || (!index ("\"';()[]#", c)
2949                          && !(!first_in_list && c == '`')
2950                          && !(new_backquote_flag && c == ','))))
2951             {
2952               if (end - p < MAX_MULTIBYTE_LENGTH)
2953                 {
2954                   int offset = p - read_buffer;
2955                   read_buffer = (char *) xrealloc (read_buffer,
2956                                                    read_buffer_size *= 2);
2957                   p = read_buffer + offset;
2958                   end = read_buffer + read_buffer_size;
2959                 }
2960 
2961               if (c == '\\')
2962                 {
2963                   c = READCHAR;
2964                   if (c == -1)
2965                     end_of_file_error ();
2966                   quoted = 1;
2967                 }
2968 
2969               if (multibyte)
2970                 p += CHAR_STRING (c, p);
2971               else
2972                 *p++ = c;
2973               c = READCHAR;
2974             }
2975 
2976           if (p == end)
2977             {
2978               int offset = p - read_buffer;
2979               read_buffer = (char *) xrealloc (read_buffer,
2980                                                read_buffer_size *= 2);
2981               p = read_buffer + offset;
2982               end = read_buffer + read_buffer_size;
2983             }
2984           *p = 0;
2985           if (c >= 0)
2986             UNREAD (c);
2987         }
2988 
2989         if (!quoted && !uninterned_symbol)
2990           {
2991             register char *p1;
2992             p1 = read_buffer;
2993             if (*p1 == '+' || *p1 == '-') p1++;
2994             /* Is it an integer? */
2995             if (p1 != p)
2996               {
2997                 while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++;
2998                 /* Integers can have trailing decimal points.  */
2999                 if (p1 > read_buffer && p1 < p && *p1 == '.') p1++;
3000                 if (p1 == p)
3001                   /* It is an integer. */
3002                   {
3003                     if (p1[-1] == '.')
3004                       p1[-1] = '\0';
3005                     {
3006                       /* EMACS_INT n = atol (read_buffer); */
3007                       char *endptr = NULL;
3008                       EMACS_INT n = (errno = 0,
3009                                      strtol (read_buffer, &endptr, 10));
3010                       if (errno == ERANGE && endptr)
3011                         {
3012                           Lisp_Object args
3013                             = Fcons (make_string (read_buffer,
3014                                                   endptr - read_buffer),
3015                                      Qnil);
3016                           xsignal (Qoverflow_error, args);
3017                         }
3018                       return make_fixnum_or_float (n);
3019                     }
3020                   }
3021               }
3022             if (isfloat_string (read_buffer, 0))
3023               {
3024                 /* Compute NaN and infinities using 0.0 in a variable,
3025                    to cope with compilers that think they are smarter
3026                    than we are.  */
3027                 double zero = 0.0;
3028 
3029                 double value;
3030 
3031                 /* Negate the value ourselves.  This treats 0, NaNs,
3032                    and infinity properly on IEEE floating point hosts,
3033                    and works around a common bug where atof ("-0.0")
3034                    drops the sign.  */
3035                 int negative = read_buffer[0] == '-';
3036 
3037                 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
3038                    returns 1, is if the input ends in e+INF or e+NaN.  */
3039                 switch (p[-1])
3040                   {
3041                   case 'F':
3042                     value = 1.0 / zero;
3043                     break;
3044                   case 'N':
3045                     value = zero / zero;
3046 
3047                     /* If that made a "negative" NaN, negate it.  */
3048 
3049                     {
3050                       int i;
3051                       union { double d; char c[sizeof (double)]; } u_data, u_minus_zero;
3052 
3053                       u_data.d = value;
3054                       u_minus_zero.d = - 0.0;
3055                       for (i = 0; i < sizeof (double); i++)
3056                         if (u_data.c[i] & u_minus_zero.c[i])
3057                           {
3058                             value = - value;
3059                             break;
3060                           }
3061                     }
3062                     /* Now VALUE is a positive NaN.  */
3063                     break;
3064                   default:
3065                     value = atof (read_buffer + negative);
3066                     break;
3067                   }
3068 
3069                 return make_float (negative ? - value : value);
3070               }
3071           }
3072         {
3073           Lisp_Object name, result;
3074           EMACS_INT nbytes = p - read_buffer;
3075           EMACS_INT nchars
3076             = (multibyte ? multibyte_chars_in_text (read_buffer, nbytes)
3077                : nbytes);
3078 
3079           if (uninterned_symbol && ! NILP (Vpurify_flag))
3080             name = make_pure_string (read_buffer, nchars, nbytes, multibyte);
3081           else
3082             name = make_specified_string (read_buffer, nchars, nbytes,multibyte);
3083           result = (uninterned_symbol ? Fmake_symbol (name)
3084                     : Fintern (name, Qnil));
3085 
3086           if (EQ (Vread_with_symbol_positions, Qt)
3087               || EQ (Vread_with_symbol_positions, readcharfun))
3088             Vread_symbol_positions_list =
3089               /* Kind of a hack; this will probably fail if characters
3090                  in the symbol name were escaped.  Not really a big
3091                  deal, though.  */
3092               Fcons (Fcons (result,
3093                             make_number (readchar_count
3094                                          - XFASTINT (Flength (Fsymbol_name (result))))),
3095                      Vread_symbol_positions_list);
3096           return result;
3097         }
3098       }
3099     }
3100 }
3101 
3102 
3103 /* List of nodes we've seen during substitute_object_in_subtree. */
3104 static Lisp_Object seen_list;
3105 
3106 static void
3107 substitute_object_in_subtree (object, placeholder)
3108      Lisp_Object object;
3109      Lisp_Object placeholder;
3110 {
3111   Lisp_Object check_object;
3112 
3113   /* We haven't seen any objects when we start. */
3114   seen_list = Qnil;
3115 
3116   /* Make all the substitutions. */
3117   check_object
3118     = substitute_object_recurse (object, placeholder, object);
3119 
3120   /* Clear seen_list because we're done with it. */
3121   seen_list = Qnil;
3122 
3123   /* The returned object here is expected to always eq the
3124      original. */
3125   if (!EQ (check_object, object))
3126     error ("Unexpected mutation error in reader");
3127 }
3128 
3129 /*  Feval doesn't get called from here, so no gc protection is needed. */
3130 #define SUBSTITUTE(get_val, set_val)                    \
3131   do {                                                  \
3132     Lisp_Object old_value = get_val;                    \
3133     Lisp_Object true_value                              \
3134       = substitute_object_recurse (object, placeholder, \
3135                                    old_value);          \
3136                                                         \
3137     if (!EQ (old_value, true_value))                    \
3138       {                                                 \
3139         set_val;                                        \
3140       }                                                 \
3141   } while (0)
3142 
3143 static Lisp_Object
3144 substitute_object_recurse (object, placeholder, subtree)
3145      Lisp_Object object;
3146      Lisp_Object placeholder;
3147      Lisp_Object subtree;
3148 {
3149   /* If we find the placeholder, return the target object. */
3150   if (EQ (placeholder, subtree))
3151     return object;
3152 
3153   /* If we've been to this node before, don't explore it again. */
3154   if (!EQ (Qnil, Fmemq (subtree, seen_list)))
3155     return subtree;
3156 
3157   /* If this node can be the entry point to a cycle, remember that
3158      we've seen it.  It can only be such an entry point if it was made
3159      by #n=, which means that we can find it as a value in
3160      read_objects.  */
3161   if (!EQ (Qnil, Frassq (subtree, read_objects)))
3162     seen_list = Fcons (subtree, seen_list);
3163 
3164   /* Recurse according to subtree's type.
3165      Every branch must return a Lisp_Object.  */
3166   switch (XTYPE (subtree))
3167     {
3168     case Lisp_Vectorlike:
3169       {
3170         int i, length = 0;
3171         if (BOOL_VECTOR_P (subtree))
3172           return subtree;               /* No sub-objects anyway.  */
3173         else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
3174                  || COMPILEDP (subtree))
3175           length = ASIZE (subtree) & PSEUDOVECTOR_SIZE_MASK;
3176         else if (VECTORP (subtree))
3177           length = ASIZE (subtree);
3178         else
3179           /* An unknown pseudovector may contain non-Lisp fields, so we
3180              can't just blindly traverse all its fields.  We used to call
3181              `Flength' which signaled `sequencep', so I just preserved this
3182              behavior.  */
3183           wrong_type_argument (Qsequencep, subtree);
3184 
3185         for (i = 0; i < length; i++)
3186           SUBSTITUTE (AREF (subtree, i),
3187                       ASET (subtree, i, true_value));
3188         return subtree;
3189       }
3190 
3191     case Lisp_Cons:
3192       {
3193         SUBSTITUTE (XCAR (subtree),
3194                     XSETCAR (subtree, true_value));
3195         SUBSTITUTE (XCDR (subtree),
3196                     XSETCDR (subtree, true_value));
3197         return subtree;
3198       }
3199 
3200     case Lisp_String:
3201       {
3202         /* Check for text properties in each interval.
3203            substitute_in_interval contains part of the logic. */
3204 
3205         INTERVAL    root_interval = STRING_INTERVALS (subtree);
3206         Lisp_Object arg           = Fcons (object, placeholder);
3207 
3208         traverse_intervals_noorder (root_interval,
3209                                     &substitute_in_interval, arg);
3210 
3211         return subtree;
3212       }
3213 
3214       /* Other types don't recurse any further. */
3215     default:
3216       return subtree;
3217     }
3218 }
3219 
3220 /*  Helper function for substitute_object_recurse.  */
3221 static void
3222 substitute_in_interval (interval, arg)
3223      INTERVAL    interval;
3224      Lisp_Object arg;
3225 {
3226   Lisp_Object object      = Fcar (arg);
3227   Lisp_Object placeholder = Fcdr (arg);
3228 
3229   SUBSTITUTE (interval->plist, interval->plist = true_value);
3230 }
3231 
3232 
3233 #define LEAD_INT 1
3234 #define DOT_CHAR 2
3235 #define TRAIL_INT 4
3236 #define E_CHAR 8
3237 #define EXP_INT 16
3238 
3239 int
3240 isfloat_string (cp, ignore_trailing)
3241      register char *cp;
3242      int ignore_trailing;
3243 {
3244   register int state;
3245 
3246   char *start = cp;
3247 
3248   state = 0;
3249   if (*cp == '+' || *cp == '-')
3250     cp++;
3251 
3252   if (*cp >= '0' && *cp <= '9')
3253     {
3254       state |= LEAD_INT;
3255       while (*cp >= '0' && *cp <= '9')
3256         cp++;
3257     }
3258   if (*cp == '.')
3259     {
3260       state |= DOT_CHAR;
3261       cp++;
3262     }
3263   if (*cp >= '0' && *cp <= '9')
3264     {
3265       state |= TRAIL_INT;
3266       while (*cp >= '0' && *cp <= '9')
3267         cp++;
3268     }
3269   if (*cp == 'e' || *cp == 'E')
3270     {
3271       state |= E_CHAR;
3272       cp++;
3273       if (*cp == '+' || *cp == '-')
3274         cp++;
3275     }
3276 
3277   if (*cp >= '0' && *cp <= '9')
3278     {
3279       state |= EXP_INT;
3280       while (*cp >= '0' && *cp <= '9')
3281         cp++;
3282     }
3283   else if (cp == start)
3284     ;
3285   else if (cp[-1] == '+' && cp[0] == 'I' && cp[1] == 'N' && cp[2] == 'F')
3286     {
3287       state |= EXP_INT;
3288       cp += 3;
3289     }
3290   else if (cp[-1] == '+' && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
3291     {
3292       state |= EXP_INT;
3293       cp += 3;
3294     }
3295 
3296   return ((ignore_trailing
3297            || (*cp == 0) || (*cp == ' ') || (*cp == '\t') || (*cp == '\n') || (*cp == '\r') || (*cp == '\f'))
3298           && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
3299               || state == (DOT_CHAR|TRAIL_INT)
3300               || state == (LEAD_INT|E_CHAR|EXP_INT)
3301               || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
3302               || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
3303 }
3304 
3305 
3306 static Lisp_Object
3307 read_vector (readcharfun, bytecodeflag)
3308      Lisp_Object readcharfun;
3309      int bytecodeflag;
3310 {
3311   register int i;
3312   register int size;
3313   register Lisp_Object *ptr;
3314   register Lisp_Object tem, item, vector;
3315   register struct Lisp_Cons *otem;
3316   Lisp_Object len;
3317 
3318   tem = read_list (1, readcharfun);
3319   len = Flength (tem);
3320   vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
3321 
3322   size = XVECTOR (vector)->size;
3323   ptr = XVECTOR (vector)->contents;
3324   for (i = 0; i < size; i++)
3325     {
3326       item = Fcar (tem);
3327       /* If `load-force-doc-strings' is t when reading a lazily-loaded
3328          bytecode object, the docstring containing the bytecode and
3329          constants values must be treated as unibyte and passed to
3330          Fread, to get the actual bytecode string and constants vector.  */
3331       if (bytecodeflag && load_force_doc_strings)
3332         {
3333           if (i == COMPILED_BYTECODE)
3334             {
3335               if (!STRINGP (item))
3336                 error ("Invalid byte code");
3337 
3338               /* Delay handling the bytecode slot until we know whether
3339                  it is lazily-loaded (we can tell by whether the
3340                  constants slot is nil).  */
3341               ptr[COMPILED_CONSTANTS] = item;
3342               item = Qnil;
3343             }
3344           else if (i == COMPILED_CONSTANTS)
3345             {
3346               Lisp_Object bytestr = ptr[COMPILED_CONSTANTS];
3347 
3348               if (NILP (item))
3349                 {
3350                   /* Coerce string to unibyte (like string-as-unibyte,
3351                      but without generating extra garbage and
3352                      guaranteeing no change in the contents).  */
3353                   STRING_SET_CHARS (bytestr, SBYTES (bytestr));
3354                   STRING_SET_UNIBYTE (bytestr);
3355 
3356                   item = Fread (Fcons (bytestr, readcharfun));
3357                   if (!CONSP (item))
3358                     error ("Invalid byte code");
3359 
3360                   otem = XCONS (item);
3361                   bytestr = XCAR (item);
3362                   item = XCDR (item);
3363                   free_cons (otem);
3364                 }
3365 
3366               /* Now handle the bytecode slot.  */
3367               ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;
3368             }
3369           else if (i == COMPILED_DOC_STRING
3370                    && STRINGP (item)
3371                    && ! STRING_MULTIBYTE (item))
3372             {
3373               if (EQ (readcharfun, Qget_emacs_mule_file_char))
3374                 item = Fdecode_coding_string (item, Qemacs_mule, Qnil, Qnil);
3375               else
3376                 item = Fstring_as_multibyte (item);
3377             }
3378         }
3379       ptr[i] = read_pure ? Fpurecopy (item) : item;
3380       otem = XCONS (tem);
3381       tem = Fcdr (tem);
3382       free_cons (otem);
3383     }
3384   return vector;
3385 }
3386 
3387 /* FLAG = 1 means check for ] to terminate rather than ) and .
3388    FLAG = -1 means check for starting with defun
3389     and make structure pure.  */
3390 
3391 static Lisp_Object
3392 read_list (flag, readcharfun)
3393      int flag;
3394      register Lisp_Object readcharfun;
3395 {
3396   /* -1 means check next element for defun,
3397      0 means don't check,
3398      1 means already checked and found defun. */
3399   int defunflag = flag < 0 ? -1 : 0;
3400   Lisp_Object val, tail;
3401   register Lisp_Object elt, tem;
3402   struct gcpro gcpro1, gcpro2;
3403   /* 0 is the normal case.
3404      1 means this list is a doc reference; replace it with the number 0.
3405      2 means this list is a doc reference; replace it with the doc string.  */
3406   int doc_reference = 0;
3407 
3408   /* Initialize this to 1 if we are reading a list.  */
3409   int first_in_list = flag <= 0;
3410 
3411   val = Qnil;
3412   tail = Qnil;
3413 
3414   while (1)
3415     {
3416       int ch;
3417       GCPRO2 (val, tail);
3418       elt = read1 (readcharfun, &ch, first_in_list);
3419       UNGCPRO;
3420 
3421       first_in_list = 0;
3422 
3423       /* While building, if the list starts with #$, treat it specially.  */
3424       if (EQ (elt, Vload_file_name)
3425           && ! NILP (elt)
3426           && !NILP (Vpurify_flag))
3427         {
3428           if (NILP (Vdoc_file_name))
3429             /* We have not yet called Snarf-documentation, so assume
3430                this file is described in the DOC-MM.NN file
3431                and Snarf-documentation will fill in the right value later.
3432                For now, replace the whole list with 0.  */
3433             doc_reference = 1;
3434           else
3435             /* We have already called Snarf-documentation, so make a relative
3436                file name for this file, so it can be found properly
3437                in the installed Lisp directory.
3438                We don't use Fexpand_file_name because that would make
3439                the directory absolute now.  */
3440             elt = concat2 (build_string ("../lisp/"),
3441                            Ffile_name_nondirectory (elt));
3442         }
3443       else if (EQ (elt, Vload_file_name)
3444                && ! NILP (elt)
3445                && load_force_doc_strings)
3446         doc_reference = 2;
3447 
3448       if (ch)
3449         {
3450           if (flag > 0)
3451             {
3452               if (ch == ']')
3453                 return val;
3454               invalid_syntax (") or . in a vector", 18);
3455             }
3456           if (ch == ')')
3457             return val;
3458           if (ch == '.')
3459             {
3460               GCPRO2 (val, tail);
3461               if (!NILP (tail))
3462                 XSETCDR (tail, read0 (readcharfun));
3463               else
3464                 val = read0 (readcharfun);
3465               read1 (readcharfun, &ch, 0);
3466               UNGCPRO;
3467               if (ch == ')')
3468                 {
3469                   if (doc_reference == 1)
3470                     return make_number (0);
3471                   if (doc_reference == 2)
3472                     {
3473                       /* Get a doc string from the file we are loading.
3474                          If it's in saved_doc_string, get it from there.
3475 
3476                          Here, we don't know if the string is a
3477                          bytecode string or a doc string.  As a
3478                          bytecode string must be unibyte, we always
3479                          return a unibyte string.  If it is actually a
3480                          doc string, caller must make it
3481                          multibyte.  */
3482 
3483                       int pos = XINT (XCDR (val));
3484                       /* Position is negative for user variables.  */
3485                       if (pos < 0) pos = -pos;
3486                       if (pos >= saved_doc_string_position
3487                           && pos < (saved_doc_string_position
3488                                     + saved_doc_string_length))
3489                         {
3490                           int start = pos - saved_doc_string_position;
3491                           int from, to;
3492 
3493                           /* Process quoting with ^A,
3494                              and find the end of the string,
3495                              which is marked with ^_ (037).  */
3496                           for (from = start, to = start;
3497                                saved_doc_string[from] != 037;)
3498                             {
3499                               int c = saved_doc_string[from++];
3500                               if (c == 1)
3501                                 {
3502                                   c = saved_doc_string[from++];
3503                                   if (c == 1)
3504                                     saved_doc_string[to++] = c;
3505                                   else if (c == '0')
3506                                     saved_doc_string[to++] = 0;
3507                                   else if (c == '_')
3508                                     saved_doc_string[to++] = 037;
3509                                 }
3510                               else
3511                                 saved_doc_string[to++] = c;
3512                             }
3513 
3514                           return make_unibyte_string (saved_doc_string + start,
3515                                                       to - start);
3516                         }
3517                       /* Look in prev_saved_doc_string the same way.  */
3518                       else if (pos >= prev_saved_doc_string_position
3519                                && pos < (prev_saved_doc_string_position
3520                                          + prev_saved_doc_string_length))
3521                         {
3522                           int start = pos - prev_saved_doc_string_position;
3523                           int from, to;
3524 
3525                           /* Process quoting with ^A,
3526                              and find the end of the string,
3527                              which is marked with ^_ (037).  */
3528                           for (from = start, to = start;
3529                                prev_saved_doc_string[from] != 037;)
3530                             {
3531                               int c = prev_saved_doc_string[from++];
3532                               if (c == 1)
3533                                 {
3534                                   c = prev_saved_doc_string[from++];
3535                                   if (c == 1)
3536                                     prev_saved_doc_string[to++] = c;
3537                                   else if (c == '0')
3538                                     prev_saved_doc_string[to++] = 0;
3539                                   else if (c == '_')
3540                                     prev_saved_doc_string[to++] = 037;
3541                                 }
3542                               else
3543                                 prev_saved_doc_string[to++] = c;
3544                             }
3545 
3546                           return make_unibyte_string (prev_saved_doc_string
3547                                                       + start,
3548                                                       to - start);
3549                         }
3550                       else
3551                         return get_doc_string (val, 1, 0);
3552                     }
3553 
3554                   return val;
3555                 }
3556               invalid_syntax (". in wrong context", 18);
3557             }
3558           invalid_syntax ("] in a list", 11);
3559         }
3560       tem = (read_pure && flag <= 0
3561              ? pure_cons (elt, Qnil)
3562              : Fcons (elt, Qnil));
3563       if (!NILP (tail))
3564         XSETCDR (tail, tem);
3565       else
3566         val = tem;
3567       tail = tem;
3568       if (defunflag < 0)
3569         defunflag = EQ (elt, Qdefun);
3570       else if (defunflag > 0)
3571         read_pure = 1;
3572     }
3573 }
3574 
3575 Lisp_Object Vobarray;
3576 Lisp_Object initial_obarray;
3577 
3578 /* oblookup stores the bucket number here, for the sake of Funintern.  */
3579 
3580 int oblookup_last_bucket_number;
3581 
3582 static int hash_string ();
3583 
3584 /* Get an error if OBARRAY is not an obarray.
3585    If it is one, return it.  */
3586 
3587 Lisp_Object
3588 check_obarray (obarray)
3589      Lisp_Object obarray;
3590 {
3591   if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
3592     {
3593       /* If Vobarray is now invalid, force it to be valid.  */
3594       if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
3595       wrong_type_argument (Qvectorp, obarray);
3596     }
3597   return obarray;
3598 }
3599 
3600 /* Intern the C string STR: return a symbol with that name,
3601    interned in the current obarray.  */
3602 
3603 Lisp_Object
3604 intern (str)
3605      const char *str;
3606 {
3607   Lisp_Object tem;
3608   int len = strlen (str);
3609   Lisp_Object obarray;
3610 
3611   obarray = Vobarray;
3612   if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
3613     obarray = check_obarray (obarray);
3614   tem = oblookup (obarray, str, len, len);
3615   if (SYMBOLP (tem))
3616     return tem;
3617   return Fintern (make_string (str, len), obarray);
3618 }
3619 
3620 Lisp_Object
3621 intern_c_string (const char *str)
3622 {
3623   Lisp_Object tem;
3624   int len = strlen (str);
3625   Lisp_Object obarray;
3626 
3627   obarray = Vobarray;
3628   if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
3629     obarray = check_obarray (obarray);
3630   tem = oblookup (obarray, str, len, len);
3631   if (SYMBOLP (tem))
3632     return tem;
3633 
3634   if (NILP (Vpurify_flag))
3635     /* Creating a non-pure string from a string literal not
3636        implemented yet.  We could just use make_string here and live
3637        with the extra copy.  */
3638     abort ();
3639 
3640   return Fintern (make_pure_c_string (str), obarray);
3641 }
3642 
3643 /* Create an uninterned symbol with name STR.  */
3644 
3645 Lisp_Object
3646 make_symbol (str)
3647      char *str;
3648 {
3649   int len = strlen (str);
3650 
3651   return Fmake_symbol ((!NILP (Vpurify_flag)
3652                         ? make_pure_string (str, len, len, 0)
3653                         : make_string (str, len)));
3654 }
3655 
3656 DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
3657        doc: /* Return the canonical symbol whose name is STRING.
3658 If there is none, one is created by this function and returned.
3659 A second optional argument specifies the obarray to use;
3660 it defaults to the value of `obarray'.  */)
3661      (string, obarray)
3662      Lisp_Object string, obarray;
3663 {
3664   register Lisp_Object tem, sym, *ptr;
3665 
3666   if (NILP (obarray)) obarray = Vobarray;
3667   obarray = check_obarray (obarray);
3668 
3669   CHECK_STRING (string);
3670 
3671   tem = oblookup (obarray, SDATA (string),
3672                   SCHARS (string),
3673                   SBYTES (string));
3674   if (!INTEGERP (tem))
3675     return tem;
3676 
3677   if (!NILP (Vpurify_flag))
3678     string = Fpurecopy (string);
3679   sym = Fmake_symbol (string);
3680 
3681   if (EQ (obarray, initial_obarray))
3682     XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
3683   else
3684     XSYMBOL (sym)->interned = SYMBOL_INTERNED;
3685 
3686   if ((SREF (string, 0) == ':')
3687       && EQ (obarray, initial_obarray))
3688     {
3689       XSYMBOL (sym)->constant = 1;
3690       XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL;
3691       SET_SYMBOL_VAL (XSYMBOL (sym), sym);
3692     }
3693 
3694   ptr = &XVECTOR (obarray)->contents[XINT (tem)];
3695   if (SYMBOLP (*ptr))
3696     XSYMBOL (sym)->next = XSYMBOL (*ptr);
3697   else
3698     XSYMBOL (sym)->next = 0;
3699   *ptr = sym;
3700   return sym;
3701 }
3702 
3703 DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
3704        doc: /* Return the canonical symbol named NAME, or nil if none exists.
3705 NAME may be a string or a symbol.  If it is a symbol, that exact
3706 symbol is searched for.
3707 A second optional argument specifies the obarray to use;
3708 it defaults to the value of `obarray'.  */)
3709      (name, obarray)
3710      Lisp_Object name, obarray;
3711 {
3712   register Lisp_Object tem, string;
3713 
3714   if (NILP (obarray)) obarray = Vobarray;
3715   obarray = check_obarray (obarray);
3716 
3717   if (!SYMBOLP (name))
3718     {
3719       CHECK_STRING (name);
3720       string = name;
3721     }
3722   else
3723     string = SYMBOL_NAME (name);
3724 
3725   tem = oblookup (obarray, SDATA (string), SCHARS (string), SBYTES (string));
3726   if (INTEGERP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
3727     return Qnil;
3728   else
3729     return tem;
3730 }
3731 
3732 DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0,
3733        doc: /* Delete the symbol named NAME, if any, from OBARRAY.
3734 The value is t if a symbol was found and deleted, nil otherwise.
3735 NAME may be a string or a symbol.  If it is a symbol, that symbol
3736 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3737 OBARRAY defaults to the value of the variable `obarray'.  */)
3738      (name, obarray)
3739      Lisp_Object name, obarray;
3740 {
3741   register Lisp_Object string, tem;
3742   int hash;
3743 
3744   if (NILP (obarray)) obarray = Vobarray;
3745   obarray = check_obarray (obarray);
3746 
3747   if (SYMBOLP (name))
3748     string = SYMBOL_NAME (name);
3749   else
3750     {
3751       CHECK_STRING (name);
3752       string = name;
3753     }
3754 
3755   tem = oblookup (obarray, SDATA (string),
3756                   SCHARS (string),
3757                   SBYTES (string));
3758   if (INTEGERP (tem))
3759     return Qnil;
3760   /* If arg was a symbol, don't delete anything but that symbol itself.  */
3761   if (SYMBOLP (name) && !EQ (name, tem))
3762     return Qnil;
3763 
3764   /* There are plenty of other symbols which will screw up the Emacs
3765      session if we unintern them, as well as even more ways to use
3766      `setq' or `fset' or whatnot to make the Emacs session
3767      unusable.  Let's not go down this silly road.  --Stef  */
3768   /* if (EQ (tem, Qnil) || EQ (tem, Qt))
3769        error ("Attempt to unintern t or nil"); */
3770 
3771   XSYMBOL (tem)->interned = SYMBOL_UNINTERNED;
3772 
3773   hash = oblookup_last_bucket_number;
3774 
3775   if (EQ (XVECTOR (obarray)->contents[hash], tem))
3776     {
3777       if (XSYMBOL (tem)->next)
3778         XSETSYMBOL (XVECTOR (obarray)->contents[hash], XSYMBOL (tem)->next);
3779       else
3780         XSETINT (XVECTOR (obarray)->contents[hash], 0);
3781     }
3782   else
3783     {
3784       Lisp_Object tail, following;
3785 
3786       for (tail = XVECTOR (obarray)->contents[hash];
3787            XSYMBOL (tail)->next;
3788            tail = following)
3789         {
3790           XSETSYMBOL (following, XSYMBOL (tail)->next);
3791           if (EQ (following, tem))
3792             {
3793               XSYMBOL (tail)->next = XSYMBOL (following)->next;
3794               break;
3795             }
3796         }
3797     }
3798 
3799   return Qt;
3800 }
3801 
3802 /* Return the symbol in OBARRAY whose names matches the string
3803    of SIZE characters (SIZE_BYTE bytes) at PTR.
3804    If there is no such symbol in OBARRAY, return nil.
3805 
3806    Also store the bucket number in oblookup_last_bucket_number.  */
3807 
3808 Lisp_Object
3809 oblookup (obarray, ptr, size, size_byte)
3810      Lisp_Object obarray;
3811      register const char *ptr;
3812      int size, size_byte;
3813 {
3814   int hash;
3815   int obsize;
3816   register Lisp_Object tail;
3817   Lisp_Object bucket, tem;
3818 
3819   if (!VECTORP (obarray)
3820       || (obsize = XVECTOR (obarray)->size) == 0)
3821     {
3822       obarray = check_obarray (obarray);
3823       obsize = XVECTOR (obarray)->size;
3824     }
3825   /* This is sometimes needed in the middle of GC.  */
3826   obsize &= ~ARRAY_MARK_FLAG;
3827   hash = hash_string (ptr, size_byte) % obsize;
3828   bucket = XVECTOR (obarray)->contents[hash];
3829   oblookup_last_bucket_number = hash;
3830   if (EQ (bucket, make_number (0)))
3831     ;
3832   else if (!SYMBOLP (bucket))
3833     error ("Bad data in guts of obarray"); /* Like CADR error message */
3834   else
3835     for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
3836       {
3837         if (SBYTES (SYMBOL_NAME (tail)) == size_byte
3838             && SCHARS (SYMBOL_NAME (tail)) == size
3839             && !bcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte))
3840           return tail;
3841         else if (XSYMBOL (tail)->next == 0)
3842           break;
3843       }
3844   XSETINT (tem, hash);
3845   return tem;
3846 }
3847 
3848 static int
3849 hash_string (ptr, len)
3850      const unsigned char *ptr;
3851      int len;
3852 {
3853   register const unsigned char *p = ptr;
3854   register const unsigned char *end = p + len;
3855   register unsigned char c;
3856   register int hash = 0;
3857 
3858   while (p != end)
3859     {
3860       c = *p++;
3861       if (c >= 0140) c -= 40;
3862       hash = ((hash<<3) + (hash>>28) + c);
3863     }
3864   return hash & 07777777777;
3865 }
3866 
3867 void
3868 map_obarray (obarray, fn, arg)
3869      Lisp_Object obarray;
3870      void (*fn) P_ ((Lisp_Object, Lisp_Object));
3871      Lisp_Object arg;
3872 {
3873   register int i;
3874   register Lisp_Object tail;
3875   CHECK_VECTOR (obarray);
3876   for (i = XVECTOR (obarray)->size - 1; i >= 0; i--)
3877     {
3878       tail = XVECTOR (obarray)->contents[i];
3879       if (SYMBOLP (tail))
3880         while (1)
3881           {
3882             (*fn) (tail, arg);
3883             if (XSYMBOL (tail)->next == 0)
3884               break;
3885             XSETSYMBOL (tail, XSYMBOL (tail)->next);
3886           }
3887     }
3888 }
3889 
3890 void
3891 mapatoms_1 (sym, function)
3892      Lisp_Object sym, function;
3893 {
3894   call1 (function, sym);
3895 }
3896 
3897 DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
3898        doc: /* Call FUNCTION on every symbol in OBARRAY.
3899 OBARRAY defaults to the value of `obarray'.  */)
3900      (function, obarray)
3901      Lisp_Object function, obarray;
3902 {
3903   if (NILP (obarray)) obarray = Vobarray;
3904   obarray = check_obarray (obarray);
3905 
3906   map_obarray (obarray, mapatoms_1, function);
3907   return Qnil;
3908 }
3909 
3910 #define OBARRAY_SIZE 1511
3911 
3912 void
3913 init_obarray ()
3914 {
3915   Lisp_Object oblength;
3916 
3917   XSETFASTINT (oblength, OBARRAY_SIZE);
3918 
3919   Vobarray = Fmake_vector (oblength, make_number (0));
3920   initial_obarray = Vobarray;
3921   staticpro (&initial_obarray);
3922 
3923   Qunbound = Fmake_symbol (make_pure_c_string ("unbound"));
3924   /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the
3925      NILP (Vpurify_flag) check in intern_c_string.  */
3926   Qnil = make_number (-1); Vpurify_flag = make_number (1);
3927   Qnil = intern_c_string ("nil");
3928 
3929   /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil,
3930      so those two need to be fixed manally.  */
3931   SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound);
3932   XSYMBOL (Qunbound)->function = Qunbound;
3933   XSYMBOL (Qunbound)->plist = Qnil;
3934   /* XSYMBOL (Qnil)->function = Qunbound; */
3935   SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
3936   XSYMBOL (Qnil)->constant = 1;
3937   XSYMBOL (Qnil)->plist = Qnil;
3938 
3939   Qt = intern_c_string ("t");
3940   SET_SYMBOL_VAL (XSYMBOL (Qt), Qt);
3941   XSYMBOL (Qt)->constant = 1;
3942 
3943   /* Qt is correct even if CANNOT_DUMP.  loadup.el will set to nil at end.  */
3944   Vpurify_flag = Qt;
3945 
3946   Qvariable_documentation = intern_c_string ("variable-documentation");
3947   staticpro (&Qvariable_documentation);
3948 
3949   read_buffer_size = 100 + MAX_MULTIBYTE_LENGTH;
3950   read_buffer = (char *) xmalloc (read_buffer_size);
3951 }
3952 
3953 void
3954 defsubr (sname)
3955      struct Lisp_Subr *sname;
3956 {
3957   Lisp_Object sym;
3958   sym = intern_c_string (sname->symbol_name);
3959   XSETPVECTYPE (sname, PVEC_SUBR);
3960   XSETSUBR (XSYMBOL (sym)->function, sname);
3961 }
3962 
3963 #ifdef NOTDEF /* use fset in subr.el now */
3964 void
3965 defalias (sname, string)
3966      struct Lisp_Subr *sname;
3967      char *string;
3968 {
3969   Lisp_Object sym;
3970   sym = intern (string);
3971   XSETSUBR (XSYMBOL (sym)->function, sname);
3972 }
3973 #endif /* NOTDEF */
3974 
3975 /* Define an "integer variable"; a symbol whose value is forwarded
3976    to a C variable of type int.  Sample call:
3977    DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation");  */
3978 void
3979 defvar_int (struct Lisp_Intfwd *i_fwd,
3980             const char *namestring, EMACS_INT *address)
3981 {
3982   Lisp_Object sym;
3983   sym = intern_c_string (namestring);
3984   i_fwd->type = Lisp_Fwd_Int;
3985   i_fwd->intvar = address;
3986   XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
3987   SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd);
3988 }
3989 
3990 /* Similar but define a variable whose value is t if address contains 1,
3991    nil if address contains 0.  */
3992 void
3993 defvar_bool (struct Lisp_Boolfwd *b_fwd,
3994              const char *namestring, int *address)
3995 {
3996   Lisp_Object sym;
3997   sym = intern_c_string (namestring);
3998   b_fwd->type = Lisp_Fwd_Bool;
3999   b_fwd->boolvar = address;
4000   XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4001   SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd);
4002   Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
4003 }
4004 
4005 /* Similar but define a variable whose value is the Lisp Object stored
4006    at address.  Two versions: with and without gc-marking of the C
4007    variable.  The nopro version is used when that variable will be
4008    gc-marked for some other reason, since marking the same slot twice
4009    can cause trouble with strings.  */
4010 void
4011 defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd,
4012                    const char *namestring, Lisp_Object *address)
4013 {
4014   Lisp_Object sym;
4015   sym = intern_c_string (namestring);
4016   o_fwd->type = Lisp_Fwd_Obj;
4017   o_fwd->objvar = address;
4018   XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4019   SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
4020 }
4021 
4022 void
4023 defvar_lisp (struct Lisp_Objfwd *o_fwd,
4024              const char *namestring, Lisp_Object *address)
4025 {
4026   defvar_lisp_nopro (o_fwd, namestring, address);
4027   staticpro (address);
4028 }
4029 
4030 /* Similar but define a variable whose value is the Lisp Object stored
4031    at a particular offset in the current kboard object.  */
4032 
4033 void
4034 defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd,
4035                const char *namestring, int offset)
4036 {
4037   Lisp_Object sym;
4038   sym = intern_c_string (namestring);
4039   ko_fwd->type = Lisp_Fwd_Kboard_Obj;
4040   ko_fwd->offset = offset;
4041   XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
4042   SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
4043 }
4044 
4045 /* Record the value of load-path used at the start of dumping
4046    so we can see if the site changed it later during dumping.  */
4047 static Lisp_Object dump_path;
4048 
4049 void
4050 init_lread ()
4051 {
4052   char *normal;
4053   int turn_off_warning = 0;
4054 
4055   /* Compute the default load-path.  */
4056 #ifdef CANNOT_DUMP
4057   normal = PATH_LOADSEARCH;
4058   Vload_path = decode_env_path (0, normal);
4059 #else
4060   if (NILP (Vpurify_flag))
4061     normal = PATH_LOADSEARCH;
4062   else
4063     normal = PATH_DUMPLOADSEARCH;
4064 
4065   /* In a dumped Emacs, we normally have to reset the value of
4066      Vload_path from PATH_LOADSEARCH, since the value that was dumped
4067      uses ../lisp, instead of the path of the installed elisp
4068      libraries.  However, if it appears that Vload_path was changed
4069      from the default before dumping, don't override that value.  */
4070   if (initialized)
4071     {
4072       if (! NILP (Fequal (dump_path, Vload_path)))
4073         {
4074           Vload_path = decode_env_path (0, normal);
4075           if (!NILP (Vinstallation_directory))
4076             {
4077               Lisp_Object tem, tem1, sitelisp;
4078 
4079               /* Remove site-lisp dirs from path temporarily and store
4080                  them in sitelisp, then conc them on at the end so
4081                  they're always first in path.  */
4082               sitelisp = Qnil;
4083               while (1)
4084                 {
4085                   tem = Fcar (Vload_path);
4086                   tem1 = Fstring_match (build_string ("site-lisp"),
4087                                         tem, Qnil);
4088                   if (!NILP (tem1))
4089                     {
4090                       Vload_path = Fcdr (Vload_path);
4091                       sitelisp = Fcons (tem, sitelisp);
4092                     }
4093                   else
4094                     break;
4095                 }
4096 
4097               /* Add to the path the lisp subdir of the
4098                  installation dir, if it exists.  */
4099               tem = Fexpand_file_name (build_string ("lisp"),
4100                                        Vinstallation_directory);
4101               tem1 = Ffile_exists_p (tem);
4102               if (!NILP (tem1))
4103                 {
4104                   if (NILP (Fmember (tem, Vload_path)))
4105                     {
4106                       turn_off_warning = 1;
4107                       Vload_path = Fcons (tem, Vload_path);
4108                     }
4109                 }
4110               else
4111                 /* That dir doesn't exist, so add the build-time
4112                    Lisp dirs instead.  */
4113                 Vload_path = nconc2 (Vload_path, dump_path);
4114 
4115               /* Add leim under the installation dir, if it exists.  */
4116               tem = Fexpand_file_name (build_string ("leim"),
4117                                        Vinstallation_directory);
4118               tem1 = Ffile_exists_p (tem);
4119               if (!NILP (tem1))
4120                 {
4121                   if (NILP (Fmember (tem, Vload_path)))
4122                     Vload_path = Fcons (tem, Vload_path);
4123                 }
4124 
4125               /* Add site-lisp under the installation dir, if it exists.  */
4126               tem = Fexpand_file_name (build_string ("site-lisp"),
4127                                        Vinstallation_directory);
4128               tem1 = Ffile_exists_p (tem);
4129               if (!NILP (tem1))
4130                 {
4131                   if (NILP (Fmember (tem, Vload_path)))
4132                     Vload_path = Fcons (tem, Vload_path);
4133                 }
4134 
4135               /* If Emacs was not built in the source directory,
4136                  and it is run from where it was built, add to load-path
4137                  the lisp, leim and site-lisp dirs under that directory.  */
4138 
4139               if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
4140                 {
4141                   Lisp_Object tem2;
4142 
4143                   tem = Fexpand_file_name (build_string ("src/Makefile"),
4144                                            Vinstallation_directory);
4145                   tem1 = Ffile_exists_p (tem);
4146 
4147                   /* Don't be fooled if they moved the entire source tree
4148                      AFTER dumping Emacs.  If the build directory is indeed
4149                      different from the source dir, src/Makefile.in and
4150                      src/Makefile will not be found together.  */
4151                   tem = Fexpand_file_name (build_string ("src/Makefile.in"),
4152                                            Vinstallation_directory);
4153                   tem2 = Ffile_exists_p (tem);
4154                   if (!NILP (tem1) && NILP (tem2))
4155                     {
4156                       tem = Fexpand_file_name (build_string ("lisp"),
4157                                                Vsource_directory);
4158 
4159                       if (NILP (Fmember (tem, Vload_path)))
4160                         Vload_path = Fcons (tem, Vload_path);
4161 
4162                       tem = Fexpand_file_name (build_string ("leim"),
4163                                                Vsource_directory);
4164 
4165                       if (NILP (Fmember (tem, Vload_path)))
4166                         Vload_path = Fcons (tem, Vload_path);
4167 
4168                       tem = Fexpand_file_name (build_string ("site-lisp"),
4169                                                Vsource_directory);
4170 
4171                       if (NILP (Fmember (tem, Vload_path)))
4172                         Vload_path = Fcons (tem, Vload_path);
4173                     }
4174                 }
4175               if (!NILP (sitelisp))
4176                 Vload_path = nconc2 (Fnreverse (sitelisp), Vload_path);
4177             }
4178         }
4179     }
4180   else
4181     {
4182       /* NORMAL refers to the lisp dir in the source directory.  */
4183       /* We used to add ../lisp at the front here, but
4184          that caused trouble because it was copied from dump_path
4185          into Vload_path, above, when Vinstallation_directory was non-nil.
4186          It should be unnecessary.  */
4187       Vload_path = decode_env_path (0, normal);
4188       dump_path = Vload_path;
4189     }
4190 #endif
4191 
4192 #if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
4193   /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
4194      almost never correct, thereby causing a warning to be printed out that
4195      confuses users.  Since PATH_LOADSEARCH is always overridden by the
4196      EMACSLOADPATH environment variable below, disable the warning on NT.  */
4197 
4198   /* Warn if dirs in the *standard* path don't exist.  */
4199   if (!turn_off_warning)
4200     {
4201       Lisp_Object path_tail;
4202 
4203       for (path_tail = Vload_path;
4204            !NILP (path_tail);
4205            path_tail = XCDR (path_tail))
4206         {
4207           Lisp_Object dirfile;
4208           dirfile = Fcar (path_tail);
4209           if (STRINGP (dirfile))
4210             {
4211               dirfile = Fdirectory_file_name (dirfile);
4212               if (access (SDATA (dirfile), 0) < 0)
4213                 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
4214                              XCAR (path_tail));
4215             }
4216         }
4217     }
4218 #endif /* !(WINDOWSNT || HAVE_NS) */
4219 
4220   /* If the EMACSLOADPATH environment variable is set, use its value.
4221      This doesn't apply if we're dumping.  */
4222 #ifndef CANNOT_DUMP
4223   if (NILP (Vpurify_flag)
4224       && egetenv ("EMACSLOADPATH"))
4225 #endif
4226     Vload_path = decode_env_path ("EMACSLOADPATH", normal);
4227 
4228   Vvalues = Qnil;
4229 
4230   load_in_progress = 0;
4231   Vload_file_name = Qnil;
4232 
4233   load_descriptor_list = Qnil;
4234 
4235   Vstandard_input = Qt;
4236   Vloads_in_progress = Qnil;
4237 }
4238 
4239 /* Print a warning, using format string FORMAT, that directory DIRNAME
4240    does not exist.  Print it on stderr and put it in *Messages*.  */
4241 
4242 void
4243 dir_warning (format, dirname)
4244      char *format;
4245      Lisp_Object dirname;
4246 {
4247   char *buffer
4248     = (char *) alloca (SCHARS (dirname) + strlen (format) + 5);
4249 
4250   fprintf (stderr, format, SDATA (dirname));
4251   sprintf (buffer, format, SDATA (dirname));
4252   /* Don't log the warning before we've initialized!! */
4253   if (initialized)
4254     message_dolog (buffer, strlen (buffer), 0, STRING_MULTIBYTE (dirname));
4255 }
4256 
4257 void
4258 syms_of_lread ()
4259 {
4260   defsubr (&Sread);
4261   defsubr (&Sread_from_string);
4262   defsubr (&Sintern);
4263   defsubr (&Sintern_soft);
4264   defsubr (&Sunintern);
4265   defsubr (&Sget_load_suffixes);
4266   defsubr (&Sload);
4267   defsubr (&Seval_buffer);
4268   defsubr (&Seval_region);
4269   defsubr (&Sread_char);
4270   defsubr (&Sread_char_exclusive);
4271   defsubr (&Sread_event);
4272   defsubr (&Sget_file_char);
4273   defsubr (&Smapatoms);
4274   defsubr (&Slocate_file_internal);
4275 
4276   DEFVAR_LISP ("obarray", &Vobarray,
4277                doc: /* Symbol table for use by `intern' and `read'.
4278 It is a vector whose length ought to be prime for best results.
4279 The vector's contents don't make sense if examined from Lisp programs;
4280 to find all the symbols in an obarray, use `mapatoms'.  */);
4281 
4282   DEFVAR_LISP ("values", &Vvalues,
4283                doc: /* List of values of all expressions which were read, evaluated and printed.
4284 Order is reverse chronological.  */);
4285 
4286   DEFVAR_LISP ("standard-input", &Vstandard_input,
4287                doc: /* Stream for read to get input from.
4288 See documentation of `read' for possible values.  */);
4289   Vstandard_input = Qt;
4290 
4291   DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions,
4292                doc: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
4293 
4294 If this variable is a buffer, then only forms read from that buffer
4295 will be added to `read-symbol-positions-list'.
4296 If this variable is t, then all read forms will be added.
4297 The effect of all other values other than nil are not currently
4298 defined, although they may be in the future.
4299 
4300 The positions are relative to the last call to `read' or
4301 `read-from-string'.  It is probably a bad idea to set this variable at
4302 the toplevel; bind it instead. */);
4303   Vread_with_symbol_positions = Qnil;
4304 
4305   DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list,
4306                doc: /* A list mapping read symbols to their positions.
4307 This variable is modified during calls to `read' or
4308 `read-from-string', but only when `read-with-symbol-positions' is
4309 non-nil.
4310 
4311 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
4312 CHAR-POSITION is an integer giving the offset of that occurrence of the
4313 symbol from the position where `read' or `read-from-string' started.
4314 
4315 Note that a symbol will appear multiple times in this list, if it was
4316 read multiple times.  The list is in the same order as the symbols
4317 were read in. */);
4318   Vread_symbol_positions_list = Qnil;
4319 
4320   DEFVAR_LISP ("read-circle", &Vread_circle,
4321                doc: /* Non-nil means read recursive structures using #N= and #N# syntax.  */);
4322   Vread_circle = Qt;
4323 
4324   DEFVAR_LISP ("load-path", &Vload_path,
4325                doc: /* *List of directories to search for files to load.
4326 Each element is a string (directory name) or nil (try default directory).
4327 Initialized based on EMACSLOADPATH environment variable, if any,
4328 otherwise to default specified by file `epaths.h' when Emacs was built.  */);
4329 
4330   DEFVAR_LISP ("load-suffixes", &Vload_suffixes,
4331                doc: /* List of suffixes for (compiled or source) Emacs Lisp files.
4332 This list should not include the empty string.
4333 `load' and related functions try to append these suffixes, in order,
4334 to the specified file name if a Lisp suffix is allowed or required.  */);
4335   Vload_suffixes = Fcons (make_pure_c_string (".elc"),
4336                           Fcons (make_pure_c_string (".el"), Qnil));
4337   DEFVAR_LISP ("load-file-rep-suffixes", &Vload_file_rep_suffixes,
4338                doc: /* List of suffixes that indicate representations of \
4339 the same file.
4340 This list should normally start with the empty string.
4341 
4342 Enabling Auto Compression mode appends the suffixes in
4343 `jka-compr-load-suffixes' to this list and disabling Auto Compression
4344 mode removes them again.  `load' and related functions use this list to
4345 determine whether they should look for compressed versions of a file
4346 and, if so, which suffixes they should try to append to the file name
4347 in order to do so.  However, if you want to customize which suffixes
4348 the loading functions recognize as compression suffixes, you should
4349 customize `jka-compr-load-suffixes' rather than the present variable.  */);
4350   Vload_file_rep_suffixes = Fcons (empty_unibyte_string, Qnil);
4351 
4352   DEFVAR_BOOL ("load-in-progress", &load_in_progress,
4353                doc: /* Non-nil if inside of `load'.  */);
4354   Qload_in_progress = intern_c_string ("load-in-progress");
4355   staticpro (&Qload_in_progress);
4356 
4357   DEFVAR_LISP ("after-load-alist", &Vafter_load_alist,
4358                doc: /* An alist of expressions to be evalled when particular files are loaded.
4359 Each element looks like (REGEXP-OR-FEATURE FORMS...).
4360 
4361 REGEXP-OR-FEATURE is either a regular expression to match file names, or
4362 a symbol \(a feature name).
4363 
4364 When `load' is run and the file-name argument matches an element's
4365 REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
4366 REGEXP-OR-FEATURE, the FORMS in the element are executed.
4367 
4368 An error in FORMS does not undo the load, but does prevent execution of
4369 the rest of the FORMS.  */);
4370   Vafter_load_alist = Qnil;
4371 
4372   DEFVAR_LISP ("load-history", &Vload_history,
4373                doc: /* Alist mapping loaded file names to symbols and features.
4374 Each alist element should be a list (FILE-NAME ENTRIES...), where
4375 FILE-NAME is the name of a file that has been loaded into Emacs.
4376 The file name is absolute and true (i.e. it doesn't contain symlinks).
4377 As an exception, one of the alist elements may have FILE-NAME nil,
4378 for symbols and features not associated with any file.
4379 
4380 The remaining ENTRIES in the alist element describe the functions and
4381 variables defined in that file, the features provided, and the
4382 features required.  Each entry has the form `(provide . FEATURE)',
4383 `(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
4384 `(defface . SYMBOL)', or `(t . SYMBOL)'.  In addition, an entry `(t
4385 . SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that
4386 SYMBOL was an autoload before this file redefined it as a function.
4387 
4388 During preloading, the file name recorded is relative to the main Lisp
4389 directory.  These file names are converted to absolute at startup.  */);
4390   Vload_history = Qnil;
4391 
4392   DEFVAR_LISP ("load-file-name", &Vload_file_name,
4393                doc: /* Full name of file being loaded by `load'.  */);
4394   Vload_file_name = Qnil;
4395 
4396   DEFVAR_LISP ("user-init-file", &Vuser_init_file,
4397                doc: /* File name, including directory, of user's initialization file.
4398 If the file loaded had extension `.elc', and the corresponding source file
4399 exists, this variable contains the name of source file, suitable for use
4400 by functions like `custom-save-all' which edit the init file.
4401 While Emacs loads and evaluates the init file, value is the real name
4402 of the file, regardless of whether or not it has the `.elc' extension.  */);
4403   Vuser_init_file = Qnil;
4404 
4405   DEFVAR_LISP ("current-load-list", &Vcurrent_load_list,
4406                doc: /* Used for internal purposes by `load'.  */);
4407   Vcurrent_load_list = Qnil;
4408 
4409   DEFVAR_LISP ("load-read-function", &Vload_read_function,
4410                doc: /* Function used by `load' and `eval-region' for reading expressions.
4411 The default is nil, which means use the function `read'.  */);
4412   Vload_read_function = Qnil;
4413 
4414   DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function,
4415                doc: /* Function called in `load' for loading an Emacs Lisp source file.
4416 This function is for doing code conversion before reading the source file.
4417 If nil, loading is done without any code conversion.
4418 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
4419  FULLNAME is the full name of FILE.
4420 See `load' for the meaning of the remaining arguments.  */);
4421   Vload_source_file_function = Qnil;
4422 
4423   DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings,
4424                doc: /* Non-nil means `load' should force-load all dynamic doc strings.
4425 This is useful when the file being loaded is a temporary copy.  */);
4426   load_force_doc_strings = 0;
4427 
4428   DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte,
4429                doc: /* Non-nil means `read' converts strings to unibyte whenever possible.
4430 This is normally bound by `load' and `eval-buffer' to control `read',
4431 and is not meant for users to change.  */);
4432   load_convert_to_unibyte = 0;
4433 
4434   DEFVAR_LISP ("source-directory", &Vsource_directory,
4435                doc: /* Directory in which Emacs sources were found when Emacs was built.
4436 You cannot count on them to still be there!  */);
4437   Vsource_directory
4438     = Fexpand_file_name (build_string ("../"),
4439                          Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH)));
4440 
4441   DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list,
4442                doc: /* List of files that were preloaded (when dumping Emacs).  */);
4443   Vpreloaded_file_list = Qnil;
4444 
4445   DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars,
4446                doc: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer.  */);
4447   Vbyte_boolean_vars = Qnil;
4448 
4449   DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries,
4450                doc: /* Non-nil means load dangerous compiled Lisp files.
4451 Some versions of XEmacs use different byte codes than Emacs.  These
4452 incompatible byte codes can make Emacs crash when it tries to execute
4453 them.  */);
4454   load_dangerous_libraries = 0;
4455 
4456   DEFVAR_BOOL ("force-load-messages", &force_load_messages,
4457                doc: /* Non-nil means force printing messages when loading Lisp files.
4458 This overrides the value of the NOMESSAGE argument to `load'.  */);
4459   force_load_messages = 0;
4460 
4461   DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp,
4462                doc: /* Regular expression matching safe to load compiled Lisp files.
4463 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
4464 from the file, and matches them against this regular expression.
4465 When the regular expression matches, the file is considered to be safe
4466 to load.  See also `load-dangerous-libraries'.  */);
4467   Vbytecomp_version_regexp
4468     = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
4469 
4470   DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list,
4471                doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'.  */);
4472   Veval_buffer_list = Qnil;
4473 
4474   DEFVAR_LISP ("old-style-backquotes", &Vold_style_backquotes,
4475                doc: /* Set to non-nil when `read' encounters an old-style backquote.  */);
4476   Vold_style_backquotes = Qnil;
4477   Qold_style_backquotes = intern_c_string ("old-style-backquotes");
4478   staticpro (&Qold_style_backquotes);
4479 
4480   /* Vsource_directory was initialized in init_lread.  */
4481 
4482   load_descriptor_list = Qnil;
4483   staticpro (&load_descriptor_list);
4484 
4485   Qcurrent_load_list = intern_c_string ("current-load-list");
4486   staticpro (&Qcurrent_load_list);
4487 
4488   Qstandard_input = intern_c_string ("standard-input");
4489   staticpro (&Qstandard_input);
4490 
4491   Qread_char = intern_c_string ("read-char");
4492   staticpro (&Qread_char);
4493 
4494   Qget_file_char = intern_c_string ("get-file-char");
4495   staticpro (&Qget_file_char);
4496 
4497   Qget_emacs_mule_file_char = intern_c_string ("get-emacs-mule-file-char");
4498   staticpro (&Qget_emacs_mule_file_char);
4499 
4500   Qload_force_doc_strings = intern_c_string ("load-force-doc-strings");
4501   staticpro (&Qload_force_doc_strings);
4502 
4503   Qbackquote = intern_c_string ("`");
4504   staticpro (&Qbackquote);
4505   Qcomma = intern_c_string (",");
4506   staticpro (&Qcomma);
4507   Qcomma_at = intern_c_string (",@");
4508   staticpro (&Qcomma_at);
4509   Qcomma_dot = intern_c_string (",.");
4510   staticpro (&Qcomma_dot);
4511 
4512   Qinhibit_file_name_operation = intern_c_string ("inhibit-file-name-operation");
4513   staticpro (&Qinhibit_file_name_operation);
4514 
4515   Qascii_character = intern_c_string ("ascii-character");
4516   staticpro (&Qascii_character);
4517 
4518   Qfunction = intern_c_string ("function");
4519   staticpro (&Qfunction);
4520 
4521   Qload = intern_c_string ("load");
4522   staticpro (&Qload);
4523 
4524   Qload_file_name = intern_c_string ("load-file-name");
4525   staticpro (&Qload_file_name);
4526 
4527   Qeval_buffer_list = intern_c_string ("eval-buffer-list");
4528   staticpro (&Qeval_buffer_list);
4529 
4530   Qfile_truename = intern_c_string ("file-truename");
4531   staticpro (&Qfile_truename) ;
4532 
4533   Qdo_after_load_evaluation = intern_c_string ("do-after-load-evaluation");
4534   staticpro (&Qdo_after_load_evaluation) ;
4535 
4536   staticpro (&dump_path);
4537 
4538   staticpro (&read_objects);
4539   read_objects = Qnil;
4540   staticpro (&seen_list);
4541   seen_list = Qnil;
4542 
4543   Vloads_in_progress = Qnil;
4544   staticpro (&Vloads_in_progress);
4545 
4546   Qhash_table = intern_c_string ("hash-table");
4547   staticpro (&Qhash_table);
4548   Qdata = intern_c_string ("data");
4549   staticpro (&Qdata);
4550   Qtest = intern_c_string ("test");
4551   staticpro (&Qtest);
4552   Qsize = intern_c_string ("size");
4553   staticpro (&Qsize);
4554   Qweakness = intern_c_string ("weakness");
4555   staticpro (&Qweakness);
4556   Qrehash_size = intern_c_string ("rehash-size");
4557   staticpro (&Qrehash_size);
4558   Qrehash_threshold = intern_c_string ("rehash-threshold");
4559   staticpro (&Qrehash_threshold);
4560 }
4561 
4562 /* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d
4563    (do not change this comment) */