*** empty log message ***
[emacs.git] / src / lread.c
blobe40d5680c8654062c97833a83d8bb1cc7a3c64d2
1 /* Lisp parsing and input streams.
2 Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 2001
3 Free Software Foundation, Inc.
5 This file is part of GNU Emacs.
7 GNU Emacs is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2, or (at your option)
10 any later version.
12 GNU Emacs is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with GNU Emacs; see the file COPYING. If not, write to
19 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
20 Boston, MA 02111-1307, USA. */
23 #include <config.h>
24 #include <stdio.h>
25 #include <sys/types.h>
26 #include <sys/stat.h>
27 #include <sys/file.h>
28 #include <errno.h>
29 #include "lisp.h"
30 #include "intervals.h"
31 #include "buffer.h"
32 #include "charset.h"
33 #include <epaths.h>
34 #include "commands.h"
35 #include "keyboard.h"
36 #include "termhooks.h"
37 #include "coding.h"
39 #ifdef lint
40 #include <sys/inode.h>
41 #endif /* lint */
43 #ifdef MSDOS
44 #if __DJGPP__ < 2
45 #include <unistd.h> /* to get X_OK */
46 #endif
47 #include "msdos.h"
48 #endif
50 #ifdef HAVE_UNISTD_H
51 #include <unistd.h>
52 #endif
54 #ifndef X_OK
55 #define X_OK 01
56 #endif
58 #include <math.h>
60 #ifdef HAVE_SETLOCALE
61 #include <locale.h>
62 #endif /* HAVE_SETLOCALE */
64 #ifndef O_RDONLY
65 #define O_RDONLY 0
66 #endif
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
76 #ifndef USE_CRT_DLL
77 extern int errno;
78 #endif
80 Lisp_Object Qread_char, Qget_file_char, Qstandard_input, Qcurrent_load_list;
81 Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist;
82 Lisp_Object Qascii_character, Qload, Qload_file_name;
83 Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
84 Lisp_Object Qinhibit_file_name_operation;
86 extern Lisp_Object Qevent_symbol_element_mask;
87 extern Lisp_Object Qfile_exists_p;
89 /* non-zero if inside `load' */
90 int load_in_progress;
92 /* Directory in which the sources were found. */
93 Lisp_Object Vsource_directory;
95 /* Search path and suffixes for files to be loaded. */
96 Lisp_Object Vload_path, Vload_suffixes, default_suffixes;
98 /* File name of user's init file. */
99 Lisp_Object Vuser_init_file;
101 /* This is the user-visible association list that maps features to
102 lists of defs in their load files. */
103 Lisp_Object Vload_history;
105 /* This is used to build the load history. */
106 Lisp_Object Vcurrent_load_list;
108 /* List of files that were preloaded. */
109 Lisp_Object Vpreloaded_file_list;
111 /* Name of file actually being read by `load'. */
112 Lisp_Object Vload_file_name;
114 /* Function to use for reading, in `load' and friends. */
115 Lisp_Object Vload_read_function;
117 /* The association list of objects read with the #n=object form.
118 Each member of the list has the form (n . object), and is used to
119 look up the object for the corresponding #n# construct.
120 It must be set to nil before all top-level calls to read0. */
121 Lisp_Object read_objects;
123 /* Nonzero means load should forcibly load all dynamic doc strings. */
124 static int load_force_doc_strings;
126 /* Nonzero means read should convert strings to unibyte. */
127 static int load_convert_to_unibyte;
129 /* Function to use for loading an Emacs lisp source file (not
130 compiled) instead of readevalloop. */
131 Lisp_Object Vload_source_file_function;
133 /* List of all DEFVAR_BOOL variables. Used by the byte optimizer. */
134 Lisp_Object Vbyte_boolean_vars;
136 /* Whether or not to add a `read-positions' property to symbols
137 read. */
138 Lisp_Object Vread_with_symbol_positions;
140 /* List of (SYMBOL . POSITION) accumulated so far. */
141 Lisp_Object Vread_symbol_positions_list;
143 /* List of descriptors now open for Fload. */
144 static Lisp_Object load_descriptor_list;
146 /* File for get_file_char to read from. Use by load. */
147 static FILE *instream;
149 /* When nonzero, read conses in pure space */
150 static int read_pure;
152 /* For use within read-from-string (this reader is non-reentrant!!) */
153 static int read_from_string_index;
154 static int read_from_string_index_byte;
155 static int read_from_string_limit;
157 /* Number of bytes left to read in the buffer character
158 that `readchar' has already advanced over. */
159 static int readchar_backlog;
160 /* Number of characters read in the current call to Fread or
161 Fread_from_string. */
162 static int readchar_count;
164 /* This contains the last string skipped with #@. */
165 static char *saved_doc_string;
166 /* Length of buffer allocated in saved_doc_string. */
167 static int saved_doc_string_size;
168 /* Length of actual data in saved_doc_string. */
169 static int saved_doc_string_length;
170 /* This is the file position that string came from. */
171 static file_offset saved_doc_string_position;
173 /* This contains the previous string skipped with #@.
174 We copy it from saved_doc_string when a new string
175 is put in saved_doc_string. */
176 static char *prev_saved_doc_string;
177 /* Length of buffer allocated in prev_saved_doc_string. */
178 static int prev_saved_doc_string_size;
179 /* Length of actual data in prev_saved_doc_string. */
180 static int prev_saved_doc_string_length;
181 /* This is the file position that string came from. */
182 static file_offset prev_saved_doc_string_position;
184 /* Nonzero means inside a new-style backquote
185 with no surrounding parentheses.
186 Fread initializes this to zero, so we need not specbind it
187 or worry about what happens to it when there is an error. */
188 static int new_backquote_flag;
190 /* A list of file names for files being loaded in Fload. Used to
191 check for recursive loads. */
193 static Lisp_Object Vloads_in_progress;
195 /* Non-zero means load dangerous compiled Lisp files. */
197 int load_dangerous_libraries;
199 /* A regular expression used to detect files compiled with Emacs. */
201 static Lisp_Object Vbytecomp_version_regexp;
203 static void to_multibyte P_ ((char **, char **, int *));
204 static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object,
205 Lisp_Object (*) (), int,
206 Lisp_Object, Lisp_Object));
207 static Lisp_Object load_unwind P_ ((Lisp_Object));
208 static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object));
211 /* Handle unreading and rereading of characters.
212 Write READCHAR to read a character,
213 UNREAD(c) to unread c to be read again.
215 The READCHAR and UNREAD macros are meant for reading/unreading a
216 byte code; they do not handle multibyte characters. The caller
217 should manage them if necessary.
219 [ Actually that seems to be a lie; READCHAR will definitely read
220 multibyte characters from buffer sources, at least. Is the
221 comment just out of date?
222 -- Colin Walters <walters@gnu.org>, 22 May 2002 16:36:50 -0400 ]
225 #define READCHAR readchar (readcharfun)
226 #define UNREAD(c) unreadchar (readcharfun, c)
228 static int
229 readchar (readcharfun)
230 Lisp_Object readcharfun;
232 Lisp_Object tem;
233 register int c;
235 readchar_count++;
237 if (BUFFERP (readcharfun))
239 register struct buffer *inbuffer = XBUFFER (readcharfun);
241 int pt_byte = BUF_PT_BYTE (inbuffer);
242 int orig_pt_byte = pt_byte;
244 if (readchar_backlog > 0)
245 /* We get the address of the byte just passed,
246 which is the last byte of the character.
247 The other bytes in this character are consecutive with it,
248 because the gap can't be in the middle of a character. */
249 return *(BUF_BYTE_ADDRESS (inbuffer, BUF_PT_BYTE (inbuffer) - 1)
250 - --readchar_backlog);
252 if (pt_byte >= BUF_ZV_BYTE (inbuffer))
253 return -1;
255 readchar_backlog = -1;
257 if (! NILP (inbuffer->enable_multibyte_characters))
259 /* Fetch the character code from the buffer. */
260 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte);
261 BUF_INC_POS (inbuffer, pt_byte);
262 c = STRING_CHAR (p, pt_byte - orig_pt_byte);
264 else
266 c = BUF_FETCH_BYTE (inbuffer, pt_byte);
267 pt_byte++;
269 SET_BUF_PT_BOTH (inbuffer, BUF_PT (inbuffer) + 1, pt_byte);
271 return c;
273 if (MARKERP (readcharfun))
275 register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
277 int bytepos = marker_byte_position (readcharfun);
278 int orig_bytepos = bytepos;
280 if (readchar_backlog > 0)
281 /* We get the address of the byte just passed,
282 which is the last byte of the character.
283 The other bytes in this character are consecutive with it,
284 because the gap can't be in the middle of a character. */
285 return *(BUF_BYTE_ADDRESS (inbuffer, XMARKER (readcharfun)->bytepos - 1)
286 - --readchar_backlog);
288 if (bytepos >= BUF_ZV_BYTE (inbuffer))
289 return -1;
291 readchar_backlog = -1;
293 if (! NILP (inbuffer->enable_multibyte_characters))
295 /* Fetch the character code from the buffer. */
296 unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos);
297 BUF_INC_POS (inbuffer, bytepos);
298 c = STRING_CHAR (p, bytepos - orig_bytepos);
300 else
302 c = BUF_FETCH_BYTE (inbuffer, bytepos);
303 bytepos++;
306 XMARKER (readcharfun)->bytepos = bytepos;
307 XMARKER (readcharfun)->charpos++;
309 return c;
312 if (EQ (readcharfun, Qlambda))
313 return read_bytecode_char (0);
315 if (EQ (readcharfun, Qget_file_char))
317 c = getc (instream);
318 #ifdef EINTR
319 /* Interrupted reads have been observed while reading over the network */
320 while (c == EOF && ferror (instream) && errno == EINTR)
322 clearerr (instream);
323 c = getc (instream);
325 #endif
326 return c;
329 if (STRINGP (readcharfun))
331 if (read_from_string_index >= read_from_string_limit)
332 c = -1;
333 else
334 FETCH_STRING_CHAR_ADVANCE (c, readcharfun,
335 read_from_string_index,
336 read_from_string_index_byte);
338 return c;
341 tem = call0 (readcharfun);
343 if (NILP (tem))
344 return -1;
345 return XINT (tem);
348 /* Unread the character C in the way appropriate for the stream READCHARFUN.
349 If the stream is a user function, call it with the char as argument. */
351 static void
352 unreadchar (readcharfun, c)
353 Lisp_Object readcharfun;
354 int c;
356 readchar_count--;
357 if (c == -1)
358 /* Don't back up the pointer if we're unreading the end-of-input mark,
359 since readchar didn't advance it when we read it. */
361 else if (BUFFERP (readcharfun))
363 struct buffer *b = XBUFFER (readcharfun);
364 int bytepos = BUF_PT_BYTE (b);
366 if (readchar_backlog >= 0)
367 readchar_backlog++;
368 else
370 BUF_PT (b)--;
371 if (! NILP (b->enable_multibyte_characters))
372 BUF_DEC_POS (b, bytepos);
373 else
374 bytepos--;
376 BUF_PT_BYTE (b) = bytepos;
379 else if (MARKERP (readcharfun))
381 struct buffer *b = XMARKER (readcharfun)->buffer;
382 int bytepos = XMARKER (readcharfun)->bytepos;
384 if (readchar_backlog >= 0)
385 readchar_backlog++;
386 else
388 XMARKER (readcharfun)->charpos--;
389 if (! NILP (b->enable_multibyte_characters))
390 BUF_DEC_POS (b, bytepos);
391 else
392 bytepos--;
394 XMARKER (readcharfun)->bytepos = bytepos;
397 else if (STRINGP (readcharfun))
399 read_from_string_index--;
400 read_from_string_index_byte
401 = string_char_to_byte (readcharfun, read_from_string_index);
403 else if (EQ (readcharfun, Qlambda))
404 read_bytecode_char (1);
405 else if (EQ (readcharfun, Qget_file_char))
406 ungetc (c, instream);
407 else
408 call1 (readcharfun, make_number (c));
411 static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object,
412 Lisp_Object));
413 static Lisp_Object read0 P_ ((Lisp_Object));
414 static Lisp_Object read1 P_ ((Lisp_Object, int *, int));
416 static Lisp_Object read_list P_ ((int, Lisp_Object));
417 static Lisp_Object read_vector P_ ((Lisp_Object, int));
418 static int read_multibyte P_ ((int, Lisp_Object));
420 static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object,
421 Lisp_Object));
422 static void substitute_object_in_subtree P_ ((Lisp_Object,
423 Lisp_Object));
424 static void substitute_in_interval P_ ((INTERVAL, Lisp_Object));
427 /* Get a character from the tty. */
429 extern Lisp_Object read_char ();
431 /* Read input events until we get one that's acceptable for our purposes.
433 If NO_SWITCH_FRAME is non-zero, switch-frame events are stashed
434 until we get a character we like, and then stuffed into
435 unread_switch_frame.
437 If ASCII_REQUIRED is non-zero, we check function key events to see
438 if the unmodified version of the symbol has a Qascii_character
439 property, and use that character, if present.
441 If ERROR_NONASCII is non-zero, we signal an error if the input we
442 get isn't an ASCII character with modifiers. If it's zero but
443 ASCII_REQUIRED is non-zero, we just re-read until we get an ASCII
444 character.
446 If INPUT_METHOD is nonzero, we invoke the current input method
447 if the character warrants that. */
449 Lisp_Object
450 read_filtered_event (no_switch_frame, ascii_required, error_nonascii,
451 input_method)
452 int no_switch_frame, ascii_required, error_nonascii, input_method;
454 register Lisp_Object val, delayed_switch_frame;
456 #ifdef HAVE_WINDOW_SYSTEM
457 if (display_hourglass_p)
458 cancel_hourglass ();
459 #endif
461 delayed_switch_frame = Qnil;
463 /* Read until we get an acceptable event. */
464 retry:
465 val = read_char (0, 0, 0,
466 (input_method ? Qnil : Qt),
469 if (BUFFERP (val))
470 goto retry;
472 /* switch-frame events are put off until after the next ASCII
473 character. This is better than signaling an error just because
474 the last characters were typed to a separate minibuffer frame,
475 for example. Eventually, some code which can deal with
476 switch-frame events will read it and process it. */
477 if (no_switch_frame
478 && EVENT_HAS_PARAMETERS (val)
479 && EQ (EVENT_HEAD (val), Qswitch_frame))
481 delayed_switch_frame = val;
482 goto retry;
485 if (ascii_required)
487 /* Convert certain symbols to their ASCII equivalents. */
488 if (SYMBOLP (val))
490 Lisp_Object tem, tem1;
491 tem = Fget (val, Qevent_symbol_element_mask);
492 if (!NILP (tem))
494 tem1 = Fget (Fcar (tem), Qascii_character);
495 /* Merge this symbol's modifier bits
496 with the ASCII equivalent of its basic code. */
497 if (!NILP (tem1))
498 XSETFASTINT (val, XINT (tem1) | XINT (Fcar (Fcdr (tem))));
502 /* If we don't have a character now, deal with it appropriately. */
503 if (!INTEGERP (val))
505 if (error_nonascii)
507 Vunread_command_events = Fcons (val, Qnil);
508 error ("Non-character input-event");
510 else
511 goto retry;
515 if (! NILP (delayed_switch_frame))
516 unread_switch_frame = delayed_switch_frame;
518 #if 0
520 #ifdef HAVE_WINDOW_SYSTEM
521 if (display_hourglass_p)
522 start_hourglass ();
523 #endif
525 #endif
527 return val;
530 DEFUN ("read-char", Fread_char, Sread_char, 0, 2, 0,
531 doc: /* Read a character from the command input (keyboard or macro).
532 It is returned as a number.
533 If the user generates an event which is not a character (i.e. a mouse
534 click or function key event), `read-char' signals an error. As an
535 exception, switch-frame events are put off until non-ASCII events can
536 be read.
537 If you want to read non-character events, or ignore them, call
538 `read-event' or `read-char-exclusive' instead.
540 If the optional argument PROMPT is non-nil, display that as a prompt.
541 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
542 input method is turned on in the current buffer, that input method
543 is used for reading a character. */)
544 (prompt, inherit_input_method)
545 Lisp_Object prompt, inherit_input_method;
547 if (! NILP (prompt))
548 message_with_string ("%s", prompt, 0);
549 return read_filtered_event (1, 1, 1, ! NILP (inherit_input_method));
552 DEFUN ("read-event", Fread_event, Sread_event, 0, 2, 0,
553 doc: /* Read an event object from the input stream.
554 If the optional argument PROMPT is non-nil, display that as a prompt.
555 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
556 input method is turned on in the current buffer, that input method
557 is used for reading a character. */)
558 (prompt, inherit_input_method)
559 Lisp_Object prompt, inherit_input_method;
561 if (! NILP (prompt))
562 message_with_string ("%s", prompt, 0);
563 return read_filtered_event (0, 0, 0, ! NILP (inherit_input_method));
566 DEFUN ("read-char-exclusive", Fread_char_exclusive, Sread_char_exclusive, 0, 2, 0,
567 doc: /* Read a character from the command input (keyboard or macro).
568 It is returned as a number. Non-character events are ignored.
570 If the optional argument PROMPT is non-nil, display that as a prompt.
571 If the optional argument INHERIT-INPUT-METHOD is non-nil and some
572 input method is turned on in the current buffer, that input method
573 is used for reading a character. */)
574 (prompt, inherit_input_method)
575 Lisp_Object prompt, inherit_input_method;
577 if (! NILP (prompt))
578 message_with_string ("%s", prompt, 0);
579 return read_filtered_event (1, 1, 0, ! NILP (inherit_input_method));
582 DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
583 doc: /* Don't use this yourself. */)
586 register Lisp_Object val;
587 XSETINT (val, getc (instream));
588 return val;
593 /* Value is non-zero if the file asswociated with file descriptor FD
594 is a compiled Lisp file that's safe to load. Only files compiled
595 with Emacs are safe to load. Files compiled with XEmacs can lead
596 to a crash in Fbyte_code because of an incompatible change in the
597 byte compiler. */
599 static int
600 safe_to_load_p (fd)
601 int fd;
603 char buf[512];
604 int nbytes, i;
605 int safe_p = 1;
607 /* Read the first few bytes from the file, and look for a line
608 specifying the byte compiler version used. */
609 nbytes = emacs_read (fd, buf, sizeof buf - 1);
610 if (nbytes > 0)
612 buf[nbytes] = '\0';
614 /* Skip to the next newline, skipping over the initial `ELC'
615 with NUL bytes following it. */
616 for (i = 0; i < nbytes && buf[i] != '\n'; ++i)
619 if (i < nbytes
620 && fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
621 buf + i) < 0)
622 safe_p = 0;
625 lseek (fd, 0, SEEK_SET);
626 return safe_p;
630 /* Callback for record_unwind_protect. Restore the old load list OLD,
631 after loading a file successfully. */
633 static Lisp_Object
634 record_load_unwind (old)
635 Lisp_Object old;
637 return Vloads_in_progress = old;
641 DEFUN ("load", Fload, Sload, 1, 5, 0,
642 doc: /* Execute a file of Lisp code named FILE.
643 First try FILE with `.elc' appended, then try with `.el',
644 then try FILE unmodified. Environment variable references in FILE
645 are replaced with their values by calling `substitute-in-file-name'.
646 This function searches the directories in `load-path'.
647 If optional second arg NOERROR is non-nil,
648 report no error if FILE doesn't exist.
649 Print messages at start and end of loading unless
650 optional third arg NOMESSAGE is non-nil.
651 If optional fourth arg NOSUFFIX is non-nil, don't try adding
652 suffixes `.elc' or `.el' to the specified name FILE.
653 If optional fifth arg MUST-SUFFIX is non-nil, insist on
654 the suffix `.elc' or `.el'; don't accept just FILE unless
655 it ends in one of those suffixes or includes a directory name.
656 Return t if file exists. */)
657 (file, noerror, nomessage, nosuffix, must_suffix)
658 Lisp_Object file, noerror, nomessage, nosuffix, must_suffix;
660 register FILE *stream;
661 register int fd = -1;
662 register Lisp_Object lispstream;
663 int count = specpdl_ptr - specpdl;
664 Lisp_Object temp;
665 struct gcpro gcpro1;
666 Lisp_Object found, efound;
667 /* 1 means we printed the ".el is newer" message. */
668 int newer = 0;
669 /* 1 means we are loading a compiled file. */
670 int compiled = 0;
671 Lisp_Object handler;
672 int safe_p = 1;
673 char *fmode = "r";
674 #ifdef DOS_NT
675 fmode = "rt";
676 #endif /* DOS_NT */
678 CHECK_STRING (file);
680 /* If file name is magic, call the handler. */
681 /* This shouldn't be necessary any more now that `openp' handles it right.
682 handler = Ffind_file_name_handler (file, Qload);
683 if (!NILP (handler))
684 return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
686 /* Do this after the handler to avoid
687 the need to gcpro noerror, nomessage and nosuffix.
688 (Below here, we care only whether they are nil or not.)
689 The presence of this call is the result of a historical accident:
690 it used to be in every file-operations and when it got removed
691 everywhere, it accidentally stayed here. Since then, enough people
692 supposedly have things like (load "$PROJECT/foo.el") in their .emacs
693 that it seemed risky to remove. */
694 file = Fsubstitute_in_file_name (file);
696 /* Avoid weird lossage with null string as arg,
697 since it would try to load a directory as a Lisp file */
698 if (XSTRING (file)->size > 0)
700 int size = STRING_BYTES (XSTRING (file));
701 Lisp_Object tmp[2];
703 GCPRO1 (file);
705 if (! NILP (must_suffix))
707 /* Don't insist on adding a suffix if FILE already ends with one. */
708 if (size > 3
709 && !strcmp (XSTRING (file)->data + size - 3, ".el"))
710 must_suffix = Qnil;
711 else if (size > 4
712 && !strcmp (XSTRING (file)->data + size - 4, ".elc"))
713 must_suffix = Qnil;
714 /* Don't insist on adding a suffix
715 if the argument includes a directory name. */
716 else if (! NILP (Ffile_name_directory (file)))
717 must_suffix = Qnil;
720 fd = openp (Vload_path, file,
721 (!NILP (nosuffix) ? Qnil
722 : !NILP (must_suffix) ? Vload_suffixes
723 : Fappend (2, (tmp[0] = Vload_suffixes,
724 tmp[1] = default_suffixes,
725 tmp))),
726 &found, Qnil);
727 UNGCPRO;
730 if (fd == -1)
732 if (NILP (noerror))
733 while (1)
734 Fsignal (Qfile_error, Fcons (build_string ("Cannot open load file"),
735 Fcons (file, Qnil)));
736 else
737 return Qnil;
740 /* Tell startup.el whether or not we found the user's init file. */
741 if (EQ (Qt, Vuser_init_file))
742 Vuser_init_file = found;
744 /* If FD is -2, that means openp found a magic file. */
745 if (fd == -2)
747 if (NILP (Fequal (found, file)))
748 /* If FOUND is a different file name from FILE,
749 find its handler even if we have already inhibited
750 the `load' operation on FILE. */
751 handler = Ffind_file_name_handler (found, Qt);
752 else
753 handler = Ffind_file_name_handler (found, Qload);
754 if (! NILP (handler))
755 return call5 (handler, Qload, found, noerror, nomessage, Qt);
758 /* Check if we're stuck in a recursive load cycle.
760 2000-09-21: It's not possible to just check for the file loaded
761 being a member of Vloads_in_progress. This fails because of the
762 way the byte compiler currently works; `provide's are not
763 evaluted, see font-lock.el/jit-lock.el as an example. This
764 leads to a certain amount of ``normal'' recursion.
766 Also, just loading a file recursively is not always an error in
767 the general case; the second load may do something different. */
769 int count = 0;
770 Lisp_Object tem;
771 for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
772 if (!NILP (Fequal (found, XCAR (tem))))
773 count++;
774 if (count > 3)
775 Fsignal (Qerror, Fcons (build_string ("Recursive load"),
776 Fcons (found, Vloads_in_progress)));
777 record_unwind_protect (record_load_unwind, Vloads_in_progress);
778 Vloads_in_progress = Fcons (found, Vloads_in_progress);
781 if (!bcmp (&(XSTRING (found)->data[STRING_BYTES (XSTRING (found)) - 4]),
782 ".elc", 4))
783 /* Load .elc files directly, but not when they are
784 remote and have no handler! */
786 if (fd != -2)
788 struct stat s1, s2;
789 int result;
791 if (!safe_to_load_p (fd))
793 safe_p = 0;
794 if (!load_dangerous_libraries)
795 error ("File `%s' was not compiled in Emacs",
796 XSTRING (found)->data);
797 else if (!NILP (nomessage))
798 message_with_string ("File `%s' not compiled in Emacs", found, 1);
801 compiled = 1;
803 GCPRO1 (efound);
804 efound = ENCODE_FILE (found);
806 #ifdef DOS_NT
807 fmode = "rb";
808 #endif /* DOS_NT */
809 stat ((char *)XSTRING (efound)->data, &s1);
810 XSTRING (efound)->data[STRING_BYTES (XSTRING (efound)) - 1] = 0;
811 result = stat ((char *)XSTRING (efound)->data, &s2);
812 XSTRING (efound)->data[STRING_BYTES (XSTRING (efound)) - 1] = 'c';
813 UNGCPRO;
815 if (result >= 0 && (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
817 /* Make the progress messages mention that source is newer. */
818 newer = 1;
820 /* If we won't print another message, mention this anyway. */
821 if (!NILP (nomessage))
823 Lisp_Object file;
824 file = Fsubstring (found, make_number (0), make_number (-1));
825 message_with_string ("Source file `%s' newer than byte-compiled file",
826 file, SMBP (file));
831 else
833 /* We are loading a source file (*.el). */
834 if (!NILP (Vload_source_file_function))
836 Lisp_Object val;
838 if (fd >= 0)
839 emacs_close (fd);
840 val = call4 (Vload_source_file_function, found, file,
841 NILP (noerror) ? Qnil : Qt,
842 NILP (nomessage) ? Qnil : Qt);
843 return unbind_to (count, val);
847 #ifdef WINDOWSNT
848 emacs_close (fd);
849 GCPRO1 (efound);
850 efound = ENCODE_FILE (found);
851 stream = fopen ((char *) XSTRING (efound)->data, fmode);
852 UNGCPRO;
853 #else /* not WINDOWSNT */
854 stream = fdopen (fd, fmode);
855 #endif /* not WINDOWSNT */
856 if (stream == 0)
858 emacs_close (fd);
859 error ("Failure to create stdio stream for %s", XSTRING (file)->data);
862 if (! NILP (Vpurify_flag))
863 Vpreloaded_file_list = Fcons (file, Vpreloaded_file_list);
865 if (NILP (nomessage))
867 if (!safe_p)
868 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...",
869 file, 1);
870 else if (!compiled)
871 message_with_string ("Loading %s (source)...", file, 1);
872 else if (newer)
873 message_with_string ("Loading %s (compiled; note, source file is newer)...",
874 file, 1);
875 else /* The typical case; compiled file newer than source file. */
876 message_with_string ("Loading %s...", file, 1);
879 GCPRO1 (file);
880 lispstream = Fcons (Qnil, Qnil);
881 XSETCARFASTINT (lispstream, (EMACS_UINT)stream >> 16);
882 XSETCDRFASTINT (lispstream, (EMACS_UINT)stream & 0xffff);
883 record_unwind_protect (load_unwind, lispstream);
884 record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
885 specbind (Qload_file_name, found);
886 specbind (Qinhibit_file_name_operation, Qnil);
887 load_descriptor_list
888 = Fcons (make_number (fileno (stream)), load_descriptor_list);
889 load_in_progress++;
890 readevalloop (Qget_file_char, stream, file, Feval, 0, Qnil, Qnil);
891 unbind_to (count, Qnil);
893 /* Run any load-hooks for this file. */
894 temp = Fassoc (file, Vafter_load_alist);
895 if (!NILP (temp))
896 Fprogn (Fcdr (temp));
897 UNGCPRO;
899 if (saved_doc_string)
900 free (saved_doc_string);
901 saved_doc_string = 0;
902 saved_doc_string_size = 0;
904 if (prev_saved_doc_string)
905 xfree (prev_saved_doc_string);
906 prev_saved_doc_string = 0;
907 prev_saved_doc_string_size = 0;
909 if (!noninteractive && NILP (nomessage))
911 if (!safe_p)
912 message_with_string ("Loading %s (compiled; note unsafe, not compiled in Emacs)...done",
913 file, 1);
914 else if (!compiled)
915 message_with_string ("Loading %s (source)...done", file, 1);
916 else if (newer)
917 message_with_string ("Loading %s (compiled; note, source file is newer)...done",
918 file, 1);
919 else /* The typical case; compiled file newer than source file. */
920 message_with_string ("Loading %s...done", file, 1);
923 return Qt;
926 static Lisp_Object
927 load_unwind (stream) /* used as unwind-protect function in load */
928 Lisp_Object stream;
930 fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16
931 | XFASTINT (XCDR (stream))));
932 if (--load_in_progress < 0) load_in_progress = 0;
933 return Qnil;
936 static Lisp_Object
937 load_descriptor_unwind (oldlist)
938 Lisp_Object oldlist;
940 load_descriptor_list = oldlist;
941 return Qnil;
944 /* Close all descriptors in use for Floads.
945 This is used when starting a subprocess. */
947 void
948 close_load_descs ()
950 #ifndef WINDOWSNT
951 Lisp_Object tail;
952 for (tail = load_descriptor_list; !NILP (tail); tail = XCDR (tail))
953 emacs_close (XFASTINT (XCAR (tail)));
954 #endif
957 static int
958 complete_filename_p (pathname)
959 Lisp_Object pathname;
961 register unsigned char *s = XSTRING (pathname)->data;
962 return (IS_DIRECTORY_SEP (s[0])
963 || (XSTRING (pathname)->size > 2
964 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))
965 #ifdef ALTOS
966 || *s == '@'
967 #endif
968 #ifdef VMS
969 || index (s, ':')
970 #endif /* VMS */
974 DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0,
975 doc: /* Search for FILENAME through PATH.
976 If SUFFIXES is non-nil, it should be a list of suffixes to append to
977 file name when searching.
978 If non-nil, PREDICATE is used instead of `file-readable-p'.
979 PREDICATE can also be an integer to pass to the access(2) function,
980 in which case file-name-handlers are ignored. */)
981 (filename, path, suffixes, predicate)
982 Lisp_Object filename, path, suffixes, predicate;
984 Lisp_Object file;
985 int fd = openp (path, filename, suffixes, &file, predicate);
986 if (NILP (predicate) && fd > 0)
987 close (fd);
988 return file;
992 /* Search for a file whose name is STR, looking in directories
993 in the Lisp list PATH, and trying suffixes from SUFFIX.
994 On success, returns a file descriptor. On failure, returns -1.
996 SUFFIXES is a list of strings containing possible suffixes.
997 The empty suffix is automatically added iff the list is empty.
999 PREDICATE non-nil means don't open the files,
1000 just look for one that satisfies the predicate. In this case,
1001 returns 1 on success. The predicate can be a lisp function or
1002 an integer to pass to `access' (in which case file-name-handlers
1003 are ignored).
1005 If STOREPTR is nonzero, it points to a slot where the name of
1006 the file actually found should be stored as a Lisp string.
1007 nil is stored there on failure.
1009 If the file we find is remote, return -2
1010 but store the found remote file name in *STOREPTR. */
1013 openp (path, str, suffixes, storeptr, predicate)
1014 Lisp_Object path, str;
1015 Lisp_Object suffixes;
1016 Lisp_Object *storeptr;
1017 Lisp_Object predicate;
1019 register int fd;
1020 int fn_size = 100;
1021 char buf[100];
1022 register char *fn = buf;
1023 int absolute = 0;
1024 int want_size;
1025 Lisp_Object filename;
1026 struct stat st;
1027 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
1028 Lisp_Object string, tail, encoded_fn;
1029 int max_suffix_len = 0;
1031 for (tail = suffixes; CONSP (tail); tail = XCDR (tail))
1033 CHECK_STRING_CAR (tail);
1034 max_suffix_len = max (max_suffix_len,
1035 STRING_BYTES (XSTRING (XCAR (tail))));
1038 string = filename = Qnil;
1039 GCPRO6 (str, string, filename, path, suffixes, encoded_fn);
1041 if (storeptr)
1042 *storeptr = Qnil;
1044 if (complete_filename_p (str))
1045 absolute = 1;
1047 for (; CONSP (path); path = XCDR (path))
1049 filename = Fexpand_file_name (str, XCAR (path));
1050 if (!complete_filename_p (filename))
1051 /* If there are non-absolute elts in PATH (eg ".") */
1052 /* Of course, this could conceivably lose if luser sets
1053 default-directory to be something non-absolute... */
1055 filename = Fexpand_file_name (filename, current_buffer->directory);
1056 if (!complete_filename_p (filename))
1057 /* Give up on this path element! */
1058 continue;
1061 /* Calculate maximum size of any filename made from
1062 this path element/specified file name and any possible suffix. */
1063 want_size = max_suffix_len + STRING_BYTES (XSTRING (filename)) + 1;
1064 if (fn_size < want_size)
1065 fn = (char *) alloca (fn_size = 100 + want_size);
1067 /* Loop over suffixes. */
1068 for (tail = NILP (suffixes) ? default_suffixes : suffixes;
1069 CONSP (tail); tail = XCDR (tail))
1071 int lsuffix = STRING_BYTES (XSTRING (XCAR (tail)));
1072 Lisp_Object handler;
1073 int exists;
1075 /* Concatenate path element/specified name with the suffix.
1076 If the directory starts with /:, remove that. */
1077 if (XSTRING (filename)->size > 2
1078 && XSTRING (filename)->data[0] == '/'
1079 && XSTRING (filename)->data[1] == ':')
1081 strncpy (fn, XSTRING (filename)->data + 2,
1082 STRING_BYTES (XSTRING (filename)) - 2);
1083 fn[STRING_BYTES (XSTRING (filename)) - 2] = 0;
1085 else
1087 strncpy (fn, XSTRING (filename)->data,
1088 STRING_BYTES (XSTRING (filename)));
1089 fn[STRING_BYTES (XSTRING (filename))] = 0;
1092 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
1093 strncat (fn, XSTRING (XCAR (tail))->data, lsuffix);
1095 /* Check that the file exists and is not a directory. */
1096 /* We used to only check for handlers on non-absolute file names:
1097 if (absolute)
1098 handler = Qnil;
1099 else
1100 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1101 It's not clear why that was the case and it breaks things like
1102 (load "/bar.el") where the file is actually "/bar.el.gz". */
1103 handler = Ffind_file_name_handler (filename, Qfile_exists_p);
1104 string = build_string (fn);
1105 if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
1107 if (NILP (predicate))
1108 exists = !NILP (Ffile_readable_p (string));
1109 else
1110 exists = !NILP (call1 (predicate, string));
1111 if (exists && !NILP (Ffile_directory_p (string)))
1112 exists = 0;
1114 if (exists)
1116 /* We succeeded; return this descriptor and filename. */
1117 if (storeptr)
1118 *storeptr = string;
1119 UNGCPRO;
1120 return -2;
1123 else
1125 char *pfn;
1127 encoded_fn = ENCODE_FILE (string);
1128 pfn = XSTRING (encoded_fn)->data;
1129 exists = (stat (pfn, &st) >= 0
1130 && (st.st_mode & S_IFMT) != S_IFDIR);
1131 if (exists)
1133 /* Check that we can access or open it. */
1134 if (NATNUMP (predicate))
1135 fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
1136 else
1137 fd = emacs_open (pfn, O_RDONLY, 0);
1139 if (fd >= 0)
1141 /* We succeeded; return this descriptor and filename. */
1142 if (storeptr)
1143 *storeptr = string;
1144 UNGCPRO;
1145 return fd;
1150 if (absolute)
1151 break;
1154 UNGCPRO;
1155 return -1;
1159 /* Merge the list we've accumulated of globals from the current input source
1160 into the load_history variable. The details depend on whether
1161 the source has an associated file name or not. */
1163 static void
1164 build_load_history (stream, source)
1165 FILE *stream;
1166 Lisp_Object source;
1168 register Lisp_Object tail, prev, newelt;
1169 register Lisp_Object tem, tem2;
1170 register int foundit, loading;
1172 loading = stream || !NARROWED;
1174 tail = Vload_history;
1175 prev = Qnil;
1176 foundit = 0;
1177 while (CONSP (tail))
1179 tem = XCAR (tail);
1181 /* Find the feature's previous assoc list... */
1182 if (!NILP (Fequal (source, Fcar (tem))))
1184 foundit = 1;
1186 /* If we're loading, remove it. */
1187 if (loading)
1189 if (NILP (prev))
1190 Vload_history = XCDR (tail);
1191 else
1192 Fsetcdr (prev, XCDR (tail));
1195 /* Otherwise, cons on new symbols that are not already members. */
1196 else
1198 tem2 = Vcurrent_load_list;
1200 while (CONSP (tem2))
1202 newelt = XCAR (tem2);
1204 if (NILP (Fmemq (newelt, tem)))
1205 Fsetcar (tail, Fcons (XCAR (tem),
1206 Fcons (newelt, XCDR (tem))));
1208 tem2 = XCDR (tem2);
1209 QUIT;
1213 else
1214 prev = tail;
1215 tail = XCDR (tail);
1216 QUIT;
1219 /* If we're loading, cons the new assoc onto the front of load-history,
1220 the most-recently-loaded position. Also do this if we didn't find
1221 an existing member for the current source. */
1222 if (loading || !foundit)
1223 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
1224 Vload_history);
1227 Lisp_Object
1228 unreadpure (junk) /* Used as unwind-protect function in readevalloop */
1229 Lisp_Object junk;
1231 read_pure = 0;
1232 return Qnil;
1235 static Lisp_Object
1236 readevalloop_1 (old)
1237 Lisp_Object old;
1239 load_convert_to_unibyte = ! NILP (old);
1240 return Qnil;
1243 /* Signal an `end-of-file' error, if possible with file name
1244 information. */
1246 static void
1247 end_of_file_error ()
1249 Lisp_Object data;
1251 if (STRINGP (Vload_file_name))
1252 data = Fcons (Vload_file_name, Qnil);
1253 else
1254 data = Qnil;
1256 Fsignal (Qend_of_file, data);
1259 /* UNIBYTE specifies how to set load_convert_to_unibyte
1260 for this invocation.
1261 READFUN, if non-nil, is used instead of `read'. */
1263 static void
1264 readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, readfun)
1265 Lisp_Object readcharfun;
1266 FILE *stream;
1267 Lisp_Object sourcename;
1268 Lisp_Object (*evalfun) ();
1269 int printflag;
1270 Lisp_Object unibyte, readfun;
1272 register int c;
1273 register Lisp_Object val;
1274 int count = specpdl_ptr - specpdl;
1275 struct gcpro gcpro1;
1276 struct buffer *b = 0;
1277 int continue_reading_p;
1279 if (BUFFERP (readcharfun))
1280 b = XBUFFER (readcharfun);
1281 else if (MARKERP (readcharfun))
1282 b = XMARKER (readcharfun)->buffer;
1284 specbind (Qstandard_input, readcharfun);
1285 specbind (Qcurrent_load_list, Qnil);
1286 record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
1287 load_convert_to_unibyte = !NILP (unibyte);
1289 readchar_backlog = -1;
1291 GCPRO1 (sourcename);
1293 LOADHIST_ATTACH (sourcename);
1295 continue_reading_p = 1;
1296 while (continue_reading_p)
1298 if (b != 0 && NILP (b->name))
1299 error ("Reading from killed buffer");
1301 instream = stream;
1302 c = READCHAR;
1303 if (c == ';')
1305 while ((c = READCHAR) != '\n' && c != -1);
1306 continue;
1308 if (c < 0) break;
1310 /* Ignore whitespace here, so we can detect eof. */
1311 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
1312 continue;
1314 if (!NILP (Vpurify_flag) && c == '(')
1316 int count1 = specpdl_ptr - specpdl;
1317 record_unwind_protect (unreadpure, Qnil);
1318 val = read_list (-1, readcharfun);
1319 unbind_to (count1, Qnil);
1321 else
1323 UNREAD (c);
1324 read_objects = Qnil;
1325 if (!NILP (readfun))
1327 val = call1 (readfun, readcharfun);
1329 /* If READCHARFUN has set point to ZV, we should
1330 stop reading, even if the form read sets point
1331 to a different value when evaluated. */
1332 if (BUFFERP (readcharfun))
1334 struct buffer *b = XBUFFER (readcharfun);
1335 if (BUF_PT (b) == BUF_ZV (b))
1336 continue_reading_p = 0;
1339 else if (! NILP (Vload_read_function))
1340 val = call1 (Vload_read_function, readcharfun);
1341 else
1342 val = read_internal_start (readcharfun, Qnil, Qnil);
1345 val = (*evalfun) (val);
1347 if (printflag)
1349 Vvalues = Fcons (val, Vvalues);
1350 if (EQ (Vstandard_output, Qt))
1351 Fprin1 (val, Qnil);
1352 else
1353 Fprint (val, Qnil);
1357 build_load_history (stream, sourcename);
1358 UNGCPRO;
1360 unbind_to (count, Qnil);
1363 DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
1364 doc: /* Execute the current buffer as Lisp code.
1365 Programs can pass two arguments, BUFFER and PRINTFLAG.
1366 BUFFER is the buffer to evaluate (nil means use current buffer).
1367 PRINTFLAG controls printing of output:
1368 nil means discard it; anything else is stream for print.
1370 If the optional third argument FILENAME is non-nil,
1371 it specifies the file name to use for `load-history'.
1372 The optional fourth argument UNIBYTE specifies `load-convert-to-unibyte'
1373 for this invocation.
1375 The optional fifth argument DO-ALLOW-PRINT, if not-nil, specifies that
1376 `print' and related functions should work normally even if PRINTFLAG is nil.
1378 This function preserves the position of point. */)
1379 (buffer, printflag, filename, unibyte, do_allow_print)
1380 Lisp_Object buffer, printflag, filename, unibyte, do_allow_print;
1382 int count = specpdl_ptr - specpdl;
1383 Lisp_Object tem, buf;
1385 if (NILP (buffer))
1386 buf = Fcurrent_buffer ();
1387 else
1388 buf = Fget_buffer (buffer);
1389 if (NILP (buf))
1390 error ("No such buffer");
1392 if (NILP (printflag) && NILP (do_allow_print))
1393 tem = Qsymbolp;
1394 else
1395 tem = printflag;
1397 if (NILP (filename))
1398 filename = XBUFFER (buf)->filename;
1400 specbind (Qstandard_output, tem);
1401 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1402 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
1403 readevalloop (buf, 0, filename, Feval, !NILP (printflag), unibyte, Qnil);
1404 unbind_to (count, Qnil);
1406 return Qnil;
1409 DEFUN ("eval-region", Feval_region, Seval_region, 2, 4, "r",
1410 doc: /* Execute the region as Lisp code.
1411 When called from programs, expects two arguments,
1412 giving starting and ending indices in the current buffer
1413 of the text to be executed.
1414 Programs can pass third argument PRINTFLAG which controls output:
1415 nil means discard it; anything else is stream for printing it.
1416 Also the fourth argument READ-FUNCTION, if non-nil, is used
1417 instead of `read' to read each expression. It gets one argument
1418 which is the input stream for reading characters.
1420 This function does not move point. */)
1421 (start, end, printflag, read_function)
1422 Lisp_Object start, end, printflag, read_function;
1424 int count = specpdl_ptr - specpdl;
1425 Lisp_Object tem, cbuf;
1427 cbuf = Fcurrent_buffer ();
1429 if (NILP (printflag))
1430 tem = Qsymbolp;
1431 else
1432 tem = printflag;
1433 specbind (Qstandard_output, tem);
1435 if (NILP (printflag))
1436 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1437 record_unwind_protect (save_restriction_restore, save_restriction_save ());
1439 /* This both uses start and checks its type. */
1440 Fgoto_char (start);
1441 Fnarrow_to_region (make_number (BEGV), end);
1442 readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval,
1443 !NILP (printflag), Qnil, read_function);
1445 return unbind_to (count, Qnil);
1449 DEFUN ("read", Fread, Sread, 0, 1, 0,
1450 doc: /* Read one Lisp expression as text from STREAM, return as Lisp object.
1451 If STREAM is nil, use the value of `standard-input' (which see).
1452 STREAM or the value of `standard-input' may be:
1453 a buffer (read from point and advance it)
1454 a marker (read from where it points and advance it)
1455 a function (call it with no arguments for each character,
1456 call it with a char as argument to push a char back)
1457 a string (takes text from string, starting at the beginning)
1458 t (read text line using minibuffer and use it, or read from
1459 standard input in batch mode). */)
1460 (stream)
1461 Lisp_Object stream;
1463 if (NILP (stream))
1464 stream = Vstandard_input;
1465 if (EQ (stream, Qt))
1466 stream = Qread_char;
1467 if (EQ (stream, Qread_char))
1468 return Fread_minibuffer (build_string ("Lisp expression: "), Qnil);
1470 return read_internal_start (stream, Qnil, Qnil);
1473 DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0,
1474 doc: /* Read one Lisp expression which is represented as text by STRING.
1475 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1476 START and END optionally delimit a substring of STRING from which to read;
1477 they default to 0 and (length STRING) respectively. */)
1478 (string, start, end)
1479 Lisp_Object string, start, end;
1481 Lisp_Object ret;
1482 CHECK_STRING (string);
1483 /* read_internal_start sets read_from_string_index. */
1484 ret = read_internal_start (string, start, end);
1485 return Fcons (ret, make_number (read_from_string_index));
1488 /* Function to set up the global context we need in toplevel read
1489 calls. */
1490 static Lisp_Object
1491 read_internal_start (stream, start, end)
1492 Lisp_Object stream;
1493 Lisp_Object start; /* Only used when stream is a string. */
1494 Lisp_Object end; /* Only used when stream is a string. */
1496 Lisp_Object retval;
1498 readchar_backlog = -1;
1499 readchar_count = 0;
1500 new_backquote_flag = 0;
1501 read_objects = Qnil;
1502 if (EQ (Vread_with_symbol_positions, Qt)
1503 || EQ (Vread_with_symbol_positions, stream))
1504 Vread_symbol_positions_list = Qnil;
1506 if (STRINGP (stream))
1508 int startval, endval;
1509 if (NILP (end))
1510 endval = XSTRING (stream)->size;
1511 else
1513 CHECK_NUMBER (end);
1514 endval = XINT (end);
1515 if (endval < 0 || endval > XSTRING (stream)->size)
1516 args_out_of_range (stream, end);
1519 if (NILP (start))
1520 startval = 0;
1521 else
1523 CHECK_NUMBER (start);
1524 startval = XINT (start);
1525 if (startval < 0 || startval > endval)
1526 args_out_of_range (stream, start);
1528 read_from_string_index = startval;
1529 read_from_string_index_byte = string_char_to_byte (stream, startval);
1530 read_from_string_limit = endval;
1533 retval = read0 (stream);
1534 if (EQ (Vread_with_symbol_positions, Qt)
1535 || EQ (Vread_with_symbol_positions, stream))
1536 Vread_symbol_positions_list = Fnreverse (Vread_symbol_positions_list);
1537 return retval;
1540 /* Use this for recursive reads, in contexts where internal tokens
1541 are not allowed. */
1543 static Lisp_Object
1544 read0 (readcharfun)
1545 Lisp_Object readcharfun;
1547 register Lisp_Object val;
1548 int c;
1550 val = read1 (readcharfun, &c, 0);
1551 if (c)
1552 Fsignal (Qinvalid_read_syntax, Fcons (Fmake_string (make_number (1),
1553 make_number (c)),
1554 Qnil));
1556 return val;
1559 static int read_buffer_size;
1560 static char *read_buffer;
1562 /* Read multibyte form and return it as a character. C is a first
1563 byte of multibyte form, and rest of them are read from
1564 READCHARFUN. */
1566 static int
1567 read_multibyte (c, readcharfun)
1568 register int c;
1569 Lisp_Object readcharfun;
1571 /* We need the actual character code of this multibyte
1572 characters. */
1573 unsigned char str[MAX_MULTIBYTE_LENGTH];
1574 int len = 0;
1575 int bytes;
1577 if (c < 0)
1578 return c;
1580 str[len++] = c;
1581 while ((c = READCHAR) >= 0xA0
1582 && len < MAX_MULTIBYTE_LENGTH)
1584 str[len++] = c;
1585 readchar_count--;
1587 UNREAD (c);
1588 if (UNIBYTE_STR_AS_MULTIBYTE_P (str, len, bytes))
1589 return STRING_CHAR (str, len);
1590 /* The byte sequence is not valid as multibyte. Unread all bytes
1591 but the first one, and return the first byte. */
1592 while (--len > 0)
1593 UNREAD (str[len]);
1594 return str[0];
1597 /* Read a \-escape sequence, assuming we already read the `\'.
1598 If the escape sequence forces unibyte, store 1 into *BYTEREP.
1599 If the escape sequence forces multibyte, store 2 into *BYTEREP.
1600 Otherwise store 0 into *BYTEREP. */
1602 static int
1603 read_escape (readcharfun, stringp, byterep)
1604 Lisp_Object readcharfun;
1605 int stringp;
1606 int *byterep;
1608 register int c = READCHAR;
1610 *byterep = 0;
1612 switch (c)
1614 case -1:
1615 end_of_file_error ();
1617 case 'a':
1618 return '\007';
1619 case 'b':
1620 return '\b';
1621 case 'd':
1622 return 0177;
1623 case 'e':
1624 return 033;
1625 case 'f':
1626 return '\f';
1627 case 'n':
1628 return '\n';
1629 case 'r':
1630 return '\r';
1631 case 't':
1632 return '\t';
1633 case 'v':
1634 return '\v';
1635 case '\n':
1636 return -1;
1637 case ' ':
1638 if (stringp)
1639 return -1;
1640 return ' ';
1642 case 'M':
1643 c = READCHAR;
1644 if (c != '-')
1645 error ("Invalid escape character syntax");
1646 c = READCHAR;
1647 if (c == '\\')
1648 c = read_escape (readcharfun, 0, byterep);
1649 return c | meta_modifier;
1651 case 'S':
1652 c = READCHAR;
1653 if (c != '-')
1654 error ("Invalid escape character syntax");
1655 c = READCHAR;
1656 if (c == '\\')
1657 c = read_escape (readcharfun, 0, byterep);
1658 return c | shift_modifier;
1660 case 'H':
1661 c = READCHAR;
1662 if (c != '-')
1663 error ("Invalid escape character syntax");
1664 c = READCHAR;
1665 if (c == '\\')
1666 c = read_escape (readcharfun, 0, byterep);
1667 return c | hyper_modifier;
1669 case 'A':
1670 c = READCHAR;
1671 if (c != '-')
1672 error ("Invalid escape character syntax");
1673 c = READCHAR;
1674 if (c == '\\')
1675 c = read_escape (readcharfun, 0, byterep);
1676 return c | alt_modifier;
1678 case 's':
1679 c = READCHAR;
1680 if (c != '-')
1681 error ("Invalid escape character syntax");
1682 c = READCHAR;
1683 if (c == '\\')
1684 c = read_escape (readcharfun, 0, byterep);
1685 return c | super_modifier;
1687 case 'C':
1688 c = READCHAR;
1689 if (c != '-')
1690 error ("Invalid escape character syntax");
1691 case '^':
1692 c = READCHAR;
1693 if (c == '\\')
1694 c = read_escape (readcharfun, 0, byterep);
1695 if ((c & ~CHAR_MODIFIER_MASK) == '?')
1696 return 0177 | (c & CHAR_MODIFIER_MASK);
1697 else if (! SINGLE_BYTE_CHAR_P ((c & ~CHAR_MODIFIER_MASK)))
1698 return c | ctrl_modifier;
1699 /* ASCII control chars are made from letters (both cases),
1700 as well as the non-letters within 0100...0137. */
1701 else if ((c & 0137) >= 0101 && (c & 0137) <= 0132)
1702 return (c & (037 | ~0177));
1703 else if ((c & 0177) >= 0100 && (c & 0177) <= 0137)
1704 return (c & (037 | ~0177));
1705 else
1706 return c | ctrl_modifier;
1708 case '0':
1709 case '1':
1710 case '2':
1711 case '3':
1712 case '4':
1713 case '5':
1714 case '6':
1715 case '7':
1716 /* An octal escape, as in ANSI C. */
1718 register int i = c - '0';
1719 register int count = 0;
1720 while (++count < 3)
1722 if ((c = READCHAR) >= '0' && c <= '7')
1724 i *= 8;
1725 i += c - '0';
1727 else
1729 UNREAD (c);
1730 break;
1734 *byterep = 1;
1735 return i;
1738 case 'x':
1739 /* A hex escape, as in ANSI C. */
1741 int i = 0;
1742 while (1)
1744 c = READCHAR;
1745 if (c >= '0' && c <= '9')
1747 i *= 16;
1748 i += c - '0';
1750 else if ((c >= 'a' && c <= 'f')
1751 || (c >= 'A' && c <= 'F'))
1753 i *= 16;
1754 if (c >= 'a' && c <= 'f')
1755 i += c - 'a' + 10;
1756 else
1757 i += c - 'A' + 10;
1759 else
1761 UNREAD (c);
1762 break;
1766 *byterep = 2;
1767 return i;
1770 default:
1771 if (BASE_LEADING_CODE_P (c))
1772 c = read_multibyte (c, readcharfun);
1773 return c;
1778 /* Read an integer in radix RADIX using READCHARFUN to read
1779 characters. RADIX must be in the interval [2..36]; if it isn't, a
1780 read error is signaled . Value is the integer read. Signals an
1781 error if encountering invalid read syntax or if RADIX is out of
1782 range. */
1784 static Lisp_Object
1785 read_integer (readcharfun, radix)
1786 Lisp_Object readcharfun;
1787 int radix;
1789 int ndigits = 0, invalid_p, c, sign = 0;
1790 EMACS_INT number = 0;
1792 if (radix < 2 || radix > 36)
1793 invalid_p = 1;
1794 else
1796 number = ndigits = invalid_p = 0;
1797 sign = 1;
1799 c = READCHAR;
1800 if (c == '-')
1802 c = READCHAR;
1803 sign = -1;
1805 else if (c == '+')
1806 c = READCHAR;
1808 while (c >= 0)
1810 int digit;
1812 if (c >= '0' && c <= '9')
1813 digit = c - '0';
1814 else if (c >= 'a' && c <= 'z')
1815 digit = c - 'a' + 10;
1816 else if (c >= 'A' && c <= 'Z')
1817 digit = c - 'A' + 10;
1818 else
1820 UNREAD (c);
1821 break;
1824 if (digit < 0 || digit >= radix)
1825 invalid_p = 1;
1827 number = radix * number + digit;
1828 ++ndigits;
1829 c = READCHAR;
1833 if (ndigits == 0 || invalid_p)
1835 char buf[50];
1836 sprintf (buf, "integer, radix %d", radix);
1837 Fsignal (Qinvalid_read_syntax, Fcons (build_string (buf), Qnil));
1840 return make_number (sign * number);
1844 /* Convert unibyte text in read_buffer to multibyte.
1846 Initially, *P is a pointer after the end of the unibyte text, and
1847 the pointer *END points after the end of read_buffer.
1849 If read_buffer doesn't have enough room to hold the result
1850 of the conversion, reallocate it and adjust *P and *END.
1852 At the end, make *P point after the result of the conversion, and
1853 return in *NCHARS the number of characters in the converted
1854 text. */
1856 static void
1857 to_multibyte (p, end, nchars)
1858 char **p, **end;
1859 int *nchars;
1861 int nbytes;
1863 parse_str_as_multibyte (read_buffer, *p - read_buffer, &nbytes, nchars);
1864 if (read_buffer_size < 2 * nbytes)
1866 int offset = *p - read_buffer;
1867 read_buffer_size = 2 * max (read_buffer_size, nbytes);
1868 read_buffer = (char *) xrealloc (read_buffer, read_buffer_size);
1869 *p = read_buffer + offset;
1870 *end = read_buffer + read_buffer_size;
1873 if (nbytes != *nchars)
1874 nbytes = str_as_multibyte (read_buffer, read_buffer_size,
1875 *p - read_buffer, nchars);
1877 *p = read_buffer + nbytes;
1881 /* If the next token is ')' or ']' or '.', we store that character
1882 in *PCH and the return value is not interesting. Else, we store
1883 zero in *PCH and we read and return one lisp object.
1885 FIRST_IN_LIST is nonzero if this is the first element of a list. */
1887 static Lisp_Object
1888 read1 (readcharfun, pch, first_in_list)
1889 register Lisp_Object readcharfun;
1890 int *pch;
1891 int first_in_list;
1893 register int c;
1894 int uninterned_symbol = 0;
1896 *pch = 0;
1898 retry:
1900 c = READCHAR;
1901 if (c < 0)
1902 end_of_file_error ();
1904 switch (c)
1906 case '(':
1907 return read_list (0, readcharfun);
1909 case '[':
1910 return read_vector (readcharfun, 0);
1912 case ')':
1913 case ']':
1915 *pch = c;
1916 return Qnil;
1919 case '#':
1920 c = READCHAR;
1921 if (c == '^')
1923 c = READCHAR;
1924 if (c == '[')
1926 Lisp_Object tmp;
1927 tmp = read_vector (readcharfun, 0);
1928 if (XVECTOR (tmp)->size < CHAR_TABLE_STANDARD_SLOTS
1929 || XVECTOR (tmp)->size > CHAR_TABLE_STANDARD_SLOTS + 10)
1930 error ("Invalid size char-table");
1931 XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));
1932 XCHAR_TABLE (tmp)->top = Qt;
1933 return tmp;
1935 else if (c == '^')
1937 c = READCHAR;
1938 if (c == '[')
1940 Lisp_Object tmp;
1941 tmp = read_vector (readcharfun, 0);
1942 if (XVECTOR (tmp)->size != SUB_CHAR_TABLE_STANDARD_SLOTS)
1943 error ("Invalid size char-table");
1944 XSETCHAR_TABLE (tmp, XCHAR_TABLE (tmp));
1945 XCHAR_TABLE (tmp)->top = Qnil;
1946 return tmp;
1948 Fsignal (Qinvalid_read_syntax,
1949 Fcons (make_string ("#^^", 3), Qnil));
1951 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#^", 2), Qnil));
1953 if (c == '&')
1955 Lisp_Object length;
1956 length = read1 (readcharfun, pch, first_in_list);
1957 c = READCHAR;
1958 if (c == '"')
1960 Lisp_Object tmp, val;
1961 int size_in_chars = ((XFASTINT (length) + BITS_PER_CHAR - 1)
1962 / BITS_PER_CHAR);
1964 UNREAD (c);
1965 tmp = read1 (readcharfun, pch, first_in_list);
1966 if (size_in_chars != XSTRING (tmp)->size
1967 /* We used to print 1 char too many
1968 when the number of bits was a multiple of 8.
1969 Accept such input in case it came from an old version. */
1970 && ! (XFASTINT (length)
1971 == (XSTRING (tmp)->size - 1) * BITS_PER_CHAR))
1972 Fsignal (Qinvalid_read_syntax,
1973 Fcons (make_string ("#&...", 5), Qnil));
1975 val = Fmake_bool_vector (length, Qnil);
1976 bcopy (XSTRING (tmp)->data, XBOOL_VECTOR (val)->data,
1977 size_in_chars);
1978 /* Clear the extraneous bits in the last byte. */
1979 if (XINT (length) != size_in_chars * BITS_PER_CHAR)
1980 XBOOL_VECTOR (val)->data[size_in_chars - 1]
1981 &= (1 << (XINT (length) % BITS_PER_CHAR)) - 1;
1982 return val;
1984 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5),
1985 Qnil));
1987 if (c == '[')
1989 /* Accept compiled functions at read-time so that we don't have to
1990 build them using function calls. */
1991 Lisp_Object tmp;
1992 tmp = read_vector (readcharfun, 1);
1993 return Fmake_byte_code (XVECTOR (tmp)->size,
1994 XVECTOR (tmp)->contents);
1996 if (c == '(')
1998 Lisp_Object tmp;
1999 struct gcpro gcpro1;
2000 int ch;
2002 /* Read the string itself. */
2003 tmp = read1 (readcharfun, &ch, 0);
2004 if (ch != 0 || !STRINGP (tmp))
2005 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
2006 GCPRO1 (tmp);
2007 /* Read the intervals and their properties. */
2008 while (1)
2010 Lisp_Object beg, end, plist;
2012 beg = read1 (readcharfun, &ch, 0);
2013 end = plist = Qnil;
2014 if (ch == ')')
2015 break;
2016 if (ch == 0)
2017 end = read1 (readcharfun, &ch, 0);
2018 if (ch == 0)
2019 plist = read1 (readcharfun, &ch, 0);
2020 if (ch)
2021 Fsignal (Qinvalid_read_syntax,
2022 Fcons (build_string ("invalid string property list"),
2023 Qnil));
2024 Fset_text_properties (beg, end, plist, tmp);
2026 UNGCPRO;
2027 return tmp;
2030 /* #@NUMBER is used to skip NUMBER following characters.
2031 That's used in .elc files to skip over doc strings
2032 and function definitions. */
2033 if (c == '@')
2035 int i, nskip = 0;
2037 /* Read a decimal integer. */
2038 while ((c = READCHAR) >= 0
2039 && c >= '0' && c <= '9')
2041 nskip *= 10;
2042 nskip += c - '0';
2044 if (c >= 0)
2045 UNREAD (c);
2047 if (load_force_doc_strings && EQ (readcharfun, Qget_file_char))
2049 /* If we are supposed to force doc strings into core right now,
2050 record the last string that we skipped,
2051 and record where in the file it comes from. */
2053 /* But first exchange saved_doc_string
2054 with prev_saved_doc_string, so we save two strings. */
2056 char *temp = saved_doc_string;
2057 int temp_size = saved_doc_string_size;
2058 file_offset temp_pos = saved_doc_string_position;
2059 int temp_len = saved_doc_string_length;
2061 saved_doc_string = prev_saved_doc_string;
2062 saved_doc_string_size = prev_saved_doc_string_size;
2063 saved_doc_string_position = prev_saved_doc_string_position;
2064 saved_doc_string_length = prev_saved_doc_string_length;
2066 prev_saved_doc_string = temp;
2067 prev_saved_doc_string_size = temp_size;
2068 prev_saved_doc_string_position = temp_pos;
2069 prev_saved_doc_string_length = temp_len;
2072 if (saved_doc_string_size == 0)
2074 saved_doc_string_size = nskip + 100;
2075 saved_doc_string = (char *) xmalloc (saved_doc_string_size);
2077 if (nskip > saved_doc_string_size)
2079 saved_doc_string_size = nskip + 100;
2080 saved_doc_string = (char *) xrealloc (saved_doc_string,
2081 saved_doc_string_size);
2084 saved_doc_string_position = file_tell (instream);
2086 /* Copy that many characters into saved_doc_string. */
2087 for (i = 0; i < nskip && c >= 0; i++)
2088 saved_doc_string[i] = c = READCHAR;
2090 saved_doc_string_length = i;
2092 else
2094 /* Skip that many characters. */
2095 for (i = 0; i < nskip && c >= 0; i++)
2096 c = READCHAR;
2099 goto retry;
2101 if (c == '$')
2102 return Vload_file_name;
2103 if (c == '\'')
2104 return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil));
2105 /* #:foo is the uninterned symbol named foo. */
2106 if (c == ':')
2108 uninterned_symbol = 1;
2109 c = READCHAR;
2110 goto default_label;
2112 /* Reader forms that can reuse previously read objects. */
2113 if (c >= '0' && c <= '9')
2115 int n = 0;
2116 Lisp_Object tem;
2118 /* Read a non-negative integer. */
2119 while (c >= '0' && c <= '9')
2121 n *= 10;
2122 n += c - '0';
2123 c = READCHAR;
2125 /* #n=object returns object, but associates it with n for #n#. */
2126 if (c == '=')
2128 /* Make a placeholder for #n# to use temporarily */
2129 Lisp_Object placeholder;
2130 Lisp_Object cell;
2132 placeholder = Fcons(Qnil, Qnil);
2133 cell = Fcons (make_number (n), placeholder);
2134 read_objects = Fcons (cell, read_objects);
2136 /* Read the object itself. */
2137 tem = read0 (readcharfun);
2139 /* Now put it everywhere the placeholder was... */
2140 substitute_object_in_subtree (tem, placeholder);
2142 /* ...and #n# will use the real value from now on. */
2143 Fsetcdr (cell, tem);
2145 return tem;
2147 /* #n# returns a previously read object. */
2148 if (c == '#')
2150 tem = Fassq (make_number (n), read_objects);
2151 if (CONSP (tem))
2152 return XCDR (tem);
2153 /* Fall through to error message. */
2155 else if (c == 'r' || c == 'R')
2156 return read_integer (readcharfun, n);
2158 /* Fall through to error message. */
2160 else if (c == 'x' || c == 'X')
2161 return read_integer (readcharfun, 16);
2162 else if (c == 'o' || c == 'O')
2163 return read_integer (readcharfun, 8);
2164 else if (c == 'b' || c == 'B')
2165 return read_integer (readcharfun, 2);
2167 UNREAD (c);
2168 Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#", 1), Qnil));
2170 case ';':
2171 while ((c = READCHAR) >= 0 && c != '\n');
2172 goto retry;
2174 case '\'':
2176 return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
2179 case '`':
2180 if (first_in_list)
2181 goto default_label;
2182 else
2184 Lisp_Object value;
2186 new_backquote_flag++;
2187 value = read0 (readcharfun);
2188 new_backquote_flag--;
2190 return Fcons (Qbackquote, Fcons (value, Qnil));
2193 case ',':
2194 if (new_backquote_flag)
2196 Lisp_Object comma_type = Qnil;
2197 Lisp_Object value;
2198 int ch = READCHAR;
2200 if (ch == '@')
2201 comma_type = Qcomma_at;
2202 else if (ch == '.')
2203 comma_type = Qcomma_dot;
2204 else
2206 if (ch >= 0) UNREAD (ch);
2207 comma_type = Qcomma;
2210 new_backquote_flag--;
2211 value = read0 (readcharfun);
2212 new_backquote_flag++;
2213 return Fcons (comma_type, Fcons (value, Qnil));
2215 else
2216 goto default_label;
2218 case '?':
2220 int discard;
2222 c = READCHAR;
2223 if (c < 0)
2224 end_of_file_error ();
2226 if (c == '\\')
2227 c = read_escape (readcharfun, 0, &discard);
2228 else if (BASE_LEADING_CODE_P (c))
2229 c = read_multibyte (c, readcharfun);
2231 return make_number (c);
2234 case '"':
2236 char *p = read_buffer;
2237 char *end = read_buffer + read_buffer_size;
2238 register int c;
2239 /* 1 if we saw an escape sequence specifying
2240 a multibyte character, or a multibyte character. */
2241 int force_multibyte = 0;
2242 /* 1 if we saw an escape sequence specifying
2243 a single-byte character. */
2244 int force_singlebyte = 0;
2245 /* 1 if read_buffer contains multibyte text now. */
2246 int is_multibyte = 0;
2247 int cancel = 0;
2248 int nchars = 0;
2250 while ((c = READCHAR) >= 0
2251 && c != '\"')
2253 if (end - p < MAX_MULTIBYTE_LENGTH)
2255 int offset = p - read_buffer;
2256 read_buffer = (char *) xrealloc (read_buffer,
2257 read_buffer_size *= 2);
2258 p = read_buffer + offset;
2259 end = read_buffer + read_buffer_size;
2262 if (c == '\\')
2264 int byterep;
2266 c = read_escape (readcharfun, 1, &byterep);
2268 /* C is -1 if \ newline has just been seen */
2269 if (c == -1)
2271 if (p == read_buffer)
2272 cancel = 1;
2273 continue;
2276 if (byterep == 1)
2277 force_singlebyte = 1;
2278 else if (byterep == 2)
2279 force_multibyte = 1;
2282 /* A character that must be multibyte forces multibyte. */
2283 if (! SINGLE_BYTE_CHAR_P (c & ~CHAR_MODIFIER_MASK))
2284 force_multibyte = 1;
2286 /* If we just discovered the need to be multibyte,
2287 convert the text accumulated thus far. */
2288 if (force_multibyte && ! is_multibyte)
2290 is_multibyte = 1;
2291 to_multibyte (&p, &end, &nchars);
2294 /* Allow `\C- ' and `\C-?'. */
2295 if (c == (CHAR_CTL | ' '))
2296 c = 0;
2297 else if (c == (CHAR_CTL | '?'))
2298 c = 127;
2300 if (c & CHAR_SHIFT)
2302 /* Shift modifier is valid only with [A-Za-z]. */
2303 if ((c & 0377) >= 'A' && (c & 0377) <= 'Z')
2304 c &= ~CHAR_SHIFT;
2305 else if ((c & 0377) >= 'a' && (c & 0377) <= 'z')
2306 c = (c & ~CHAR_SHIFT) - ('a' - 'A');
2309 if (c & CHAR_META)
2310 /* Move the meta bit to the right place for a string. */
2311 c = (c & ~CHAR_META) | 0x80;
2312 if (c & CHAR_MODIFIER_MASK)
2313 error ("Invalid modifier in string");
2315 if (is_multibyte)
2316 p += CHAR_STRING (c, p);
2317 else
2318 *p++ = c;
2320 nchars++;
2323 if (c < 0)
2324 end_of_file_error ();
2326 /* If purifying, and string starts with \ newline,
2327 return zero instead. This is for doc strings
2328 that we are really going to find in etc/DOC.nn.nn */
2329 if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
2330 return make_number (0);
2332 if (is_multibyte || force_singlebyte)
2334 else if (load_convert_to_unibyte)
2336 Lisp_Object string;
2337 to_multibyte (&p, &end, &nchars);
2338 if (p - read_buffer != nchars)
2340 string = make_multibyte_string (read_buffer, nchars,
2341 p - read_buffer);
2342 return Fstring_make_unibyte (string);
2344 /* We can make a unibyte string directly. */
2345 is_multibyte = 0;
2347 else if (EQ (readcharfun, Qget_file_char)
2348 || EQ (readcharfun, Qlambda))
2350 /* Nowadays, reading directly from a file is used only for
2351 compiled Emacs Lisp files, and those always use the
2352 Emacs internal encoding. Meanwhile, Qlambda is used
2353 for reading dynamic byte code (compiled with
2354 byte-compile-dynamic = t). So make the string multibyte
2355 if the string contains any multibyte sequences.
2356 (to_multibyte is a no-op if not.) */
2357 to_multibyte (&p, &end, &nchars);
2358 is_multibyte = (p - read_buffer) != nchars;
2360 else
2361 /* In all other cases, if we read these bytes as
2362 separate characters, treat them as separate characters now. */
2365 /* We want readchar_count to be the number of characters, not
2366 bytes. Hence we adjust for multibyte characters in the
2367 string. ... But it doesn't seem to be necessary, because
2368 READCHAR *does* read multibyte characters from buffers. */
2369 /* readchar_count -= (p - read_buffer) - nchars; */
2370 if (read_pure)
2371 return make_pure_string (read_buffer, nchars, p - read_buffer,
2372 is_multibyte);
2373 return make_specified_string (read_buffer, nchars, p - read_buffer,
2374 is_multibyte);
2377 case '.':
2379 int next_char = READCHAR;
2380 UNREAD (next_char);
2382 if (next_char <= 040
2383 || index ("\"'`,(", next_char))
2385 *pch = c;
2386 return Qnil;
2389 /* Otherwise, we fall through! Note that the atom-reading loop
2390 below will now loop at least once, assuring that we will not
2391 try to UNREAD two characters in a row. */
2393 default:
2394 default_label:
2395 if (c <= 040) goto retry;
2397 char *p = read_buffer;
2398 int quoted = 0;
2401 char *end = read_buffer + read_buffer_size;
2403 while (c > 040
2404 && !(c == '\"' || c == '\'' || c == ';'
2405 || c == '(' || c == ')'
2406 || c == '[' || c == ']' || c == '#'))
2408 if (end - p < MAX_MULTIBYTE_LENGTH)
2410 int offset = p - read_buffer;
2411 read_buffer = (char *) xrealloc (read_buffer,
2412 read_buffer_size *= 2);
2413 p = read_buffer + offset;
2414 end = read_buffer + read_buffer_size;
2417 if (c == '\\')
2419 c = READCHAR;
2420 if (c == -1)
2421 end_of_file_error ();
2422 quoted = 1;
2425 if (! SINGLE_BYTE_CHAR_P (c))
2426 p += CHAR_STRING (c, p);
2427 else
2428 *p++ = c;
2430 c = READCHAR;
2433 if (p == end)
2435 int offset = p - read_buffer;
2436 read_buffer = (char *) xrealloc (read_buffer,
2437 read_buffer_size *= 2);
2438 p = read_buffer + offset;
2439 end = read_buffer + read_buffer_size;
2441 *p = 0;
2442 if (c >= 0)
2443 UNREAD (c);
2446 if (!quoted && !uninterned_symbol)
2448 register char *p1;
2449 register Lisp_Object val;
2450 p1 = read_buffer;
2451 if (*p1 == '+' || *p1 == '-') p1++;
2452 /* Is it an integer? */
2453 if (p1 != p)
2455 while (p1 != p && (c = *p1) >= '0' && c <= '9') p1++;
2456 /* Integers can have trailing decimal points. */
2457 if (p1 > read_buffer && p1 < p && *p1 == '.') p1++;
2458 if (p1 == p)
2459 /* It is an integer. */
2461 if (p1[-1] == '.')
2462 p1[-1] = '\0';
2463 if (sizeof (int) == sizeof (EMACS_INT))
2464 XSETINT (val, atoi (read_buffer));
2465 else if (sizeof (long) == sizeof (EMACS_INT))
2466 XSETINT (val, atol (read_buffer));
2467 else
2468 abort ();
2469 return val;
2472 if (isfloat_string (read_buffer))
2474 /* Compute NaN and infinities using 0.0 in a variable,
2475 to cope with compilers that think they are smarter
2476 than we are. */
2477 double zero = 0.0;
2479 double value;
2481 /* Negate the value ourselves. This treats 0, NaNs,
2482 and infinity properly on IEEE floating point hosts,
2483 and works around a common bug where atof ("-0.0")
2484 drops the sign. */
2485 int negative = read_buffer[0] == '-';
2487 /* The only way p[-1] can be 'F' or 'N', after isfloat_string
2488 returns 1, is if the input ends in e+INF or e+NaN. */
2489 switch (p[-1])
2491 case 'F':
2492 value = 1.0 / zero;
2493 break;
2494 case 'N':
2495 value = zero / zero;
2496 break;
2497 default:
2498 value = atof (read_buffer + negative);
2499 break;
2502 return make_float (negative ? - value : value);
2506 Lisp_Object result = uninterned_symbol ? make_symbol (read_buffer)
2507 : intern (read_buffer);
2508 if (EQ (Vread_with_symbol_positions, Qt)
2509 || EQ (Vread_with_symbol_positions, readcharfun))
2510 Vread_symbol_positions_list =
2511 /* Kind of a hack; this will probably fail if characters
2512 in the symbol name were escaped. Not really a big
2513 deal, though. */
2514 Fcons (Fcons (result,
2515 make_number (readchar_count
2516 - XFASTINT (Flength (Fsymbol_name (result))))),
2517 Vread_symbol_positions_list);
2518 return result;
2525 /* List of nodes we've seen during substitute_object_in_subtree. */
2526 static Lisp_Object seen_list;
2528 static void
2529 substitute_object_in_subtree (object, placeholder)
2530 Lisp_Object object;
2531 Lisp_Object placeholder;
2533 Lisp_Object check_object;
2535 /* We haven't seen any objects when we start. */
2536 seen_list = Qnil;
2538 /* Make all the substitutions. */
2539 check_object
2540 = substitute_object_recurse (object, placeholder, object);
2542 /* Clear seen_list because we're done with it. */
2543 seen_list = Qnil;
2545 /* The returned object here is expected to always eq the
2546 original. */
2547 if (!EQ (check_object, object))
2548 error ("Unexpected mutation error in reader");
2551 /* Feval doesn't get called from here, so no gc protection is needed. */
2552 #define SUBSTITUTE(get_val, set_val) \
2554 Lisp_Object old_value = get_val; \
2555 Lisp_Object true_value \
2556 = substitute_object_recurse (object, placeholder,\
2557 old_value); \
2559 if (!EQ (old_value, true_value)) \
2561 set_val; \
2565 static Lisp_Object
2566 substitute_object_recurse (object, placeholder, subtree)
2567 Lisp_Object object;
2568 Lisp_Object placeholder;
2569 Lisp_Object subtree;
2571 /* If we find the placeholder, return the target object. */
2572 if (EQ (placeholder, subtree))
2573 return object;
2575 /* If we've been to this node before, don't explore it again. */
2576 if (!EQ (Qnil, Fmemq (subtree, seen_list)))
2577 return subtree;
2579 /* If this node can be the entry point to a cycle, remember that
2580 we've seen it. It can only be such an entry point if it was made
2581 by #n=, which means that we can find it as a value in
2582 read_objects. */
2583 if (!EQ (Qnil, Frassq (subtree, read_objects)))
2584 seen_list = Fcons (subtree, seen_list);
2586 /* Recurse according to subtree's type.
2587 Every branch must return a Lisp_Object. */
2588 switch (XTYPE (subtree))
2590 case Lisp_Vectorlike:
2592 int i;
2593 int length = XINT (Flength(subtree));
2594 for (i = 0; i < length; i++)
2596 Lisp_Object idx = make_number (i);
2597 SUBSTITUTE (Faref (subtree, idx),
2598 Faset (subtree, idx, true_value));
2600 return subtree;
2603 case Lisp_Cons:
2605 SUBSTITUTE (Fcar_safe (subtree),
2606 Fsetcar (subtree, true_value));
2607 SUBSTITUTE (Fcdr_safe (subtree),
2608 Fsetcdr (subtree, true_value));
2609 return subtree;
2612 case Lisp_String:
2614 /* Check for text properties in each interval.
2615 substitute_in_interval contains part of the logic. */
2617 INTERVAL root_interval = XSTRING (subtree)->intervals;
2618 Lisp_Object arg = Fcons (object, placeholder);
2620 traverse_intervals_noorder (root_interval,
2621 &substitute_in_interval, arg);
2623 return subtree;
2626 /* Other types don't recurse any further. */
2627 default:
2628 return subtree;
2632 /* Helper function for substitute_object_recurse. */
2633 static void
2634 substitute_in_interval (interval, arg)
2635 INTERVAL interval;
2636 Lisp_Object arg;
2638 Lisp_Object object = Fcar (arg);
2639 Lisp_Object placeholder = Fcdr (arg);
2641 SUBSTITUTE(interval->plist, interval->plist = true_value);
2645 #define LEAD_INT 1
2646 #define DOT_CHAR 2
2647 #define TRAIL_INT 4
2648 #define E_CHAR 8
2649 #define EXP_INT 16
2652 isfloat_string (cp)
2653 register char *cp;
2655 register int state;
2657 char *start = cp;
2659 state = 0;
2660 if (*cp == '+' || *cp == '-')
2661 cp++;
2663 if (*cp >= '0' && *cp <= '9')
2665 state |= LEAD_INT;
2666 while (*cp >= '0' && *cp <= '9')
2667 cp++;
2669 if (*cp == '.')
2671 state |= DOT_CHAR;
2672 cp++;
2674 if (*cp >= '0' && *cp <= '9')
2676 state |= TRAIL_INT;
2677 while (*cp >= '0' && *cp <= '9')
2678 cp++;
2680 if (*cp == 'e' || *cp == 'E')
2682 state |= E_CHAR;
2683 cp++;
2684 if (*cp == '+' || *cp == '-')
2685 cp++;
2688 if (*cp >= '0' && *cp <= '9')
2690 state |= EXP_INT;
2691 while (*cp >= '0' && *cp <= '9')
2692 cp++;
2694 else if (cp == start)
2696 else if (cp[-1] == '+' && cp[0] == 'I' && cp[1] == 'N' && cp[2] == 'F')
2698 state |= EXP_INT;
2699 cp += 3;
2701 else if (cp[-1] == '+' && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
2703 state |= EXP_INT;
2704 cp += 3;
2707 return (((*cp == 0) || (*cp == ' ') || (*cp == '\t') || (*cp == '\n') || (*cp == '\r') || (*cp == '\f'))
2708 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
2709 || state == (DOT_CHAR|TRAIL_INT)
2710 || state == (LEAD_INT|E_CHAR|EXP_INT)
2711 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
2712 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
2716 static Lisp_Object
2717 read_vector (readcharfun, bytecodeflag)
2718 Lisp_Object readcharfun;
2719 int bytecodeflag;
2721 register int i;
2722 register int size;
2723 register Lisp_Object *ptr;
2724 register Lisp_Object tem, item, vector;
2725 register struct Lisp_Cons *otem;
2726 Lisp_Object len;
2728 tem = read_list (1, readcharfun);
2729 len = Flength (tem);
2730 vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
2732 size = XVECTOR (vector)->size;
2733 ptr = XVECTOR (vector)->contents;
2734 for (i = 0; i < size; i++)
2736 item = Fcar (tem);
2737 /* If `load-force-doc-strings' is t when reading a lazily-loaded
2738 bytecode object, the docstring containing the bytecode and
2739 constants values must be treated as unibyte and passed to
2740 Fread, to get the actual bytecode string and constants vector. */
2741 if (bytecodeflag && load_force_doc_strings)
2743 if (i == COMPILED_BYTECODE)
2745 if (!STRINGP (item))
2746 error ("invalid byte code");
2748 /* Delay handling the bytecode slot until we know whether
2749 it is lazily-loaded (we can tell by whether the
2750 constants slot is nil). */
2751 ptr[COMPILED_CONSTANTS] = item;
2752 item = Qnil;
2754 else if (i == COMPILED_CONSTANTS)
2756 Lisp_Object bytestr = ptr[COMPILED_CONSTANTS];
2758 if (NILP (item))
2760 /* Coerce string to unibyte (like string-as-unibyte,
2761 but without generating extra garbage and
2762 guaranteeing no change in the contents). */
2763 XSTRING (bytestr)->size = STRING_BYTES (XSTRING (bytestr));
2764 SET_STRING_BYTES (XSTRING (bytestr), -1);
2766 item = Fread (bytestr);
2767 if (!CONSP (item))
2768 error ("invalid byte code");
2770 otem = XCONS (item);
2771 bytestr = XCAR (item);
2772 item = XCDR (item);
2773 free_cons (otem);
2776 /* Now handle the bytecode slot. */
2777 ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;
2780 ptr[i] = read_pure ? Fpurecopy (item) : item;
2781 otem = XCONS (tem);
2782 tem = Fcdr (tem);
2783 free_cons (otem);
2785 return vector;
2788 /* FLAG = 1 means check for ] to terminate rather than ) and .
2789 FLAG = -1 means check for starting with defun
2790 and make structure pure. */
2792 static Lisp_Object
2793 read_list (flag, readcharfun)
2794 int flag;
2795 register Lisp_Object readcharfun;
2797 /* -1 means check next element for defun,
2798 0 means don't check,
2799 1 means already checked and found defun. */
2800 int defunflag = flag < 0 ? -1 : 0;
2801 Lisp_Object val, tail;
2802 register Lisp_Object elt, tem;
2803 struct gcpro gcpro1, gcpro2;
2804 /* 0 is the normal case.
2805 1 means this list is a doc reference; replace it with the number 0.
2806 2 means this list is a doc reference; replace it with the doc string. */
2807 int doc_reference = 0;
2809 /* Initialize this to 1 if we are reading a list. */
2810 int first_in_list = flag <= 0;
2812 val = Qnil;
2813 tail = Qnil;
2815 while (1)
2817 int ch;
2818 GCPRO2 (val, tail);
2819 elt = read1 (readcharfun, &ch, first_in_list);
2820 UNGCPRO;
2822 first_in_list = 0;
2824 /* While building, if the list starts with #$, treat it specially. */
2825 if (EQ (elt, Vload_file_name)
2826 && ! NILP (elt)
2827 && !NILP (Vpurify_flag))
2829 if (NILP (Vdoc_file_name))
2830 /* We have not yet called Snarf-documentation, so assume
2831 this file is described in the DOC-MM.NN file
2832 and Snarf-documentation will fill in the right value later.
2833 For now, replace the whole list with 0. */
2834 doc_reference = 1;
2835 else
2836 /* We have already called Snarf-documentation, so make a relative
2837 file name for this file, so it can be found properly
2838 in the installed Lisp directory.
2839 We don't use Fexpand_file_name because that would make
2840 the directory absolute now. */
2841 elt = concat2 (build_string ("../lisp/"),
2842 Ffile_name_nondirectory (elt));
2844 else if (EQ (elt, Vload_file_name)
2845 && ! NILP (elt)
2846 && load_force_doc_strings)
2847 doc_reference = 2;
2849 if (ch)
2851 if (flag > 0)
2853 if (ch == ']')
2854 return val;
2855 Fsignal (Qinvalid_read_syntax,
2856 Fcons (make_string (") or . in a vector", 18), Qnil));
2858 if (ch == ')')
2859 return val;
2860 if (ch == '.')
2862 GCPRO2 (val, tail);
2863 if (!NILP (tail))
2864 XSETCDR (tail, read0 (readcharfun));
2865 else
2866 val = read0 (readcharfun);
2867 read1 (readcharfun, &ch, 0);
2868 UNGCPRO;
2869 if (ch == ')')
2871 if (doc_reference == 1)
2872 return make_number (0);
2873 if (doc_reference == 2)
2875 /* Get a doc string from the file we are loading.
2876 If it's in saved_doc_string, get it from there. */
2877 int pos = XINT (XCDR (val));
2878 /* Position is negative for user variables. */
2879 if (pos < 0) pos = -pos;
2880 if (pos >= saved_doc_string_position
2881 && pos < (saved_doc_string_position
2882 + saved_doc_string_length))
2884 int start = pos - saved_doc_string_position;
2885 int from, to;
2887 /* Process quoting with ^A,
2888 and find the end of the string,
2889 which is marked with ^_ (037). */
2890 for (from = start, to = start;
2891 saved_doc_string[from] != 037;)
2893 int c = saved_doc_string[from++];
2894 if (c == 1)
2896 c = saved_doc_string[from++];
2897 if (c == 1)
2898 saved_doc_string[to++] = c;
2899 else if (c == '0')
2900 saved_doc_string[to++] = 0;
2901 else if (c == '_')
2902 saved_doc_string[to++] = 037;
2904 else
2905 saved_doc_string[to++] = c;
2908 return make_string (saved_doc_string + start,
2909 to - start);
2911 /* Look in prev_saved_doc_string the same way. */
2912 else if (pos >= prev_saved_doc_string_position
2913 && pos < (prev_saved_doc_string_position
2914 + prev_saved_doc_string_length))
2916 int start = pos - prev_saved_doc_string_position;
2917 int from, to;
2919 /* Process quoting with ^A,
2920 and find the end of the string,
2921 which is marked with ^_ (037). */
2922 for (from = start, to = start;
2923 prev_saved_doc_string[from] != 037;)
2925 int c = prev_saved_doc_string[from++];
2926 if (c == 1)
2928 c = prev_saved_doc_string[from++];
2929 if (c == 1)
2930 prev_saved_doc_string[to++] = c;
2931 else if (c == '0')
2932 prev_saved_doc_string[to++] = 0;
2933 else if (c == '_')
2934 prev_saved_doc_string[to++] = 037;
2936 else
2937 prev_saved_doc_string[to++] = c;
2940 return make_string (prev_saved_doc_string + start,
2941 to - start);
2943 else
2944 return get_doc_string (val, 0, 0);
2947 return val;
2949 return Fsignal (Qinvalid_read_syntax, Fcons (make_string (". in wrong context", 18), Qnil));
2951 return Fsignal (Qinvalid_read_syntax, Fcons (make_string ("] in a list", 11), Qnil));
2953 tem = (read_pure && flag <= 0
2954 ? pure_cons (elt, Qnil)
2955 : Fcons (elt, Qnil));
2956 if (!NILP (tail))
2957 XSETCDR (tail, tem);
2958 else
2959 val = tem;
2960 tail = tem;
2961 if (defunflag < 0)
2962 defunflag = EQ (elt, Qdefun);
2963 else if (defunflag > 0)
2964 read_pure = 1;
2968 Lisp_Object Vobarray;
2969 Lisp_Object initial_obarray;
2971 /* oblookup stores the bucket number here, for the sake of Funintern. */
2973 int oblookup_last_bucket_number;
2975 static int hash_string ();
2976 Lisp_Object oblookup ();
2978 /* Get an error if OBARRAY is not an obarray.
2979 If it is one, return it. */
2981 Lisp_Object
2982 check_obarray (obarray)
2983 Lisp_Object obarray;
2985 while (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
2987 /* If Vobarray is now invalid, force it to be valid. */
2988 if (EQ (Vobarray, obarray)) Vobarray = initial_obarray;
2990 obarray = wrong_type_argument (Qvectorp, obarray);
2992 return obarray;
2995 /* Intern the C string STR: return a symbol with that name,
2996 interned in the current obarray. */
2998 Lisp_Object
2999 intern (str)
3000 char *str;
3002 Lisp_Object tem;
3003 int len = strlen (str);
3004 Lisp_Object obarray;
3006 obarray = Vobarray;
3007 if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0)
3008 obarray = check_obarray (obarray);
3009 tem = oblookup (obarray, str, len, len);
3010 if (SYMBOLP (tem))
3011 return tem;
3012 return Fintern (make_string (str, len), obarray);
3015 /* Create an uninterned symbol with name STR. */
3017 Lisp_Object
3018 make_symbol (str)
3019 char *str;
3021 int len = strlen (str);
3023 return Fmake_symbol ((!NILP (Vpurify_flag)
3024 ? make_pure_string (str, len, len, 0)
3025 : make_string (str, len)));
3028 DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
3029 doc: /* Return the canonical symbol whose name is STRING.
3030 If there is none, one is created by this function and returned.
3031 A second optional argument specifies the obarray to use;
3032 it defaults to the value of `obarray'. */)
3033 (string, obarray)
3034 Lisp_Object string, obarray;
3036 register Lisp_Object tem, sym, *ptr;
3038 if (NILP (obarray)) obarray = Vobarray;
3039 obarray = check_obarray (obarray);
3041 CHECK_STRING (string);
3043 tem = oblookup (obarray, XSTRING (string)->data,
3044 XSTRING (string)->size,
3045 STRING_BYTES (XSTRING (string)));
3046 if (!INTEGERP (tem))
3047 return tem;
3049 if (!NILP (Vpurify_flag))
3050 string = Fpurecopy (string);
3051 sym = Fmake_symbol (string);
3053 if (EQ (obarray, initial_obarray))
3054 XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
3055 else
3056 XSYMBOL (sym)->interned = SYMBOL_INTERNED;
3058 if ((XSTRING (string)->data[0] == ':')
3059 && EQ (obarray, initial_obarray))
3061 XSYMBOL (sym)->constant = 1;
3062 XSYMBOL (sym)->value = sym;
3065 ptr = &XVECTOR (obarray)->contents[XINT (tem)];
3066 if (SYMBOLP (*ptr))
3067 XSYMBOL (sym)->next = XSYMBOL (*ptr);
3068 else
3069 XSYMBOL (sym)->next = 0;
3070 *ptr = sym;
3071 return sym;
3074 DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0,
3075 doc: /* Return the canonical symbol named NAME, or nil if none exists.
3076 NAME may be a string or a symbol. If it is a symbol, that exact
3077 symbol is searched for.
3078 A second optional argument specifies the obarray to use;
3079 it defaults to the value of `obarray'. */)
3080 (name, obarray)
3081 Lisp_Object name, obarray;
3083 register Lisp_Object tem;
3084 struct Lisp_String *string;
3086 if (NILP (obarray)) obarray = Vobarray;
3087 obarray = check_obarray (obarray);
3089 if (!SYMBOLP (name))
3091 CHECK_STRING (name);
3092 string = XSTRING (name);
3094 else
3095 string = XSTRING (SYMBOL_NAME (name));
3097 tem = oblookup (obarray, string->data, string->size, STRING_BYTES (string));
3098 if (INTEGERP (tem) || (SYMBOLP (name) && !EQ (name, tem)))
3099 return Qnil;
3100 else
3101 return tem;
3104 DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0,
3105 doc: /* Delete the symbol named NAME, if any, from OBARRAY.
3106 The value is t if a symbol was found and deleted, nil otherwise.
3107 NAME may be a string or a symbol. If it is a symbol, that symbol
3108 is deleted, if it belongs to OBARRAY--no other symbol is deleted.
3109 OBARRAY defaults to the value of the variable `obarray'. */)
3110 (name, obarray)
3111 Lisp_Object name, obarray;
3113 register Lisp_Object string, tem;
3114 int hash;
3116 if (NILP (obarray)) obarray = Vobarray;
3117 obarray = check_obarray (obarray);
3119 if (SYMBOLP (name))
3120 string = SYMBOL_NAME (name);
3121 else
3123 CHECK_STRING (name);
3124 string = name;
3127 tem = oblookup (obarray, XSTRING (string)->data,
3128 XSTRING (string)->size,
3129 STRING_BYTES (XSTRING (string)));
3130 if (INTEGERP (tem))
3131 return Qnil;
3132 /* If arg was a symbol, don't delete anything but that symbol itself. */
3133 if (SYMBOLP (name) && !EQ (name, tem))
3134 return Qnil;
3136 XSYMBOL (tem)->interned = SYMBOL_UNINTERNED;
3137 XSYMBOL (tem)->constant = 0;
3138 XSYMBOL (tem)->indirect_variable = 0;
3140 hash = oblookup_last_bucket_number;
3142 if (EQ (XVECTOR (obarray)->contents[hash], tem))
3144 if (XSYMBOL (tem)->next)
3145 XSETSYMBOL (XVECTOR (obarray)->contents[hash], XSYMBOL (tem)->next);
3146 else
3147 XSETINT (XVECTOR (obarray)->contents[hash], 0);
3149 else
3151 Lisp_Object tail, following;
3153 for (tail = XVECTOR (obarray)->contents[hash];
3154 XSYMBOL (tail)->next;
3155 tail = following)
3157 XSETSYMBOL (following, XSYMBOL (tail)->next);
3158 if (EQ (following, tem))
3160 XSYMBOL (tail)->next = XSYMBOL (following)->next;
3161 break;
3166 return Qt;
3169 /* Return the symbol in OBARRAY whose names matches the string
3170 of SIZE characters (SIZE_BYTE bytes) at PTR.
3171 If there is no such symbol in OBARRAY, return nil.
3173 Also store the bucket number in oblookup_last_bucket_number. */
3175 Lisp_Object
3176 oblookup (obarray, ptr, size, size_byte)
3177 Lisp_Object obarray;
3178 register char *ptr;
3179 int size, size_byte;
3181 int hash;
3182 int obsize;
3183 register Lisp_Object tail;
3184 Lisp_Object bucket, tem;
3186 if (!VECTORP (obarray)
3187 || (obsize = XVECTOR (obarray)->size) == 0)
3189 obarray = check_obarray (obarray);
3190 obsize = XVECTOR (obarray)->size;
3192 /* This is sometimes needed in the middle of GC. */
3193 obsize &= ~ARRAY_MARK_FLAG;
3194 /* Combining next two lines breaks VMS C 2.3. */
3195 hash = hash_string (ptr, size_byte);
3196 hash %= obsize;
3197 bucket = XVECTOR (obarray)->contents[hash];
3198 oblookup_last_bucket_number = hash;
3199 if (XFASTINT (bucket) == 0)
3201 else if (!SYMBOLP (bucket))
3202 error ("Bad data in guts of obarray"); /* Like CADR error message */
3203 else
3204 for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
3206 if (STRING_BYTES (XSTRING (SYMBOL_NAME (tail))) == size_byte
3207 && XSTRING (SYMBOL_NAME (tail))->size == size
3208 && !bcmp (XSTRING (SYMBOL_NAME (tail))->data, ptr, size_byte))
3209 return tail;
3210 else if (XSYMBOL (tail)->next == 0)
3211 break;
3213 XSETINT (tem, hash);
3214 return tem;
3217 static int
3218 hash_string (ptr, len)
3219 unsigned char *ptr;
3220 int len;
3222 register unsigned char *p = ptr;
3223 register unsigned char *end = p + len;
3224 register unsigned char c;
3225 register int hash = 0;
3227 while (p != end)
3229 c = *p++;
3230 if (c >= 0140) c -= 40;
3231 hash = ((hash<<3) + (hash>>28) + c);
3233 return hash & 07777777777;
3236 void
3237 map_obarray (obarray, fn, arg)
3238 Lisp_Object obarray;
3239 void (*fn) P_ ((Lisp_Object, Lisp_Object));
3240 Lisp_Object arg;
3242 register int i;
3243 register Lisp_Object tail;
3244 CHECK_VECTOR (obarray);
3245 for (i = XVECTOR (obarray)->size - 1; i >= 0; i--)
3247 tail = XVECTOR (obarray)->contents[i];
3248 if (SYMBOLP (tail))
3249 while (1)
3251 (*fn) (tail, arg);
3252 if (XSYMBOL (tail)->next == 0)
3253 break;
3254 XSETSYMBOL (tail, XSYMBOL (tail)->next);
3259 void
3260 mapatoms_1 (sym, function)
3261 Lisp_Object sym, function;
3263 call1 (function, sym);
3266 DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0,
3267 doc: /* Call FUNCTION on every symbol in OBARRAY.
3268 OBARRAY defaults to the value of `obarray'. */)
3269 (function, obarray)
3270 Lisp_Object function, obarray;
3272 if (NILP (obarray)) obarray = Vobarray;
3273 obarray = check_obarray (obarray);
3275 map_obarray (obarray, mapatoms_1, function);
3276 return Qnil;
3279 #define OBARRAY_SIZE 1511
3281 void
3282 init_obarray ()
3284 Lisp_Object oblength;
3285 int hash;
3286 Lisp_Object *tem;
3288 XSETFASTINT (oblength, OBARRAY_SIZE);
3290 Qnil = Fmake_symbol (make_pure_string ("nil", 3, 3, 0));
3291 Vobarray = Fmake_vector (oblength, make_number (0));
3292 initial_obarray = Vobarray;
3293 staticpro (&initial_obarray);
3294 /* Intern nil in the obarray */
3295 XSYMBOL (Qnil)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY;
3296 XSYMBOL (Qnil)->constant = 1;
3298 /* These locals are to kludge around a pyramid compiler bug. */
3299 hash = hash_string ("nil", 3);
3300 /* Separate statement here to avoid VAXC bug. */
3301 hash %= OBARRAY_SIZE;
3302 tem = &XVECTOR (Vobarray)->contents[hash];
3303 *tem = Qnil;
3305 Qunbound = Fmake_symbol (make_pure_string ("unbound", 7, 7, 0));
3306 XSYMBOL (Qnil)->function = Qunbound;
3307 XSYMBOL (Qunbound)->value = Qunbound;
3308 XSYMBOL (Qunbound)->function = Qunbound;
3310 Qt = intern ("t");
3311 XSYMBOL (Qnil)->value = Qnil;
3312 XSYMBOL (Qnil)->plist = Qnil;
3313 XSYMBOL (Qt)->value = Qt;
3314 XSYMBOL (Qt)->constant = 1;
3316 /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */
3317 Vpurify_flag = Qt;
3319 Qvariable_documentation = intern ("variable-documentation");
3320 staticpro (&Qvariable_documentation);
3322 read_buffer_size = 100 + MAX_MULTIBYTE_LENGTH;
3323 read_buffer = (char *) xmalloc (read_buffer_size);
3326 void
3327 defsubr (sname)
3328 struct Lisp_Subr *sname;
3330 Lisp_Object sym;
3331 sym = intern (sname->symbol_name);
3332 XSETSUBR (XSYMBOL (sym)->function, sname);
3335 #ifdef NOTDEF /* use fset in subr.el now */
3336 void
3337 defalias (sname, string)
3338 struct Lisp_Subr *sname;
3339 char *string;
3341 Lisp_Object sym;
3342 sym = intern (string);
3343 XSETSUBR (XSYMBOL (sym)->function, sname);
3345 #endif /* NOTDEF */
3347 /* Define an "integer variable"; a symbol whose value is forwarded
3348 to a C variable of type int. Sample call: */
3349 /* DEFVAR_INT ("indent-tabs-mode", &indent_tabs_mode, "Documentation"); */
3350 void
3351 defvar_int (namestring, address)
3352 char *namestring;
3353 EMACS_INT *address;
3355 Lisp_Object sym, val;
3356 sym = intern (namestring);
3357 val = allocate_misc ();
3358 XMISCTYPE (val) = Lisp_Misc_Intfwd;
3359 XINTFWD (val)->intvar = address;
3360 SET_SYMBOL_VALUE (sym, val);
3363 /* Similar but define a variable whose value is t if address contains 1,
3364 nil if address contains 0 */
3365 void
3366 defvar_bool (namestring, address)
3367 char *namestring;
3368 int *address;
3370 Lisp_Object sym, val;
3371 sym = intern (namestring);
3372 val = allocate_misc ();
3373 XMISCTYPE (val) = Lisp_Misc_Boolfwd;
3374 XBOOLFWD (val)->boolvar = address;
3375 SET_SYMBOL_VALUE (sym, val);
3376 Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
3379 /* Similar but define a variable whose value is the Lisp Object stored
3380 at address. Two versions: with and without gc-marking of the C
3381 variable. The nopro version is used when that variable will be
3382 gc-marked for some other reason, since marking the same slot twice
3383 can cause trouble with strings. */
3384 void
3385 defvar_lisp_nopro (namestring, address)
3386 char *namestring;
3387 Lisp_Object *address;
3389 Lisp_Object sym, val;
3390 sym = intern (namestring);
3391 val = allocate_misc ();
3392 XMISCTYPE (val) = Lisp_Misc_Objfwd;
3393 XOBJFWD (val)->objvar = address;
3394 SET_SYMBOL_VALUE (sym, val);
3397 void
3398 defvar_lisp (namestring, address)
3399 char *namestring;
3400 Lisp_Object *address;
3402 defvar_lisp_nopro (namestring, address);
3403 staticpro (address);
3406 /* Similar but define a variable whose value is the Lisp Object stored in
3407 the current buffer. address is the address of the slot in the buffer
3408 that is current now. */
3410 void
3411 defvar_per_buffer (namestring, address, type, doc)
3412 char *namestring;
3413 Lisp_Object *address;
3414 Lisp_Object type;
3415 char *doc;
3417 Lisp_Object sym, val;
3418 int offset;
3419 extern struct buffer buffer_local_symbols;
3421 sym = intern (namestring);
3422 val = allocate_misc ();
3423 offset = (char *)address - (char *)current_buffer;
3425 XMISCTYPE (val) = Lisp_Misc_Buffer_Objfwd;
3426 XBUFFER_OBJFWD (val)->offset = offset;
3427 SET_SYMBOL_VALUE (sym, val);
3428 PER_BUFFER_SYMBOL (offset) = sym;
3429 PER_BUFFER_TYPE (offset) = type;
3431 if (PER_BUFFER_IDX (offset) == 0)
3432 /* Did a DEFVAR_PER_BUFFER without initializing the corresponding
3433 slot of buffer_local_flags */
3434 abort ();
3438 /* Similar but define a variable whose value is the Lisp Object stored
3439 at a particular offset in the current kboard object. */
3441 void
3442 defvar_kboard (namestring, offset)
3443 char *namestring;
3444 int offset;
3446 Lisp_Object sym, val;
3447 sym = intern (namestring);
3448 val = allocate_misc ();
3449 XMISCTYPE (val) = Lisp_Misc_Kboard_Objfwd;
3450 XKBOARD_OBJFWD (val)->offset = offset;
3451 SET_SYMBOL_VALUE (sym, val);
3454 /* Record the value of load-path used at the start of dumping
3455 so we can see if the site changed it later during dumping. */
3456 static Lisp_Object dump_path;
3458 void
3459 init_lread ()
3461 char *normal;
3462 int turn_off_warning = 0;
3464 /* Compute the default load-path. */
3465 #ifdef CANNOT_DUMP
3466 normal = PATH_LOADSEARCH;
3467 Vload_path = decode_env_path (0, normal);
3468 #else
3469 if (NILP (Vpurify_flag))
3470 normal = PATH_LOADSEARCH;
3471 else
3472 normal = PATH_DUMPLOADSEARCH;
3474 /* In a dumped Emacs, we normally have to reset the value of
3475 Vload_path from PATH_LOADSEARCH, since the value that was dumped
3476 uses ../lisp, instead of the path of the installed elisp
3477 libraries. However, if it appears that Vload_path was changed
3478 from the default before dumping, don't override that value. */
3479 if (initialized)
3481 if (! NILP (Fequal (dump_path, Vload_path)))
3483 Vload_path = decode_env_path (0, normal);
3484 if (!NILP (Vinstallation_directory))
3486 Lisp_Object tem, tem1, sitelisp;
3488 /* Remove site-lisp dirs from path temporarily and store
3489 them in sitelisp, then conc them on at the end so
3490 they're always first in path. */
3491 sitelisp = Qnil;
3492 while (1)
3494 tem = Fcar (Vload_path);
3495 tem1 = Fstring_match (build_string ("site-lisp"),
3496 tem, Qnil);
3497 if (!NILP (tem1))
3499 Vload_path = Fcdr (Vload_path);
3500 sitelisp = Fcons (tem, sitelisp);
3502 else
3503 break;
3506 /* Add to the path the lisp subdir of the
3507 installation dir, if it exists. */
3508 tem = Fexpand_file_name (build_string ("lisp"),
3509 Vinstallation_directory);
3510 tem1 = Ffile_exists_p (tem);
3511 if (!NILP (tem1))
3513 if (NILP (Fmember (tem, Vload_path)))
3515 turn_off_warning = 1;
3516 Vload_path = Fcons (tem, Vload_path);
3519 else
3520 /* That dir doesn't exist, so add the build-time
3521 Lisp dirs instead. */
3522 Vload_path = nconc2 (Vload_path, dump_path);
3524 /* Add leim under the installation dir, if it exists. */
3525 tem = Fexpand_file_name (build_string ("leim"),
3526 Vinstallation_directory);
3527 tem1 = Ffile_exists_p (tem);
3528 if (!NILP (tem1))
3530 if (NILP (Fmember (tem, Vload_path)))
3531 Vload_path = Fcons (tem, Vload_path);
3534 /* Add site-list under the installation dir, if it exists. */
3535 tem = Fexpand_file_name (build_string ("site-lisp"),
3536 Vinstallation_directory);
3537 tem1 = Ffile_exists_p (tem);
3538 if (!NILP (tem1))
3540 if (NILP (Fmember (tem, Vload_path)))
3541 Vload_path = Fcons (tem, Vload_path);
3544 /* If Emacs was not built in the source directory,
3545 and it is run from where it was built, add to load-path
3546 the lisp, leim and site-lisp dirs under that directory. */
3548 if (NILP (Fequal (Vinstallation_directory, Vsource_directory)))
3550 Lisp_Object tem2;
3552 tem = Fexpand_file_name (build_string ("src/Makefile"),
3553 Vinstallation_directory);
3554 tem1 = Ffile_exists_p (tem);
3556 /* Don't be fooled if they moved the entire source tree
3557 AFTER dumping Emacs. If the build directory is indeed
3558 different from the source dir, src/Makefile.in and
3559 src/Makefile will not be found together. */
3560 tem = Fexpand_file_name (build_string ("src/Makefile.in"),
3561 Vinstallation_directory);
3562 tem2 = Ffile_exists_p (tem);
3563 if (!NILP (tem1) && NILP (tem2))
3565 tem = Fexpand_file_name (build_string ("lisp"),
3566 Vsource_directory);
3568 if (NILP (Fmember (tem, Vload_path)))
3569 Vload_path = Fcons (tem, Vload_path);
3571 tem = Fexpand_file_name (build_string ("leim"),
3572 Vsource_directory);
3574 if (NILP (Fmember (tem, Vload_path)))
3575 Vload_path = Fcons (tem, Vload_path);
3577 tem = Fexpand_file_name (build_string ("site-lisp"),
3578 Vsource_directory);
3580 if (NILP (Fmember (tem, Vload_path)))
3581 Vload_path = Fcons (tem, Vload_path);
3584 if (!NILP (sitelisp))
3585 Vload_path = nconc2 (Fnreverse (sitelisp), Vload_path);
3589 else
3591 /* NORMAL refers to the lisp dir in the source directory. */
3592 /* We used to add ../lisp at the front here, but
3593 that caused trouble because it was copied from dump_path
3594 into Vload_path, aboe, when Vinstallation_directory was non-nil.
3595 It should be unnecessary. */
3596 Vload_path = decode_env_path (0, normal);
3597 dump_path = Vload_path;
3599 #endif
3601 #ifndef WINDOWSNT
3602 /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
3603 almost never correct, thereby causing a warning to be printed out that
3604 confuses users. Since PATH_LOADSEARCH is always overridden by the
3605 EMACSLOADPATH environment variable below, disable the warning on NT. */
3607 /* Warn if dirs in the *standard* path don't exist. */
3608 if (!turn_off_warning)
3610 Lisp_Object path_tail;
3612 for (path_tail = Vload_path;
3613 !NILP (path_tail);
3614 path_tail = XCDR (path_tail))
3616 Lisp_Object dirfile;
3617 dirfile = Fcar (path_tail);
3618 if (STRINGP (dirfile))
3620 dirfile = Fdirectory_file_name (dirfile);
3621 if (access (XSTRING (dirfile)->data, 0) < 0)
3622 dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
3623 XCAR (path_tail));
3627 #endif /* WINDOWSNT */
3629 /* If the EMACSLOADPATH environment variable is set, use its value.
3630 This doesn't apply if we're dumping. */
3631 #ifndef CANNOT_DUMP
3632 if (NILP (Vpurify_flag)
3633 && egetenv ("EMACSLOADPATH"))
3634 #endif
3635 Vload_path = decode_env_path ("EMACSLOADPATH", normal);
3637 Vvalues = Qnil;
3639 load_in_progress = 0;
3640 Vload_file_name = Qnil;
3642 load_descriptor_list = Qnil;
3644 Vstandard_input = Qt;
3645 Vloads_in_progress = Qnil;
3648 /* Print a warning, using format string FORMAT, that directory DIRNAME
3649 does not exist. Print it on stderr and put it in *Message*. */
3651 void
3652 dir_warning (format, dirname)
3653 char *format;
3654 Lisp_Object dirname;
3656 char *buffer
3657 = (char *) alloca (XSTRING (dirname)->size + strlen (format) + 5);
3659 fprintf (stderr, format, XSTRING (dirname)->data);
3660 sprintf (buffer, format, XSTRING (dirname)->data);
3661 /* Don't log the warning before we've initialized!! */
3662 if (initialized)
3663 message_dolog (buffer, strlen (buffer), 0, STRING_MULTIBYTE (dirname));
3666 void
3667 syms_of_lread ()
3669 defsubr (&Sread);
3670 defsubr (&Sread_from_string);
3671 defsubr (&Sintern);
3672 defsubr (&Sintern_soft);
3673 defsubr (&Sunintern);
3674 defsubr (&Sload);
3675 defsubr (&Seval_buffer);
3676 defsubr (&Seval_region);
3677 defsubr (&Sread_char);
3678 defsubr (&Sread_char_exclusive);
3679 defsubr (&Sread_event);
3680 defsubr (&Sget_file_char);
3681 defsubr (&Smapatoms);
3682 defsubr (&Slocate_file_internal);
3684 DEFVAR_LISP ("obarray", &Vobarray,
3685 doc: /* Symbol table for use by `intern' and `read'.
3686 It is a vector whose length ought to be prime for best results.
3687 The vector's contents don't make sense if examined from Lisp programs;
3688 to find all the symbols in an obarray, use `mapatoms'. */);
3690 DEFVAR_LISP ("values", &Vvalues,
3691 doc: /* List of values of all expressions which were read, evaluated and printed.
3692 Order is reverse chronological. */);
3694 DEFVAR_LISP ("standard-input", &Vstandard_input,
3695 doc: /* Stream for read to get input from.
3696 See documentation of `read' for possible values. */);
3697 Vstandard_input = Qt;
3699 DEFVAR_LISP ("read-with-symbol-positions", &Vread_with_symbol_positions,
3700 doc: /* If non-nil, add position of read symbols to `read-symbol-positions-list'.
3702 If this variable is a buffer, then only forms read from that buffer
3703 will be added to `read-symbol-positions-list'.
3704 If this variable is t, then all read forms will be added.
3705 The effect of all other values other than nil are not currently
3706 defined, although they may be in the future.
3708 The positions are relative to the last call to `read' or
3709 `read-from-string'. It is probably a bad idea to set this variable at
3710 the toplevel; bind it instead. */);
3711 Vread_with_symbol_positions = Qnil;
3713 DEFVAR_LISP ("read-symbol-positions-list", &Vread_symbol_positions_list,
3714 doc: /* An list mapping read symbols to their positions.
3715 This variable is modified during calls to `read' or
3716 `read-from-string', but only when `read-with-symbol-positions' is
3717 non-nil.
3719 Each element of the list looks like (SYMBOL . CHAR-POSITION), where
3720 CHAR-POSITION is an integer giving the offset of that occurence of the
3721 symbol from the position where `read' or `read-from-string' started.
3723 Note that a symbol will appear multiple times in this list, if it was
3724 read multiple times. The list is in the same order as the symbols
3725 were read in. */);
3726 Vread_symbol_positions_list = Qnil;
3728 DEFVAR_LISP ("load-path", &Vload_path,
3729 doc: /* *List of directories to search for files to load.
3730 Each element is a string (directory name) or nil (try default directory).
3731 Initialized based on EMACSLOADPATH environment variable, if any,
3732 otherwise to default specified by file `epaths.h' when Emacs was built. */);
3734 DEFVAR_LISP ("load-suffixes", &Vload_suffixes,
3735 doc: /* *List of suffixes to try for files to load.
3736 This list should not include the empty string. */);
3737 Vload_suffixes = Fcons (build_string (".elc"),
3738 Fcons (build_string (".el"), Qnil));
3739 /* We don't use empty_string because it's not initialized yet. */
3740 default_suffixes = Fcons (build_string (""), Qnil);
3741 staticpro (&default_suffixes);
3743 DEFVAR_BOOL ("load-in-progress", &load_in_progress,
3744 doc: /* Non-nil iff inside of `load'. */);
3746 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist,
3747 doc: /* An alist of expressions to be evalled when particular files are loaded.
3748 Each element looks like (FILENAME FORMS...).
3749 When `load' is run and the file-name argument is FILENAME,
3750 the FORMS in the corresponding element are executed at the end of loading.
3752 FILENAME must match exactly! Normally FILENAME is the name of a library,
3753 with no directory specified, since that is how `load' is normally called.
3754 An error in FORMS does not undo the load,
3755 but does prevent execution of the rest of the FORMS.
3756 FILENAME can also be a symbol (a feature) and FORMS are then executed
3757 when the corresponding call to `provide' is made. */);
3758 Vafter_load_alist = Qnil;
3760 DEFVAR_LISP ("load-history", &Vload_history,
3761 doc: /* Alist mapping source file names to symbols and features.
3762 Each alist element is a list that starts with a file name,
3763 except for one element (optional) that starts with nil and describes
3764 definitions evaluated from buffers not visiting files.
3765 The remaining elements of each list are symbols defined as functions
3766 or variables, and cons cells `(provide . FEATURE)', `(require . FEATURE)',
3767 and `(autoload . SYMBOL)'. */);
3768 Vload_history = Qnil;
3770 DEFVAR_LISP ("load-file-name", &Vload_file_name,
3771 doc: /* Full name of file being loaded by `load'. */);
3772 Vload_file_name = Qnil;
3774 DEFVAR_LISP ("user-init-file", &Vuser_init_file,
3775 doc: /* File name, including directory, of user's initialization file.
3776 If the file loaded had extension `.elc' and there was a corresponding `.el'
3777 file, this variable contains the name of the .el file, suitable for use
3778 by functions like `custom-save-all' which edit the init file. */);
3779 Vuser_init_file = Qnil;
3781 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list,
3782 doc: /* Used for internal purposes by `load'. */);
3783 Vcurrent_load_list = Qnil;
3785 DEFVAR_LISP ("load-read-function", &Vload_read_function,
3786 doc: /* Function used by `load' and `eval-region' for reading expressions.
3787 The default is nil, which means use the function `read'. */);
3788 Vload_read_function = Qnil;
3790 DEFVAR_LISP ("load-source-file-function", &Vload_source_file_function,
3791 doc: /* Function called in `load' for loading an Emacs lisp source file.
3792 This function is for doing code conversion before reading the source file.
3793 If nil, loading is done without any code conversion.
3794 Arguments are FULLNAME, FILE, NOERROR, NOMESSAGE, where
3795 FULLNAME is the full name of FILE.
3796 See `load' for the meaning of the remaining arguments. */);
3797 Vload_source_file_function = Qnil;
3799 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings,
3800 doc: /* Non-nil means `load' should force-load all dynamic doc strings.
3801 This is useful when the file being loaded is a temporary copy. */);
3802 load_force_doc_strings = 0;
3804 DEFVAR_BOOL ("load-convert-to-unibyte", &load_convert_to_unibyte,
3805 doc: /* Non-nil means `read' converts strings to unibyte whenever possible.
3806 This is normally bound by `load' and `eval-buffer' to control `read',
3807 and is not meant for users to change. */);
3808 load_convert_to_unibyte = 0;
3810 DEFVAR_LISP ("source-directory", &Vsource_directory,
3811 doc: /* Directory in which Emacs sources were found when Emacs was built.
3812 You cannot count on them to still be there! */);
3813 Vsource_directory
3814 = Fexpand_file_name (build_string ("../"),
3815 Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH)));
3817 DEFVAR_LISP ("preloaded-file-list", &Vpreloaded_file_list,
3818 doc: /* List of files that were preloaded (when dumping Emacs). */);
3819 Vpreloaded_file_list = Qnil;
3821 DEFVAR_LISP ("byte-boolean-vars", &Vbyte_boolean_vars,
3822 doc: /* List of all DEFVAR_BOOL variables, used by the byte code optimizer. */);
3823 Vbyte_boolean_vars = Qnil;
3825 DEFVAR_BOOL ("load-dangerous-libraries", &load_dangerous_libraries,
3826 doc: /* Non-nil means load dangerous compiled Lisp files.
3827 Some versions of XEmacs use different byte codes than Emacs. These
3828 incompatible byte codes can make Emacs crash when it tries to execute
3829 them. */);
3830 load_dangerous_libraries = 0;
3832 DEFVAR_LISP ("bytecomp-version-regexp", &Vbytecomp_version_regexp,
3833 doc: /* Regular expression matching safe to load compiled Lisp files.
3834 When Emacs loads a compiled Lisp file, it reads the first 512 bytes
3835 from the file, and matches them against this regular expression.
3836 When the regular expression matches, the file is considered to be safe
3837 to load. See also `load-dangerous-libraries'. */);
3838 Vbytecomp_version_regexp
3839 = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
3841 /* Vsource_directory was initialized in init_lread. */
3843 load_descriptor_list = Qnil;
3844 staticpro (&load_descriptor_list);
3846 Qcurrent_load_list = intern ("current-load-list");
3847 staticpro (&Qcurrent_load_list);
3849 Qstandard_input = intern ("standard-input");
3850 staticpro (&Qstandard_input);
3852 Qread_char = intern ("read-char");
3853 staticpro (&Qread_char);
3855 Qget_file_char = intern ("get-file-char");
3856 staticpro (&Qget_file_char);
3858 Qbackquote = intern ("`");
3859 staticpro (&Qbackquote);
3860 Qcomma = intern (",");
3861 staticpro (&Qcomma);
3862 Qcomma_at = intern (",@");
3863 staticpro (&Qcomma_at);
3864 Qcomma_dot = intern (",.");
3865 staticpro (&Qcomma_dot);
3867 Qinhibit_file_name_operation = intern ("inhibit-file-name-operation");
3868 staticpro (&Qinhibit_file_name_operation);
3870 Qascii_character = intern ("ascii-character");
3871 staticpro (&Qascii_character);
3873 Qfunction = intern ("function");
3874 staticpro (&Qfunction);
3876 Qload = intern ("load");
3877 staticpro (&Qload);
3879 Qload_file_name = intern ("load-file-name");
3880 staticpro (&Qload_file_name);
3882 staticpro (&dump_path);
3884 staticpro (&read_objects);
3885 read_objects = Qnil;
3886 staticpro (&seen_list);
3888 Vloads_in_progress = Qnil;
3889 staticpro (&Vloads_in_progress);