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

75 76 77 78 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
/* 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;
105

106
/* File for get_file_char to read from.  Use by load.  */
Jim Blandy's avatar
Jim Blandy committed
107 108
static FILE *instream;

109
/* For use within read-from-string (this reader is non-reentrant!!)  */
110 111 112
static ptrdiff_t read_from_string_index;
static ptrdiff_t read_from_string_index_byte;
static ptrdiff_t read_from_string_limit;
113

114
/* Number of characters read in the current call to Fread or
115
   Fread_from_string.  */
116
static EMACS_INT readchar_count;
117

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

127 128 129 130 131
/* 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.  */
132
static ptrdiff_t prev_saved_doc_string_size;
133
/* Length of actual data in prev_saved_doc_string.  */
134
static ptrdiff_t prev_saved_doc_string_length;
135
/* This is the file position that string came from.  */
136
static file_offset prev_saved_doc_string_position;
137

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

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

Lute Kamstra's avatar
Lute Kamstra committed
147
static Lisp_Object Vloads_in_progress;
148

149 150
static int read_emacs_mule_char (int, int (*) (int, Lisp_Object),
                                 Lisp_Object);
Kenichi Handa's avatar
Kenichi Handa committed
151

152
static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool,
153 154
                          Lisp_Object, Lisp_Object,
                          Lisp_Object, Lisp_Object);
Jim Blandy's avatar
Jim Blandy committed
155

Kenichi Handa's avatar
Kenichi Handa committed
156 157 158 159 160 161
/* 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.  */

162 163 164
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
165

Jim Blandy's avatar
Jim Blandy committed
166 167
/* Handle unreading and rereading of characters.
   Write READCHAR to read a character,
Karl Heuer's avatar
Karl Heuer committed
168 169
   UNREAD(c) to unread c to be read again.

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

172
#define READCHAR readchar (readcharfun, NULL)
Jim Blandy's avatar
Jim Blandy committed
173 174
#define UNREAD(c) unreadchar (readcharfun, c)

175 176 177
/* 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
178
/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
Kenichi Handa's avatar
Kenichi Handa committed
179 180
   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
181
   means that there's no unread character.  */
Kenichi Handa's avatar
Kenichi Handa committed
182 183
static int unread_char;

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

194 195 196
  if (multibyte)
    *multibyte = 0;

197
  readchar_count++;
198

199
  if (BUFFERP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
200
    {
201
      register struct buffer *inbuffer = XBUFFER (readcharfun);
Jim Blandy's avatar
Jim Blandy committed
202

203
      ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
204

205 206 207
      if (! BUFFER_LIVE_P (inbuffer))
	return -1;

208 209
      if (pt_byte >= BUF_ZV_BYTE (inbuffer))
	return -1;
Jim Blandy's avatar
Jim Blandy committed
210

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

229
      return c;
Jim Blandy's avatar
Jim Blandy committed
230
    }
231
  if (MARKERP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
232
    {
233
      register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
Jim Blandy's avatar
Jim Blandy committed
234

235
      ptrdiff_t bytepos = marker_byte_position (readcharfun);
236

237 238
      if (bytepos >= BUF_ZV_BYTE (inbuffer))
	return -1;
239

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

257 258 259 260
      XMARKER (readcharfun)->bytepos = bytepos;
      XMARKER (readcharfun)->charpos++;

      return c;
Jim Blandy's avatar
Jim Blandy committed
261
    }
262 263

  if (EQ (readcharfun, Qlambda))
Kenichi Handa's avatar
Kenichi Handa committed
264 265 266 267
    {
      readbyte = readbyte_for_lambda;
      goto read_multibyte;
    }
268

Jim Blandy's avatar
Jim Blandy committed
269
  if (EQ (readcharfun, Qget_file_char))
270
    {
Kenichi Handa's avatar
Kenichi Handa committed
271 272
      readbyte = readbyte_from_file;
      goto read_multibyte;
273
    }
Jim Blandy's avatar
Jim Blandy committed
274

275
  if (STRINGP (readcharfun))
Jim Blandy's avatar
Jim Blandy committed
276
    {
277
      if (read_from_string_index >= read_from_string_limit)
Jim Blandy's avatar
Jim Blandy committed
278
	c = -1;
279 280 281 282 283 284 285 286
      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);
	}
287
      else
288 289 290 291 292
	{
	  c = SREF (readcharfun, read_from_string_index_byte);
	  read_from_string_index++;
	  read_from_string_index_byte++;
	}
Jim Blandy's avatar
Jim Blandy committed
293 294 295
      return c;
    }

296
  if (CONSP (readcharfun) && STRINGP (XCAR (readcharfun)))
Kenichi Handa's avatar
Kenichi Handa committed
297 298 299 300 301 302 303 304 305 306 307
    {
      /* 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
308

Kenichi Handa's avatar
Kenichi Handa committed
309 310 311 312 313 314
  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
315 316 317

  tem = call0 (readcharfun);

Jim Blandy's avatar
Jim Blandy committed
318
  if (NILP (tem))
Jim Blandy's avatar
Jim Blandy committed
319 320
    return -1;
  return XINT (tem);
Kenichi Handa's avatar
Kenichi Handa committed
321 322 323 324 325 326 327 328 329

 read_multibyte:
  if (unread_char >= 0)
    {
      c = unread_char;
      unread_char = -1;
      return c;
    }
  c = (*readbyte) (-1, readcharfun);
330
  if (c < 0)
331 332 333
    return c;
  if (multibyte)
    *multibyte = 1;
334
  if (ASCII_CHAR_P (c))
Kenichi Handa's avatar
Kenichi Handa committed
335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351
    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;
    }
352
  return STRING_CHAR (buf);
Jim Blandy's avatar
Jim Blandy committed
353 354
}

Stefan Monnier's avatar
Stefan Monnier committed
355 356 357 358
#define FROM_FILE_P(readcharfun)			\
  (EQ (readcharfun, Qget_file_char)			\
   || EQ (readcharfun, Qget_emacs_mule_file_char))

359 360 361
static void
skip_dyn_bytes (Lisp_Object readcharfun, ptrdiff_t n)
{
Stefan Monnier's avatar
Stefan Monnier committed
362
  if (FROM_FILE_P (readcharfun))
363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381
    {
      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');
    }
}

382 383 384 385 386 387 388 389 390 391 392 393 394
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
395 396 397 398
/* 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
399
unreadchar (Lisp_Object readcharfun, int c)
Jim Blandy's avatar
Jim Blandy committed
400
{
401
  readchar_count--;
402 403 404 405
  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.  */
    ;
406
  else if (BUFFERP (readcharfun))
407
    {
408
      struct buffer *b = XBUFFER (readcharfun);
409 410
      ptrdiff_t charpos = BUF_PT (b);
      ptrdiff_t bytepos = BUF_PT_BYTE (b);
411

Tom Tromey's avatar
Tom Tromey committed
412
      if (! NILP (BVAR (b, enable_multibyte_characters)))
Kenichi Handa's avatar
Kenichi Handa committed
413
	BUF_DEC_POS (b, bytepos);
414
      else
Kenichi Handa's avatar
Kenichi Handa committed
415
	bytepos--;
416

417
      SET_BUF_PT_BOTH (b, charpos - 1, bytepos);
418
    }
419
  else if (MARKERP (readcharfun))
420
    {
421
      struct buffer *b = XMARKER (readcharfun)->buffer;
422
      ptrdiff_t bytepos = XMARKER (readcharfun)->bytepos;
423

Kenichi Handa's avatar
Kenichi Handa committed
424
      XMARKER (readcharfun)->charpos--;
Tom Tromey's avatar
Tom Tromey committed
425
      if (! NILP (BVAR (b, enable_multibyte_characters)))
Kenichi Handa's avatar
Kenichi Handa committed
426
	BUF_DEC_POS (b, bytepos);
427
      else
Kenichi Handa's avatar
Kenichi Handa committed
428
	bytepos--;
429

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

Kenichi Handa's avatar
Kenichi Handa committed
454
static int
455
readbyte_for_lambda (int c, Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
456 457 458 459 460 461
{
  return read_bytecode_char (c >= 0);
}


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

472
  block_input ();
Miles Bader's avatar
Miles Bader committed
473

474
  /* Interrupted reads have been observed while reading over the network.  */
475 476
  while ((c = getc_unlocked (instream)) == EOF && errno == EINTR
	 && ferror_unlocked (instream))
Miles Bader's avatar
Miles Bader committed
477
    {
478
      unblock_input ();
Paul Eggert's avatar
Paul Eggert committed
479
      maybe_quit ();
480
      block_input ();
481
      clearerr_unlocked (instream);
YAMAMOTO Mitsuharu's avatar
YAMAMOTO Mitsuharu committed
482
    }
Miles Bader's avatar
Miles Bader committed
483

484
  unblock_input ();
Miles Bader's avatar
Miles Bader committed
485

Kenichi Handa's avatar
Kenichi Handa committed
486 487 488 489
  return (c == EOF ? -1 : c);
}

static int
490
readbyte_from_string (int c, Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
491 492 493 494 495 496 497 498 499
{
  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
500

Kenichi Handa's avatar
Kenichi Handa committed
501 502 503 504 505 506 507 508 509 510 511 512 513 514 515
  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
516
read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun)
Kenichi Handa's avatar
Kenichi Handa committed
517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544
{
  /* 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)
    {
545
      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
Kenichi Handa's avatar
Kenichi Handa committed
546 547 548 549 550 551 552
      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)
	{
553
	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
Kenichi Handa's avatar
Kenichi Handa committed
554 555 556 557
	  code = buf[2] & 0x7F;
	}
      else
	{
558
	  charset = CHARSET_FROM_ID (emacs_mule_charset[buf[0]]);
Kenichi Handa's avatar
Kenichi Handa committed
559 560 561 562 563
	  code = ((buf[1] << 8) | buf[2]) & 0x7F7F;
	}
    }
  else
    {
564
      charset = CHARSET_FROM_ID (emacs_mule_charset[buf[1]]);
Kenichi Handa's avatar
Kenichi Handa committed
565
      code = ((buf[2] << 8) | buf[3]) & 0x7F7F;
Kenichi Handa's avatar
Kenichi Handa committed
566 567 568 569
    }
  c = DECODE_CHAR (charset, code);
  if (c < 0)
    Fsignal (Qinvalid_read_syntax,
570
	     list1 (build_string ("invalid multibyte form")));
Kenichi Handa's avatar
Kenichi Handa committed
571 572 573 574
  return c;
}


575 576 577
static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object,
                                        Lisp_Object);
static Lisp_Object read0 (Lisp_Object);
578
static Lisp_Object read1 (Lisp_Object, int *, bool);
579

580 581
static Lisp_Object read_list (bool, Lisp_Object);
static Lisp_Object read_vector (Lisp_Object, bool);
582

583 584 585
static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object,
                                              Lisp_Object);
static void substitute_in_interval (INTERVAL, Lisp_Object);
586

Jim Blandy's avatar
Jim Blandy committed
587

588
/* Get a character from the tty.  */
Jim Blandy's avatar
Jim Blandy committed
589

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

592
   If NO_SWITCH_FRAME, switch-frame events are stashed
593 594 595
   until we get a character we like, and then stuffed into
   unread_switch_frame.

596
   If ASCII_REQUIRED, check function key events to see
597 598 599
   if the unmodified version of the symbol has a Qascii_character
   property, and use that character, if present.

600 601 602
   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
603 604
   character.

605
   If INPUT_METHOD, invoke the current input method
606 607
   if the character warrants that.

608
   If SECONDS is a number, wait that many seconds for input, and
609
   return Qnil if no input arrives within that time.  */
610

Andreas Schwab's avatar
Andreas Schwab committed
611
static Lisp_Object
612 613
read_filtered_event (bool no_switch_frame, bool ascii_required,
		     bool error_nonascii, bool input_method, Lisp_Object seconds)
614
{
615
  Lisp_Object val, delayed_switch_frame;
616
  struct timespec end_time;
617

618
#ifdef HAVE_WINDOW_SYSTEM
619 620
  if (display_hourglass_p)
    cancel_hourglass ();
621
#endif
622

623
  delayed_switch_frame = Qnil;
624

625 626 627
  /* Compute timeout.  */
  if (NUMBERP (seconds))
    {
628
      double duration = XFLOATINT (seconds);
629 630
      struct timespec wait_time = dtotimespec (duration);
      end_time = timespec_add (current_timespec (), wait_time);
631 632
    }

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

640
  if (BUFFERP (val))
641 642
    goto retry;

643
  /* `switch-frame' events are put off until after the next ASCII
Karl Heuer's avatar
Karl Heuer committed
644
     character.  This is better than signaling an error just because
645 646 647 648 649
     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)
650
      && EQ (EVENT_HEAD_KIND (EVENT_HEAD (val)), Qswitch_frame))
651 652 653 654 655
    {
      delayed_switch_frame = val;
      goto retry;
    }

656
  if (ascii_required && !(NUMBERP (seconds) && NILP (val)))
657 658
    {
      /* Convert certain symbols to their ASCII equivalents.  */
659
      if (SYMBOLP (val))
660
	{
661
	  Lisp_Object tem, tem1;
662 663 664 665 666 667 668
	  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))
669
		XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
670 671
	    }
	}
672

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

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

689 690
#if 0

691
#ifdef HAVE_WINDOW_SYSTEM
692 693
  if (display_hourglass_p)
    start_hourglass ();
694
#endif
695 696 697

#endif

698 699 700
  return val;
}

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

707 708
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
709 710
exception, switch-frame events are put off until non-character events
can be read.
711 712 713 714 715 716
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
717 718 719 720 721
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
722
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
723
{
724 725
  Lisp_Object val;

726 727
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
728
  val = read_filtered_event (1, 1, 1, ! NILP (inherit_input_method), seconds);
729 730 731

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

Paul Eggert's avatar
Paul Eggert committed
734
DEFUN ("read-event", Fread_event, Sread_event, 0, 3, 0,
735 736 737 738
       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
739 740 741 742 743
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
744
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
745
{
746 747
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
748
  return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method), seconds);
Jim Blandy's avatar
Jim Blandy committed
749 750
}

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

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
760 761 762 763 764
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
765
  (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds)
Jim Blandy's avatar
Jim Blandy committed
766
{
767 768
  Lisp_Object val;

769 770
  if (! NILP (prompt))
    message_with_string ("%s", prompt, 0);
771

772
  val = read_filtered_event (1, 1, 0, ! NILP (inherit_input_method), seconds);
773 774 775

  return (NILP (val) ? Qnil
	  : make_number (char_resolve_modifier_mask (XINT (val))));
Jim Blandy's avatar
Jim Blandy committed
776 777 778
}

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


790 791 792 793


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

797
static bool
Stefan Monnier's avatar
Stefan Monnier committed
798
lisp_file_lexically_bound_p (Lisp_Object readcharfun)
799 800
{
  int ch = READCHAR;
801 802 803 804 805 806 807 808 809 810 811 812 813

  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
814 815
      /* It is OK to leave the position after a #! line, since
         that is what read1 does.  */
816 817
    }

818 819 820 821 822 823 824 825 826
  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.  */
    {
827
      bool rv = 0;
828
      enum {
Paul Eggert's avatar
Paul Eggert committed
829
	NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX
830
      } beg_end_state = NOMINAL;
831
      bool in_file_vars = 0;
832

833 834 835 836 837 838 839 840 841 842
#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;					\
843 844 845 846 847 848 849 850 851 852 853 854
    }

      /* 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)
	{
855
	  char var[100], val[100];
856
	  unsigned i;
857 858 859 860 861 862 863

	  ch = READCHAR;

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

864
	  i = 0;
865
	  while (ch != ':' && ch != '\n' && ch != EOF && in_file_vars)
866
	    {
867 868
	      if (i < sizeof var - 1)
		var[i++] = ch;
869 870 871
	      UPDATE_BEG_END_STATE (ch);
	      ch = READCHAR;
	    }
872

873
	  /* Stop scanning if no colon was found before end marker.  */
874
	  if (!in_file_vars || ch == '\n' || ch == EOF)
875 876
	    break;

877 878 879
	  while (i > 0 && (var[i - 1] == ' ' || var[i - 1] == '\t'))
	    i--;
	  var[i] = '\0';
880 881 882 883 884 885 886 887 888

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

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

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

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

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

      return rv;
    }
}
919

Kenichi Handa's avatar
Kenichi Handa committed
920
/* Value is a version number of byte compiled code if the file
Miles Bader's avatar
Miles Bader committed
921
   associated with file descriptor FD is a compiled Lisp file that's
Kenichi Handa's avatar
Kenichi Handa committed
922 923 924
   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.  */
925 926

static int
927
safe_to_load_version (int fd)
928 929 930
{
  char buf[512];
  int nbytes, i;
Kenichi Handa's avatar
Kenichi Handa committed
931
  int version = 1;
932 933 934

  /* 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
935
  nbytes = emacs_read_quit (fd, buf, sizeof buf);
936 937 938
  if (nbytes > 0)
    {
      /* Skip to the next newline, skipping over the initial `ELC'
Dave Love's avatar
Dave Love committed
939
	 with NUL bytes following it, but note the version.  */
940
      for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
Dave Love's avatar
Dave Love committed
941
	if (i == 4)
Kenichi Handa's avatar
Kenichi Handa committed
942
	  version = buf[i];
943

944
      if (i >= nbytes
945
	  || fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
946
					      buf + i, nbytes - i) < 0)
947
	version = 0;
948 949 950
    }

  lseek (fd, 0, SEEK_SET);
951
  return version;
952 953 954
}


955 956 957
/* Callback for record_unwind_protect.  Restore the old load list OLD,
   after loading a file successfully.  */

958
static void
959
record_load_unwind (Lisp_Object old)
960
{
961
  Vloads_in_progress = old;
962 963
}

964 965 966
/* This handler function is used via internal_condition_case_1.  */

static Lisp_Object
967
load_error_handler (Lisp_Object data)
968 969 970
{
  return Qnil;
}
971

972
static void
973
load_warn_old_style_backquotes (Lisp_Object file)
974
{
975
  if (!NILP (Vlread_old_style_backquotes))
976
    {
977
      AUTO_STRING (format, "Loading `%s': old-style backquotes detected!");
978
      CALLN (Fmessage, format, file);
979
    }
980 981
}

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

Paul Eggert's avatar
Paul Eggert committed
999
DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
1000 1001 1002
       doc: /* Return the suffixes that `load' should try if a suffix is \
required.
This uses the variables `load-suffixes' and `load-file-rep-suffixes'.  */)
Dan Nicolaescu's avatar
Dan Nicolaescu committed
1003
  (void)
1004 1005 1006 1007 1008 1009 1010 1011