lread.c 149 KB
Newer Older
Jim Blandy's avatar
Jim Blandy committed
1
/* Lisp parsing and input streams.
2

Paul Eggert's avatar
Paul Eggert committed
3
Copyright (C) 1985-1989, 1993-1995, 1997-2017 Free Software Foundation,
4
Inc.
Jim Blandy's avatar
Jim Blandy committed
5 6 7

This file is part of GNU Emacs.

8
GNU Emacs is free software: you can redistribute it and/or modify
Jim Blandy's avatar
Jim Blandy committed
9
it under the terms of the GNU General Public License as published by
10 11
the Free Software Foundation, either version 3 of the License, or (at
your option) any later version.
Jim Blandy's avatar
Jim Blandy committed
12 13 14 15 16 17 18

GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

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/>.  */
Jim Blandy's avatar
Jim Blandy committed
20

21 22
/* Tell globals.h to define tables needed by init_obarray.  */
#define DEFINE_SYMBOLS
Jim Blandy's avatar
Jim Blandy committed
23

Richard M. Stallman's avatar
Richard M. Stallman committed
24
#include <config.h>
25
#include "sysstdio.h"
Paul Eggert's avatar
Paul Eggert committed
26
#include <stdlib.h>
Jim Blandy's avatar
Jim Blandy committed
27 28 29
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/file.h>
30
#include <errno.h>
31
#include <math.h>
32
#include <stat-time.h>
Jim Blandy's avatar
Jim Blandy committed
33
#include "lisp.h"
34
#include "dispextern.h"
35
#include "intervals.h"
Kenichi Handa's avatar
Kenichi Handa committed
36
#include "character.h"
37
#include "buffer.h"
Karl Heuer's avatar
Karl Heuer committed
38
#include "charset.h"
39
#include <epaths.h>
Jim Blandy's avatar
Jim Blandy committed
40
#include "commands.h"
Jim Blandy's avatar
Jim Blandy committed
41
#include "keyboard.h"
42
#include "systime.h"
43
#include "termhooks.h"
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
44
#include "blockinput.h"
45
#include <c-ctype.h>
Jim Blandy's avatar
Jim Blandy committed
46

47 48
#ifdef MSDOS
#include "msdos.h"
Eli Zaretskii's avatar
Eli Zaretskii committed
49 50 51 52
#if __DJGPP__ == 2 && __DJGPP_MINOR__ < 5
# define INFINITY  __builtin_inf()
# define NAN       __builtin_nan("")
#endif
53 54
#endif

55 56 57 58
#ifdef HAVE_NS
#include "nsterm.h"
#endif

Andreas Schwab's avatar
Andreas Schwab committed
59
#include <unistd.h>
Jim Blandy's avatar
Jim Blandy committed
60

Richard M. Stallman's avatar
Richard M. Stallman committed
61 62 63 64
#ifdef HAVE_SETLOCALE
#include <locale.h>
#endif /* HAVE_SETLOCALE */

Dave Love's avatar
Dave Love committed
65
#include <fcntl.h>
Richard M. Stallman's avatar
Richard M. Stallman committed
66

67
#ifdef HAVE_FSEEKO
68 69 70 71 72 73 74
#define file_offset off_t
#define file_tell ftello
#else
#define file_offset long
#define file_tell ftell
#endif

Ken Raeburn's avatar
Ken Raeburn committed
75 76 77 78
#ifndef HAVE_GETC_UNLOCKED
#define getc_unlocked getc
#endif

79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108
/* The objects or placeholders read with the #n=object form.

   A hash table maps a number to either a placeholder (while the
   object is still being parsed, in case it's referenced within its
   own definition) or to the completed object.  With small integers
   for keys, it's effectively little more than a vector, but it'll
   manage any needed resizing for us.

   The variable must be reset to an empty hash table before all
   top-level calls to read0.  In between calls, it may be an empty
   hash table left unused from the previous call (to reduce
   allocations), or nil.  */
static Lisp_Object read_objects_map;

/* The recursive objects read with the #n=object form.

   Objects that might have circular references are stored here, so
   that recursive substitution knows not to keep processing them
   multiple times.

   Only objects that are completely processed, including substituting
   references to themselves (but not necessarily replacing
   placeholders for other objects still being read), are stored.

   A hash table is used for efficient lookups of keys.  We don't care
   what the value slots hold.  The variable must be set to an empty
   hash table before all top-level calls to read0.  In between calls,
   it may be an empty hash table left unused from the previous call
   (to reduce allocations), or nil.  */
static Lisp_Object read_objects_completed;
109

110
/* File for get_file_char to read from.  Use by load.  */
Jim Blandy's avatar
Jim Blandy committed
111 112
static FILE *instream;

113
/* For use within read-from-string (this reader is non-reentrant!!)  */
114 115 116
static ptrdiff_t read_from_string_index;
static ptrdiff_t read_from_string_index_byte;
static ptrdiff_t read_from_string_limit;
117

118
/* Number of characters read in the current call to Fread or
119
   Fread_from_string.  */
120
static EMACS_INT readchar_count;
121

122
/* This contains the last string skipped with #@.  */
123 124
static char *saved_doc_string;
/* Length of buffer allocated in saved_doc_string.  */
125
static ptrdiff_t saved_doc_string_size;
126
/* Length of actual data in saved_doc_string.  */
127
static ptrdiff_t saved_doc_string_length;
128
/* This is the file position that string came from.  */
129
static file_offset saved_doc_string_position;
130

131 132 133 134 135
/* This contains the previous string skipped with #@.
   We copy it from saved_doc_string when a new string
   is put in saved_doc_string.  */
static char *prev_saved_doc_string;
/* Length of buffer allocated in prev_saved_doc_string.  */
136
static ptrdiff_t prev_saved_doc_string_size;
137
/* Length of actual data in prev_saved_doc_string.  */
138
static ptrdiff_t prev_saved_doc_string_length;
139
/* This is the file position that string came from.  */
140
static file_offset prev_saved_doc_string_position;
141

142
/* True means inside a new-style backquote
143
   with no surrounding parentheses.
144
   Fread initializes this to false, so we need not specbind it
145
   or worry about what happens to it when there is an error.  */
146
static bool new_backquote_flag;
147 148 149 150

/* A list of file names for files being loaded in Fload.  Used to
   check for recursive loads.  */

Lute Kamstra's avatar
Lute Kamstra committed
151
static Lisp_Object Vloads_in_progress;
152

153 154
static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
                                 Lisp_Object);
Kenichi Handa's avatar
Kenichi Handa committed
155

156
static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool,
157 158
                          Lisp_Object, Lisp_Object,
                          Lisp_Object, Lisp_Object);
Jim Blandy's avatar
Jim Blandy committed
159

Kenichi Handa's avatar
Kenichi Handa committed
160 161 162 163 164 165
/* Functions that read one byte from the current source READCHARFUN
   or unreads one byte.  If the integer argument C is -1, it returns
   one read byte, or -1 when there's no more byte in the source.  If C
   is 0 or positive, it unreads C, and the return value is not
   interesting.  */

166 167 168
static int readbyte_for_lambda (int, Lisp_Object);
static int readbyte_from_file (int, Lisp_Object);
static int readbyte_from_string (int, Lisp_Object);
Kenichi Handa's avatar
Kenichi Handa committed
169

Jim Blandy's avatar
Jim Blandy committed
170 171
/* Handle unreading and rereading of characters.
   Write READCHAR to read a character,
Karl Heuer's avatar
Karl Heuer committed
172 173
   UNREAD(c) to unread c to be read again.

Kenichi Handa's avatar
Kenichi Handa committed
174
   These macros correctly read/unread multibyte characters.  */
Jim Blandy's avatar
Jim Blandy committed
175

176
#define READCHAR readchar (readcharfun, NULL)
Jim Blandy's avatar
Jim Blandy committed
177 178
#define UNREAD(c) unreadchar (readcharfun, c)

179 180 181
/* Same as READCHAR but set *MULTIBYTE to the multibyteness of the source.  */
#define READCHAR_REPORT_MULTIBYTE(multibyte) readchar (readcharfun, multibyte)

Kenichi Handa's avatar
Kenichi Handa committed
182
/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
Kenichi Handa's avatar
Kenichi Handa committed
183 184
   Qlambda, or a cons, we use this to keep an unread character because
   a file stream can't handle multibyte-char unreading.  The value -1
185
   means that there's no unread character.  */
Kenichi Handa's avatar
Kenichi Handa committed
186 187
static int unread_char;

Jim Blandy's avatar
Jim Blandy committed
188
static int
189
readchar (Lisp_Object readcharfun, bool *multibyte)
Jim Blandy's avatar
Jim Blandy committed
190 191
{
  Lisp_Object tem;
192
  register int c;
193
  int (*readbyte) (int, Lisp_Object);
Kenichi Handa's avatar
Kenichi Handa committed
194 195
  unsigned char buf[MAX_MULTIBYTE_LENGTH];
  int i, len;
196
  bool emacs_mule_encoding = 0;
Jim Blandy's avatar
Jim Blandy committed
197

198 199 200
  if (multibyte)
    *multibyte = 0;

201
  readchar_count++;
202

203
  if (BUFFERP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
204
    {
205
      register struct buffer *inbuffer = XBUFFER (readcharfun);
Jim Blandy's avatar
Jim Blandy committed
206

207
      ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
208

209 210 211
      if (! BUFFER_LIVE_P (inbuffer))
	return -1;

212 213
      if (pt_byte >= BUF_ZV_BYTE (inbuffer))
	return -1;
Jim Blandy's avatar
Jim Blandy committed
214

Tom Tromey's avatar
Tom Tromey committed
215
      if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
216
	{
217
	  /* Fetch the character code from the buffer.  */
218 219
	  unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
	  BUF_INC_POS (inbuffer, pt_byte);
220
	  c = STRING_CHAR (p);
221 222
	  if (multibyte)
	    *multibyte = 1;
223 224 225 226
	}
      else
	{
	  c = BUF_FETCH_BYTE (inbuffer, pt_byte);
227
	  if (! ASCII_CHAR_P (c))
Kenichi Handa's avatar
Kenichi Handa committed
228
	    c = BYTE8_TO_CHAR (c);
229
	  pt_byte++;
230
	}
231
      SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
232

233
      return c;
Jim Blandy's avatar
Jim Blandy committed
234
    }
235
  if (MARKERP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
236
    {
237
      register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
Jim Blandy's avatar
Jim Blandy committed
238

239
      ptrdiff_t bytepos = marker_byte_position (readcharfun);
240

241 242
      if (bytepos >= BUF_ZV_BYTE (inbuffer))
	return -1;
243

Tom Tromey's avatar
Tom Tromey committed
244
      if (! NILP (BVAR (inbuffer, enable_multibyte_characters)))
245
	{
246
	  /* Fetch the character code from the buffer.  */
247 248
	  unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
	  BUF_INC_POS (inbuffer, bytepos);
249
	  c = STRING_CHAR (p);
250 251
	  if (multibyte)
	    *multibyte = 1;
252 253 254 255
	}
      else
	{
	  c = BUF_FETCH_BYTE (inbuffer, bytepos);
256
	  if (! ASCII_CHAR_P (c))
Kenichi Handa's avatar
Kenichi Handa committed
257
	    c = BYTE8_TO_CHAR (c);
258
	  bytepos++;
259 260
	}

261 262 263 264
      XMARKER (readcharfun)->bytepos = bytepos;
      XMARKER (readcharfun)->charpos++;

      return c;
Jim Blandy's avatar
Jim Blandy committed
265
    }
266 267

  if (EQ (readcharfun, Qlambda))
Kenichi Handa's avatar
Kenichi Handa committed
268 269 270 271
    {
      readbyte = readbyte_for_lambda;
      goto read_multibyte;
    }
272

Jim Blandy's avatar
Jim Blandy committed
273
  if (EQ (readcharfun, Qget_file_char))
274
    {
Kenichi Handa's avatar
Kenichi Handa committed
275 276
      readbyte = readbyte_from_file;
      goto read_multibyte;
277
    }
Jim Blandy's avatar
Jim Blandy committed
278

279
  if (STRINGP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
280
    {
281
      if (read_from_string_index >= read_from_string_limit)
Jim Blandy's avatar
Jim Blandy committed
282
	c = -1;
283 284 285 286 287 288 289 290
      else if (STRING_MULTIBYTE (readcharfun))
	{
	  if (multibyte)
	    *multibyte = 1;
	  FETCH_STRING_CHAR_ADVANCE_NO_CHECK (c, readcharfun,
					      read_from_string_index,
					      read_from_string_index_byte);
	}
291
      else
292 293 294 295 296
	{
	  c = SREF (readcharfun, read_from_string_index_byte);
	  read_from_string_index++;
	  read_from_string_index_byte++;
	}
Jim Blandy's avatar
Jim Blandy committed
297 298 299
      return c;
    }

300
  if (CONSP (readcharfun) && STRINGP (XCAR (readcharfun)))
Kenichi Handa's avatar
Kenichi Handa committed
301 302 303 304 305 306 307 308 309 310 311
    {
      /* This is the case that read_vector is reading from a unibyte
	 string that contains a byte sequence previously skipped
	 because of #@NUMBER.  The car part of readcharfun is that
	 string, and the cdr part is a value of readcharfun given to
	 read_vector.  */
      readbyte = readbyte_from_string;
      if (EQ (XCDR (readcharfun), Qget_emacs_mule_file_char))
	emacs_mule_encoding = 1;
      goto read_multibyte;
    }
Kenichi Handa's avatar
Kenichi Handa committed
312

Kenichi Handa's avatar
Kenichi Handa committed
313 314 315 316 317 318
  if (EQ (readcharfun, Qget_emacs_mule_file_char))
    {
      readbyte = readbyte_from_file;
      emacs_mule_encoding = 1;
      goto read_multibyte;
    }
Jim Blandy's avatar
Jim Blandy committed
319 320 321

  tem = call0 (readcharfun);

Jim Blandy's avatar
Jim Blandy committed
322
  if (NILP (tem))
Jim Blandy's avatar
Jim Blandy committed
323 324
    return -1;
  return XINT (tem);
Kenichi Handa's avatar
Kenichi Handa committed
325 326 327 328 329 330 331 332 333

 read_multibyte:
  if (unread_char >= 0)
    {
      c = unread_char;
      unread_char = -1;
      return c;
    }
  c = (*readbyte) (-1, readcharfun);
334
  if (c < 0)
335 336 337
    return c;
  if (multibyte)
    *multibyte = 1;
338
  if (ASCII_CHAR_P (c))
Kenichi Handa's avatar
Kenichi Handa committed
339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355
    return c;
  if (emacs_mule_encoding)
    return read_emacs_mule_char (c, readbyte, readcharfun);
  i = 0;
  buf[i++] = c;
  len = BYTES_BY_CHAR_HEAD (c);
  while (i < len)
    {
      c = (*readbyte) (-1, readcharfun);
      if (c < 0 || ! TRAILING_CODE_P (c))
	{
	  while (--i > 1)
	    (*readbyte) (buf[i], readcharfun);
	  return BYTE8_TO_CHAR (buf[0]);
	}
      buf[i++] = c;
    }
356
  return STRING_CHAR (buf);
Jim Blandy's avatar
Jim Blandy committed
357 358
}

Stefan Monnier's avatar
Stefan Monnier committed
359 360 361 362
#define FROM_FILE_P(readcharfun)			\
  (EQ (readcharfun, Qget_file_char)			\
   || EQ (readcharfun, Qget_emacs_mule_file_char))

363 364 365
static void
skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
{
Stefan Monnier's avatar
Stefan Monnier committed
366
  if (FROM_FILE_P (readcharfun))
367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385
    {
      block_input ();		/* FIXME: Not sure if it's needed.  */
      fseek (instream, n, SEEK_CUR);
      unblock_input ();
    }
  else
    { /* We're not reading directly from a file.  In that case, it's difficult
	 to reliably count bytes, since these are usually meant for the file's
	 encoding, whereas we're now typically in the internal encoding.
	 But luckily, skip_dyn_bytes is used to skip over a single
	 dynamic-docstring (or dynamic byte-code) which is always quoted such
	 that \037 is the final char.  */
      int c;
      do {
	c = READCHAR;
      } while (c >= 0 && c != '\037');
    }
}

386 387 388 389 390 391 392 393 394 395 396 397 398
static void
skip_dyn_eof (Lisp_Object readcharfun)
{
  if (FROM_FILE_P (readcharfun))
    {
      block_input ();		/* FIXME: Not sure if it's needed.  */
      fseek (instream, 0, SEEK_END);
      unblock_input ();
    }
  else
    while (READCHAR >= 0);
}

Jim Blandy's avatar
Jim Blandy committed
399 400 401 402
/* Unread the character C in the way appropriate for the stream READCHARFUN.
   If the stream is a user function, call it with the char as argument.  */

static void
403
unreadchar (Lisp_Object readcharfun, int c)
Jim Blandy's avatar
Jim Blandy committed
404
{
405
  readchar_count--;
406 407 408 409
  if (c == -1)
    /* Don't back up the pointer if we're unreading the end-of-input mark,
       since readchar didn't advance it when we read it.  */
    ;
410
  else if (BUFFERP (readcharfun))
411
    {
412
      struct buffer *b = XBUFFER (readcharfun);
413 414
      ptrdiff_t charpos = BUF_PT (b);
      ptrdiff_t bytepos = BUF_PT_BYTE (b);
415

Tom Tromey's avatar
Tom Tromey committed
416
      if (! NILP (BVAR (b, enable_multibyte_characters)))
Kenichi Handa's avatar
Kenichi Handa committed
417
	BUF_DEC_POS (b, bytepos);
418
      else
Kenichi Handa's avatar
Kenichi Handa committed
419
	bytepos--;
420

421
      SET_BUF_PT_BOTH (b, charpos - 1, bytepos);
422
    }
423
  else if (MARKERP (readcharfun))
424
    {
425
      struct buffer *b = XMARKER (readcharfun)->buffer;
426
      ptrdiff_t bytepos = XMARKER (readcharfun)->bytepos;
427

Kenichi Handa's avatar
Kenichi Handa committed
428
      XMARKER (readcharfun)->charpos--;
Tom Tromey's avatar
Tom Tromey committed
429
      if (! NILP (BVAR (b, enable_multibyte_characters)))
Kenichi Handa's avatar
Kenichi Handa committed
430
	BUF_DEC_POS (b, bytepos);
431
      else
Kenichi Handa's avatar
Kenichi Handa committed
432
	bytepos--;
433

Kenichi Handa's avatar
Kenichi Handa committed
434
      XMARKER (readcharfun)->bytepos = bytepos;
435
    }
436
  else if (STRINGP (readcharfun))
437 438 439 440 441
    {
      read_from_string_index--;
      read_from_string_index_byte
	= string_char_to_byte (readcharfun, read_from_string_index);
    }
442
  else if (CONSP (readcharfun) && STRINGP (XCAR (readcharfun)))
Kenichi Handa's avatar
Kenichi Handa committed
443 444 445
    {
      unread_char = c;
    }
446
  else if (EQ (readcharfun, Qlambda))
Kenichi Handa's avatar
Kenichi Handa committed
447 448 449
    {
      unread_char = c;
    }
Stefan Monnier's avatar
Stefan Monnier committed
450
  else if (FROM_FILE_P (readcharfun))
Kenichi Handa's avatar
Kenichi Handa committed
451
    {
452
      unread_char = c;
Kenichi Handa's avatar
Kenichi Handa committed
453
    }
Jim Blandy's avatar
Jim Blandy committed
454 455 456 457
  else
    call1 (readcharfun, make_number (c));
}

Kenichi Handa's avatar
Kenichi Handa committed
458
static int
459
readbyte_for_lambda (int c, Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
460 461 462 463 464 465
{
  return read_bytecode_char (c >= 0);
}


static int
466
readbyte_from_file (int c, Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
467 468 469
{
  if (c >= 0)
    {
470
      block_input ();
Kenichi Handa's avatar
Kenichi Handa committed
471
      ungetc (c, instream);
472
      unblock_input ();
Kenichi Handa's avatar
Kenichi Handa committed
473 474 475
      return 0;
    }

476
  block_input ();
Ken Raeburn's avatar
Ken Raeburn committed
477
  c = getc_unlocked (instream);
Miles Bader's avatar
Miles Bader committed
478

479
  /* Interrupted reads have been observed while reading over the network.  */
Miles Bader's avatar
Miles Bader committed
480 481
  while (c == EOF && ferror (instream) && errno == EINTR)
    {
482
      unblock_input ();
Paul Eggert's avatar
Paul Eggert committed
483
      maybe_quit ();
484
      block_input ();
Miles Bader's avatar
Miles Bader committed
485
      clearerr (instream);
Ken Raeburn's avatar
Ken Raeburn committed
486
      c = getc_unlocked (instream);
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
487
    }
Miles Bader's avatar
Miles Bader committed
488

489
  unblock_input ();
Miles Bader's avatar
Miles Bader committed
490

Kenichi Handa's avatar
Kenichi Handa committed
491 492 493 494
  return (c == EOF ? -1 : c);
}

static int
495
readbyte_from_string (int c, Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
496 497 498 499 500 501 502 503 504
{
  Lisp_Object string = XCAR (readcharfun);

  if (c >= 0)
    {
      read_from_string_index--;
      read_from_string_index_byte
	= string_char_to_byte (string, read_from_string_index);
    }
Kenichi Handa's avatar
Kenichi Handa committed
505

Kenichi Handa's avatar
Kenichi Handa committed
506 507 508 509 510 511 512 513 514 515 516 517 518 519 520
  if (read_from_string_index >= read_from_string_limit)
    c = -1;
  else
    FETCH_STRING_CHAR_ADVANCE (c, string,
			       read_from_string_index,
			       read_from_string_index_byte);
  return c;
}


/* Read one non-ASCII character from INSTREAM.  The character is
   encoded in `emacs-mule' and the first byte is already read in
   C.  */

static int
521
read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549
{
  /* Emacs-mule coding uses at most 4-byte for one character.  */
  unsigned char buf[4];
  int len = emacs_mule_bytes[c];
  struct charset *charset;
  int i;
  unsigned code;

  if (len == 1)
    /* C is not a valid leading-code of `emacs-mule'.  */
    return BYTE8_TO_CHAR (c);

  i = 0;
  buf[i++] = c;
  while (i < len)
    {
      c = (*readbyte) (-1, readcharfun);
      if (c < 0xA0)
	{
	  while (--i > 1)
	    (*readbyte) (buf[i], readcharfun);
	  return BYTE8_TO_CHAR (buf[0]);
	}
      buf[i++] = c;
    }

  if (len == 2)
    {
550
      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
Kenichi Handa's avatar
Kenichi Handa committed
551 552 553 554 555 556 557
      code = buf[1] & 0x7F;
    }
  else if (len == 3)
    {
      if (buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_11
	  || buf[0] == EMACS_MULE_LEADING_CODE_PRIVATE_12)
	{
558
	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
Kenichi Handa's avatar
Kenichi Handa committed
559 560 561 562
	  code = buf[2] & 0x7F;
	}
      else
	{
563
	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
Kenichi Handa's avatar
Kenichi Handa committed
564 565 566 567 568
	  code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
	}
    }
  else
    {
569
      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
Kenichi Handa's avatar
Kenichi Handa committed
570
      code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
Kenichi Handa's avatar
Kenichi Handa committed
571 572 573 574
    }
  c = DECODE_CHAR (charset, code);
  if (c < 0)
    Fsignal (Qinvalid_read_syntax,
575
	     list1 (build_string ("invalid multibyte form")));
Kenichi Handa's avatar
Kenichi Handa committed
576 577 578 579
  return c;
}


580 581 582
static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
                                        Lisp_Object);
static Lisp_Object read0 (Lisp_Object);
583
static Lisp_Object read1 (Lisp_Object, int *, bool);
584

585 586
static Lisp_Object read_list (bool, Lisp_Object);
static Lisp_Object read_vector (Lisp_Object, bool);
587

588 589 590
static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object,
                                              Lisp_Object);
static void substitute_in_interval (INTERVAL, Lisp_Object);
591

Jim Blandy's avatar
Jim Blandy committed
592

593
/* Get a character from the tty.  */
Jim Blandy's avatar
Jim Blandy committed
594

595 596
/* Read input events until we get one that's acceptable for our purposes.

597
   If NO_SWITCH_FRAME, switch-frame events are stashed
598 599 600
   until we get a character we like, and then stuffed into
   unread_switch_frame.

601
   If ASCII_REQUIRED, check function key events to see
602 603 604
   if the unmodified version of the symbol has a Qascii_character
   property, and use that character, if present.

605 606 607
   If ERROR_NONASCII, signal an error if the input we
   get isn't an ASCII character with modifiers.  If it's false but
   ASCII_REQUIRED is true, just re-read until we get an ASCII
608 609
   character.

610
   If INPUT_METHOD, invoke the current input method
611 612
   if the character warrants that.

613
   If SECONDS is a number, wait that many seconds for input, and
614
   return Qnil if no input arrives within that time.  */
615

Andreas Schwab's avatar
Andreas Schwab committed
616
static Lisp_Object
617 618
read_filtered_event (bool no_switch_frame, bool ascii_required,
		     bool error_nonascii, bool input_method, Lisp_Object seconds)
619
{
620
  Lisp_Object val, delayed_switch_frame;
621
  struct timespec end_time;
622

623
#ifdef HAVE_WINDOW_SYSTEM
624 625
  if (display_hourglass_p)
    cancel_hourglass ();
626
#endif
627

628
  delayed_switch_frame = Qnil;
629

630 631 632
  /* Compute timeout.  */
  if (NUMBERP (seconds))
    {
633
      double duration = XFLOATINT (seconds);
634 635
      struct timespec wait_time = dtotimespec (duration);
      end_time = timespec_add (current_timespec (), wait_time);
636 637
    }

638
  /* Read until we get an acceptable event.  */
639
 retry:
640
  do
641
    val = read_char (0, Qnil, (input_method ? Qnil : Qt), 0,
Karoly Lorentey's avatar
Karoly Lorentey committed
642
		     NUMBERP (seconds) ? &end_time : NULL);
643
  while (INTEGERP (val) && XINT (val) == -2); /* wrong_kboard_jmpbuf */
644

645
  if (BUFFERP (val))
646 647
    goto retry;

648
  /* `switch-frame' events are put off until after the next ASCII
Karl Heuer's avatar
Karl Heuer committed
649
     character.  This is better than signaling an error just because
650 651 652 653 654
     the last characters were typed to a separate minibuffer frame,
     for example.  Eventually, some code which can deal with
     switch-frame events will read it and process it.  */
  if (no_switch_frame
      && EVENT_HAS_PARAMETERS (val)
655
      && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
656 657 658 659 660
    {
      delayed_switch_frame = val;
      goto retry;
    }

661
  if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
662 663
    {
      /* Convert certain symbols to their ASCII equivalents.  */
664
      if (SYMBOLP (val))
665
	{
666
	  Lisp_Object tem, tem1;
667 668 669 670 671 672 673
	  tem = Fget (val, Qevent_symbol_element_mask);
	  if (!NILP (tem))
	    {
	      tem1 = Fget (Fcar (tem), Qascii_character);
	      /* Merge this symbol's modifier bits
		 with the ASCII equivalent of its basic code.  */
	      if (!NILP (tem1))
674
		XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
675 676
	    }
	}
677

678
      /* If we don't have a character now, deal with it appropriately.  */
679
      if (!INTEGERP (val))
680 681 682
	{
	  if (error_nonascii)
	    {
683
	      Vunread_command_events = list1 (val);
684 685 686 687 688 689 690 691 692 693
	      error ("Non-character input-event");
	    }
	  else
	    goto retry;
	}
    }

  if (! NILP (delayed_switch_frame))
    unread_switch_frame = delayed_switch_frame;

694 695
#if 0

696
#ifdef HAVE_WINDOW_SYSTEM
697 698
  if (display_hourglass_p)
    start_hourglass ();
699
#endif
700 701 702

#endif

703 704 705
  return val;
}

Paul Eggert's avatar
Paul Eggert committed
706
DEFUN ("read-char", Fread_char, Sread_char, 0, 3, 0,
707 708
       doc: /* Read a character from the command input (keyboard or macro).
It is returned as a number.
709 710 711
If the character has modifiers, they are resolved and reflected to the
character code if possible (e.g. C-SPC -> 0).

712 713
If the user generates an event which is not a character (i.e. a mouse
click or function key event), `read-char' signals an error.  As an
714 715
exception, switch-frame events are put off until non-character events
can be read.
716 717 718 719 720 721
If you want to read non-character events, or ignore them, call
`read-event' or `read-char-exclusive' instead.

If the optional argument PROMPT is non-nil, display that as a prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
722 723 724 725 726
is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input.  If no
input arrives in that time, return nil.  SECONDS may be a
floating-point value.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
727
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
728
{
729 730
  Lisp_Object val;

731 732
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
733
  val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
734 735 736

  return (NILP (val) ? Qnil
	  : make_number (char_resolve_modifier_mask (XINT (val))));
Jim Blandy's avatar
Jim Blandy committed
737 738
}

Paul Eggert's avatar
Paul Eggert committed
739
DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
740 741 742 743
       doc: /* Read an event object from the input stream.
If the optional argument PROMPT is non-nil, display that as a prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
744 745 746 747 748
is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input.  If no
input arrives in that time, return nil.  SECONDS may be a
floating-point value.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
749
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
750
{
751 752
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
753
  return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
Jim Blandy's avatar
Jim Blandy committed
754 755
}

756
DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 3, 0,
757 758
       doc: /* Read a character from the command input (keyboard or macro).
It is returned as a number.  Non-character events are ignored.
759 760
If the character has modifiers, they are resolved and reflected to the
character code if possible (e.g. C-SPC -> 0).
761 762 763 764

If the optional argument PROMPT is non-nil, display that as a prompt.
If the optional argument INHERIT-INPUT-METHOD is non-nil and some
input method is turned on in the current buffer, that input method
765 766 767 768 769
is used for reading a character.
If the optional argument SECONDS is non-nil, it should be a number
specifying the maximum number of seconds to wait for input.  If no
input arrives in that time, return nil.  SECONDS may be a
floating-point value.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
770
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
771
{
772 773
  Lisp_Object val;

774 775
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
776

777
  val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
778 779 780

  return (NILP (val) ? Qnil
	  : make_number (char_resolve_modifier_mask (XINT (val))));
Jim Blandy's avatar
Jim Blandy committed
781 782 783
}

DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
784
       doc: /* Don't use this yourself.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
785
  (void)
Jim Blandy's avatar
Jim Blandy committed
786 787
{
  register Lisp_Object val;
788
  block_input ();
Ken Raeburn's avatar
Ken Raeburn committed
789
  XSETINT (val, getc_unlocked (instream));
790
  unblock_input ();
Jim Blandy's avatar
Jim Blandy committed
791 792
  return val;
}
793 794


795 796 797 798


/* Return true if the lisp code read using READCHARFUN defines a non-nil
   `lexical-binding' file variable.  After returning, the stream is
799 800
   positioned following the first line, if it is a comment or #! line,
   otherwise nothing is read.  */
801

802
static bool
Stefan Monnier's avatar
Stefan Monnier committed
803
lisp_file_lexically_bound_p (Lisp_Object readcharfun)
804 805
{
  int ch = READCHAR;
806 807 808 809 810 811 812 813 814 815 816 817 818

  if (ch == '#')
    {
      ch = READCHAR;
      if (ch != '!')
        {
          UNREAD (ch);
          UNREAD ('#');
          return 0;
        }
      while (ch != '\n' && ch != EOF)
        ch = READCHAR;
      if (ch == '\n') ch = READCHAR;
Glenn Morris's avatar
Comment  
Glenn Morris committed
819 820
      /* It is OK to leave the position after a #! line, since
         that is what read1 does.  */
821 822
    }

823 824 825 826 827 828 829 830 831
  if (ch != ';')
    /* The first line isn't a comment, just give up.  */
    {
      UNREAD (ch);
      return 0;
    }
  else
    /* Look for an appropriate file-variable in the first line.  */
    {
832
      bool rv = 0;
833
      enum {
Paul Eggert's avatar
Paul Eggert committed
834
	NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX
835
      } beg_end_state = NOMINAL;
836
      bool in_file_vars = 0;
837

838 839 840 841 842 843 844 845 846 847
#define UPDATE_BEG_END_STATE(ch)				\
  if (beg_end_state == NOMINAL)					\
    beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL);	\
  else if (beg_end_state == AFTER_FIRST_DASH)			\
    beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL);	\
  else if (beg_end_state == AFTER_ASTERIX)			\
    {								\
      if (ch == '-')						\
	in_file_vars = !in_file_vars;				\
      beg_end_state = NOMINAL;					\
848 849 850 851 852 853 854 855 856 857 858 859
    }

      /* Skip until we get to the file vars, if any.  */
      do
	{
	  ch = READCHAR;
	  UPDATE_BEG_END_STATE (ch);
	}
      while (!in_file_vars && ch != '\n' && ch != EOF);

      while (in_file_vars)
	{
860
	  char var[100], val[100];
861
	  unsigned i;
862 863 864 865 866 867 868

	  ch = READCHAR;

	  /* Read a variable name.  */
	  while (ch == ' ' || ch == '\t')
	    ch = READCHAR;

869
	  i = 0;
870
	  while (ch != ':' && ch != '\n' && ch != EOF && in_file_vars)
871
	    {
872 873
	      if (i < sizeof var - 1)
		var[i++] = ch;
874 875 876
	      UPDATE_BEG_END_STATE (ch);
	      ch = READCHAR;
	    }
877

878
	  /* Stop scanning if no colon was found before end marker.  */
879
	  if (!in_file_vars || ch == '\n' || ch == EOF)
880 881
	    break;

882 883 884
	  while (i > 0 && (var[i - 1] == ' ' || var[i - 1] == '\t'))
	    i--;
	  var[i] = '\0';
885 886 887 888 889 890 891 892 893

	  if (ch == ':')
	    {
	      /* Read a variable value.  */
	      ch = READCHAR;

	      while (ch == ' ' || ch == '\t')
		ch = READCHAR;

894
	      i = 0;
895 896
	      while (ch != ';' && ch != '\n' && ch != EOF && in_file_vars)
		{
897 898
		  if (i < sizeof val - 1)
		    val[i++] = ch;
899 900 901 902
		  UPDATE_BEG_END_STATE (ch);
		  ch = READCHAR;
		}
	      if (! in_file_vars)
903
		/* The value was terminated by an end-marker, which remove.  */
904 905 906 907
		i -= 3;
	      while (i > 0 && (val[i - 1] == ' ' || val[i - 1] == '\t'))
		i--;
	      val[i] = '\0';
908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923

	      if (strcmp (var, "lexical-binding") == 0)
		/* This is it...  */
		{
		  rv = (strcmp (val, "nil") != 0);
		  break;
		}
	    }
	}

      while (ch != '\n' && ch != EOF)
	ch = READCHAR;

      return rv;
    }
}
924

Kenichi Handa's avatar
Kenichi Handa committed
925
/* Value is a version number of byte compiled code if the file
Miles Bader's avatar
Miles Bader committed
926
   associated with file descriptor FD is a compiled Lisp file that's
Kenichi Handa's avatar
Kenichi Handa committed
927 928 929
   safe to load.  Only files compiled with Emacs are safe to load.
   Files compiled with XEmacs can lead to a crash in Fbyte_code
   because of an incompatible change in the byte compiler.  */
930 931

static int
932
safe_to_load_version (int fd)
933 934 935
{
  char buf[512];
  int nbytes, i;
Kenichi Handa's avatar
Kenichi Handa committed
936
  int version = 1;
937 938 939

  /* Read the first few bytes from the file, and look for a line
     specifying the byte compiler version used.  */
Paul Eggert's avatar
Paul Eggert committed
940
  nbytes = emacs_read_quit (fd, buf, sizeof buf);
941 942 943
  if (nbytes > 0)
    {
      /* Skip to the next newline, skipping over the initial `ELC'
Dave Love's avatar
Dave Love committed
944
	 with NUL bytes following it, but note the version.  */
945
      for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
Dave Love's avatar
Dave Love committed
946
	if (i == 4)
Kenichi Handa's avatar
Kenichi Handa committed
947
	  version = buf[i];
948

949
      if (i >= nbytes
950
	  || fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
951
					      buf + i, nbytes - i) < 0)
952
	version = 0;
953 954 955
    }

  lseek (fd, 0, SEEK_SET);
956
  return version;
957 958 959
}


960 961 962
/* Callback for record_unwind_protect.  Restore the old load list OLD,
   after loading a file successfully.  */

963
static void
964
record_load_unwind (Lisp_Object old)
965
{
966
  Vloads_in_progress = old;
967 968
}

969 970 971
/* This handler function is used via internal_condition_case_1.  */

static Lisp_Object
972
load_error_handler (Lisp_Object data)
973 974 975
{
  return Qnil;
}
976

977
static void
978
load_warn_old_style_backquotes (Lisp_Object file)
979
{
980
  if (!NILP (Vlread_old_style_backquotes))
981
    {
982
      AUTO_STRING (format, "Loading `%s': old-style backquotes detected!");
983
      CALLN (Fmessage, format, file);
984
    }
985 986
}

987 988 989 990 991
static void
load_warn_unescaped_character_literals (Lisp_Object file)
{
  if (NILP (Vlread_unescaped_character_literals)) return;
  CHECK_CONS (Vlread_unescaped_character_literals);
992 993 994 995
  Lisp_Object format =
    build_string ("Loading `%s': unescaped character literals %s detected!");
  Lisp_Object separator = build_string (", ");
  Lisp_Object inner_format = build_string ("`?%c'");
996 997
  CALLN (Fmessage,
         format, file,
998 999
         Fmapconcat (list3 (Qlambda, list1 (Qchar),
                            list3 (Qformat, inner_format, Qchar)),
1000 1001 1002 1003
                     Fsort (Vlread_unescaped_character_literals, Qlss),
                     separator));
}

Paul Eggert's avatar
Paul Eggert committed
1004
DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
1005 1006 1007
       doc: /* Return the suffixes that `load' should try if a suffix is \
required.
This uses the variables `load-suffixes' and `load-file-rep-suffixes'.  */)