1 /* Lisp parsing and input streams.
2 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Tinker Systems.
4 Copyright (C) 1996 Ben Wing.
6 This file is part of XEmacs.
8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 2, or (at your option) any
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with XEmacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA. */
23 /* Synched up with: Mule 2.0, FSF 19.30. */
25 /* This file has been Mule-ized. */
38 #include "file-coding.h"
43 #ifdef LISP_FLOAT_TYPE
44 #define THIS_FILENAME lread
46 #endif /* LISP_FLOAT_TYPE */
48 Lisp_Object Qread_char, Qstandard_input;
49 Lisp_Object Qvariable_documentation;
50 #define LISP_BACKQUOTES
51 #ifdef LISP_BACKQUOTES
53 Nonzero means inside a new-style backquote
54 with no surrounding parentheses.
55 Fread initializes this to zero, so we need not specbind it
56 or worry about what happens to it when there is an error.
59 Nested backquotes are perfectly legal and fail utterly with
61 static int new_backquote_flag, old_backquote_flag;
62 Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot;
64 Lisp_Object Qvariable_domain; /* I18N3 */
65 Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
66 Lisp_Object Qcurrent_load_list;
67 Lisp_Object Qload, Qload_file_name;
68 Lisp_Object Qlocate_file_hash_table;
71 /* See read_escape() for an explanation of this. */
73 int fail_on_bucky_bit_character_escapes;
76 /* This symbol is also used in fns.c */
77 #define FEATUREP_SYNTAX
79 #ifdef FEATUREP_SYNTAX
80 Lisp_Object Qfeaturep;
83 /* non-zero if inside `load' */
86 /* Whether Fload_internal() should check whether the .el is newer
88 int load_warn_when_source_newer;
89 /* Whether Fload_internal() should check whether the .elc doesn't exist */
90 int load_warn_when_source_only;
91 /* Whether Fload_internal() should ignore .elc files when no suffix is given */
92 int load_ignore_elc_files;
94 /* Directory in which the sources were found. */
95 Lisp_Object Vsource_directory;
97 /* Search path for files to be loaded. */
98 Lisp_Object Vload_path;
100 /* Search path for files when dumping. */
101 /* Lisp_Object Vdump_load_path; */
103 /* This is the user-visible association list that maps features to
104 lists of defs in their load files. */
105 Lisp_Object Vload_history;
107 /* This is used to build the load history. */
108 Lisp_Object Vcurrent_load_list;
110 /* Name of file actually being read by `load'. */
111 Lisp_Object Vload_file_name;
113 /* Same as Vload_file_name but not Lisp-accessible. This ensures that
114 our #$ checks are reliable. */
115 Lisp_Object Vload_file_name_internal;
117 Lisp_Object Vload_file_name_internal_the_purecopy;
119 /* Function to use for reading, in `load' and friends. */
120 Lisp_Object Vload_read_function;
122 /* The association list of objects read with the #n=object form.
123 Each member of the list has the form (n . object), and is used to
124 look up the object for the corresponding #n# construct.
125 It must be set to nil before all top-level calls to read0. */
126 Lisp_Object read_objects;
128 /* Nonzero means load should forcibly load all dynamic doc strings. */
129 /* Note that this always happens (with some special behavior) when
130 purify_flag is set. */
131 static int load_force_doc_strings;
133 /* List of descriptors now open for Fload_internal. */
134 static Lisp_Object Vload_descriptor_list;
136 /* In order to implement "load_force_doc_strings", we keep
137 a list of all the compiled-function objects and such
138 that we have created in the process of loading this file.
141 We specbind this just like Vload_file_name, so there's no
142 problems with recursive loading. */
143 static Lisp_Object Vload_force_doc_string_list;
145 /* A resizing-buffer stream used to temporarily hold data while reading */
146 static Lisp_Object Vread_buffer_stream;
148 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
149 Lisp_Object Vcurrent_compiled_function_annotation;
152 static int load_byte_code_version;
154 /* An array describing all known built-in structure types */
155 static structure_type_dynarr *the_structure_type_dynarr;
157 #if 0 /* FSF defun hack */
158 /* When nonzero, read conses in pure space */
159 static int read_pure;
162 #if 0 /* FSF stuff */
163 /* For use within read-from-string (this reader is non-reentrant!!) */
164 static int read_from_string_index;
165 static int read_from_string_limit;
168 #if 0 /* More FSF implementation kludges. */
169 /* In order to implement load-force-doc-string, FSF saves the
170 #@-quoted string when it's seen, and goes back and retrieves
173 This approach is not only kludgy, but it in general won't work
174 correctly because there's no stack of remembered #@-quoted-strings
175 and those strings don't generally appear in the file in the same
176 order as their #$ references. (Yes, that is amazingly stupid too.
178 It would be trivially easy to always encode the #@ string
179 [which is a comment, anyway] in the middle of the (#$ . INT) cons
180 reference. That way, it would be really easy to implement
181 load-force-doc-string in a non-kludgy way by just retrieving the
182 string immediately, because it's delivered on a silver platter.)
184 And finally, this stupid approach doesn't work under Mule, or
185 under MS-DOS or Windows NT, or under VMS, or any other place
186 where you either can't do an ftell() or don't get back a byte
189 Oh, and one more lossage in this approach: If you attempt to
190 dump any ELC files that were compiled with `byte-compile-dynamic'
191 (as opposed to just `byte-compile-dynamic-docstring'), you
192 get hosed. FMH! (as the illustrious JWZ was prone to utter)
194 The approach we use is clean, solves all of these problems, and is
195 probably easier to implement anyway. We just save a list of all
196 the containing objects that have (#$ . INT) conses in them (this
197 will only be compiled-function objects and lists), and when the
198 file is finished loading, we go through and fill in all the
199 doc strings at once. */
201 /* This contains the last string skipped with #@. */
202 static char *saved_doc_string;
203 /* Length of buffer allocated in saved_doc_string. */
204 static int saved_doc_string_size;
205 /* Length of actual data in saved_doc_string. */
206 static int saved_doc_string_length;
207 /* This is the file position that string came from. */
208 static int saved_doc_string_position;
211 EXFUN (Fread_from_string, 3);
213 /* When errors are signaled, the actual readcharfun should not be used
214 as an argument if it is an lstream, so that lstreams don't escape
215 to the Lisp level. */
216 #define READCHARFUN_MAYBE(x) (LSTREAMP (x) \
217 ? (build_string ("internal input stream")) \
222 syntax_error (CONST char *string)
224 signal_error (Qinvalid_read_syntax,
225 list1 (build_translated_string (string)));
229 continuable_syntax_error (CONST char *string)
231 return Fsignal (Qinvalid_read_syntax,
232 list1 (build_translated_string (string)));
236 /* Handle unreading and rereading of characters. */
238 readchar (Lisp_Object readcharfun)
240 /* This function can GC */
242 if (BUFFERP (readcharfun))
245 struct buffer *b = XBUFFER (readcharfun);
247 if (!BUFFER_LIVE_P (b))
248 error ("Reading from killed buffer");
250 if (BUF_PT (b) >= BUF_ZV (b))
252 c = BUF_FETCH_CHAR (b, BUF_PT (b));
253 BUF_SET_PT (b, BUF_PT (b) + 1);
257 else if (LSTREAMP (readcharfun))
259 Emchar c = Lstream_get_emchar (XLSTREAM (readcharfun));
260 #ifdef DEBUG_XEMACS /* testing Mule */
261 static int testing_mule = 0; /* Change via debugger */
263 if (c >= 0x20 && c <= 0x7E) fprintf (stderr, "%c", c);
264 else if (c == '\n') fprintf (stderr, "\\n\n");
265 else fprintf (stderr, "\\%o ", c);
270 else if (MARKERP (readcharfun))
273 Bufpos mpos = marker_position (readcharfun);
274 struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
276 if (mpos >= BUF_ZV (inbuffer))
278 c = BUF_FETCH_CHAR (inbuffer, mpos);
279 set_marker_position (readcharfun, mpos + 1);
284 Lisp_Object tem = call0 (readcharfun);
286 if (!CHAR_OR_CHAR_INTP (tem))
288 return XCHAR_OR_CHAR_INT (tem);
292 /* Unread the character C in the way appropriate for the stream READCHARFUN.
293 If the stream is a user function, call it with the char as argument. */
296 unreadchar (Lisp_Object readcharfun, Emchar c)
299 /* Don't back up the pointer if we're unreading the end-of-input mark,
300 since readchar didn't advance it when we read it. */
302 else if (BUFFERP (readcharfun))
303 BUF_SET_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1);
304 else if (LSTREAMP (readcharfun))
306 Lstream_unget_emchar (XLSTREAM (readcharfun), c);
307 #ifdef DEBUG_XEMACS /* testing Mule */
309 static int testing_mule = 0; /* Set this using debugger */
312 (c >= 0x20 && c <= 0x7E) ? "UU%c" :
313 ((c == '\n') ? "UU\\n\n" : "UU\\%o"), c);
317 else if (MARKERP (readcharfun))
318 set_marker_position (readcharfun, marker_position (readcharfun) - 1);
320 call1 (readcharfun, make_char (c));
323 static Lisp_Object read0 (Lisp_Object readcharfun);
324 static Lisp_Object read1 (Lisp_Object readcharfun);
325 /* allow_dotted_lists means that something like (foo bar . baz)
326 is acceptable. If -1, means check for starting with defun
327 and make structure pure. (not implemented, probably for very
331 If check_for_doc_references, look for (#$ . INT) doc references
332 in the list and record if load_force_doc_strings is non-zero.
333 (Such doc references will be destroyed during the loadup phase
334 by replacing with Qzero, because Snarf-documentation will fill
337 WARNING: If you set this, you sure as hell better not call
338 free_list() on the returned list here. */
340 static Lisp_Object read_list (Lisp_Object readcharfun,
342 int allow_dotted_lists,
343 int check_for_doc_references);
345 static void readevalloop (Lisp_Object readcharfun,
346 Lisp_Object sourcefile,
347 Lisp_Object (*evalfun) (Lisp_Object),
351 load_unwind (Lisp_Object stream) /* used as unwind-protect function in load */
353 Lstream_close (XLSTREAM (stream));
354 if (--load_in_progress < 0)
355 load_in_progress = 0;
360 load_descriptor_unwind (Lisp_Object oldlist)
362 Vload_descriptor_list = oldlist;
367 load_file_name_internal_unwind (Lisp_Object oldval)
369 Vload_file_name_internal = oldval;
374 load_file_name_internal_the_purecopy_unwind (Lisp_Object oldval)
376 Vload_file_name_internal_the_purecopy = oldval;
381 load_byte_code_version_unwind (Lisp_Object oldval)
383 load_byte_code_version = XINT (oldval);
387 /* The plague is coming.
389 Ring around the rosy, pocket full of posy,
390 Ashes ashes, they all fall down.
393 ebolify_bytecode_constants (Lisp_Object vector)
395 int len = XVECTOR_LENGTH (vector);
398 for (i = 0; i < len; i++)
400 Lisp_Object el = XVECTOR_DATA (vector)[i];
402 /* We don't check for `eq', `equal', and the others that have
403 bytecode opcodes. This might lose if someone passes #'eq or
404 something to `funcall', but who would really do that? As
405 they say in law, we've made a "good-faith effort" to
406 unfuckify ourselves. And doing it this way avoids screwing
407 up args to `make-hashtable' and such. As it is, we have to
408 add an extra Ebola check in decode_weak_list_type(). --ben */
414 /* I think this is a bad idea because it will probably mess
416 if (EQ (el, Qdelete))
421 if (EQ (el, Qrassoc))
423 XVECTOR_DATA (vector)[i] = el;
428 pas_de_lache_ici (int fd, Lisp_Object victim)
433 if (!INTP (XCDR (victim)))
434 signal_simple_error ("Bogus doc string reference", victim);
435 pos = XINT (XCDR (victim));
437 pos = -pos; /* kludge to mark a user variable */
438 tem = unparesseuxify_doc_string (fd, pos, 0, Vload_file_name_internal);
440 signal_error (Qerror, tem);
445 load_force_doc_string_unwind (Lisp_Object oldlist)
448 Lisp_Object list = Vload_force_doc_string_list;
450 int fd = XINT (XCAR (Vload_descriptor_list));
451 /* NOTE: If purify_flag is true, we're in-place modifying objects that
452 may be in purespace (and if not, they will be). Therefore, we have
453 to be VERY careful to make sure that all objects that we create
454 are purecopied -- objects in purespace are not marked for GC, and
455 if we leave any impure objects inside of pure ones, we're really
459 /* restore the old value first just in case an error occurs. */
460 Vload_force_doc_string_list = oldlist;
462 LIST_LOOP (tail, list)
464 Lisp_Object john = Fcar (tail);
467 assert (CONSP (XCAR (john)));
468 assert (!purify_flag); /* should have been handled in read_list() */
469 XCAR (john) = pas_de_lache_ici (fd, XCAR (john));
475 assert (COMPILED_FUNCTIONP (john));
476 if (CONSP (XCOMPILED_FUNCTION (john)->bytecodes))
478 struct gcpro ngcpro1;
479 Lisp_Object juan = (pas_de_lache_ici
480 (fd, XCOMPILED_FUNCTION (john)->bytecodes));
486 signal_simple_error ("invalid lazy-loaded byte code", ivan);
487 /* Remember to purecopy; see above. */
488 XCOMPILED_FUNCTION (john)->bytecodes = Fpurecopy (XCAR (ivan));
489 /* v18 or v19 bytecode file. Need to Ebolify. */
490 if (XCOMPILED_FUNCTION (john)->flags.ebolified
491 && VECTORP (XCDR (ivan)))
492 ebolify_bytecode_constants (XCDR (ivan));
493 XCOMPILED_FUNCTION (john)->constants = Fpurecopy (XCDR (ivan));
496 doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
499 assert (!purify_flag); /* should have been handled in
500 read_compiled_function() */
501 doc = pas_de_lache_ici (fd, doc);
502 set_compiled_function_documentation (XCOMPILED_FUNCTION (john),
515 /* Close all descriptors in use for Fload_internal.
516 This is used when starting a subprocess. */
519 close_load_descs (void)
522 LIST_LOOP (tail, Vload_descriptor_list)
523 close (XINT (XCAR (tail)));
527 Lisp_Object Vfile_domain;
530 restore_file_domain (Lisp_Object val)
537 DEFUN ("load-internal", Fload_internal, 1, 6, 0, /*
538 Execute a file of Lisp code named FILE; no coding-system frobbing.
539 This function is identical to `load' except for the handling of the
540 CODESYS and USED-CODESYS arguments under XEmacs/Mule. (When Mule
541 support is not present, both functions are identical and ignore the
542 CODESYS and USED-CODESYS arguments.)
544 If support for Mule exists in this Emacs, the file is decoded
545 according to CODESYS; if omitted, no conversion happens. If
546 USED-CODESYS is non-nil, it should be a symbol, and the actual coding
547 system that was used for the decoding is stored into it. It will in
548 general be different from CODESYS if CODESYS specifies automatic
549 encoding detection or end-of-line detection.
551 (file, no_error, nomessage, nosuffix, codesys, used_codesys))
553 /* This function can GC */
555 int speccount = specpdl_depth ();
557 Lisp_Object newer = Qnil;
558 Lisp_Object handler = Qnil;
559 Lisp_Object found = Qnil;
560 struct gcpro gcpro1, gcpro2, gcpro3;
562 int message_p = NILP (nomessage);
563 /*#ifdef DEBUG_XEMACS*/
564 static Lisp_Object last_file_loaded;
565 size_t pure_usage = 0;
568 GCPRO3 (file, newer, found);
572 /*#ifdef DEBUG_XEMACS*/
573 if (purify_flag && noninteractive)
576 last_file_loaded = file;
577 pure_usage = purespace_usage ();
579 /*#endif / * DEBUG_XEMACS */
581 /* If file name is magic, call the handler. */
582 handler = Ffind_file_name_handler (file, Qload);
584 RETURN_UNGCPRO (call5 (handler, Qload, file, no_error,
585 nomessage, nosuffix));
587 /* Do this after the handler to avoid
588 the need to gcpro noerror, nomessage and nosuffix.
589 (Below here, we care only whether they are nil or not.) */
590 file = Fsubstitute_in_file_name (file);
592 if (!NILP (used_codesys))
593 CHECK_SYMBOL (used_codesys);
596 /* Avoid weird lossage with null string as arg,
597 since it would try to load a directory as a Lisp file.
599 if (XSTRING_LENGTH (file) > 0)
604 fd = locate_file (Vload_path, file,
605 ((!NILP (nosuffix)) ? "" :
606 load_ignore_elc_files ? ".el:" :
614 signal_file_error ("Cannot open load file", file);
622 foundstr = (char *) alloca (XSTRING_LENGTH (found) + 1);
623 strcpy (foundstr, (char *) XSTRING_DATA (found));
624 foundlen = strlen (foundstr);
626 /* The omniscient JWZ thinks this is worthless, but I beg to
628 if (load_ignore_elc_files)
630 newer = Ffile_name_nondirectory (found);
632 else if (load_warn_when_source_newer &&
633 !memcmp (".elc", foundstr + foundlen - 4, 4))
635 if (! fstat (fd, &s1)) /* can't fail, right? */
638 /* temporarily hack the 'c' off the end of the filename */
639 foundstr[foundlen - 1] = '\0';
640 result = stat (foundstr, &s2);
642 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
644 Lisp_Object newer_name = make_string ((Bufbyte *) foundstr,
646 struct gcpro nngcpro1;
647 NNGCPRO1 (newer_name);
648 newer = Ffile_name_nondirectory (newer_name);
651 /* put the 'c' back on (kludge-o-rama) */
652 foundstr[foundlen - 1] = 'c';
655 else if (load_warn_when_source_only &&
656 /* `found' ends in ".el" */
657 !memcmp (".el", foundstr + foundlen - 3, 3) &&
658 /* `file' does not end in ".el" */
660 XSTRING_DATA (file) + XSTRING_LENGTH (file) - 3,
666 if (!memcmp (".elc", foundstr + foundlen - 4, 4))
670 #define PRINT_LOADING_MESSAGE(done) do { \
671 if (load_ignore_elc_files) \
674 message ("Loading %s..." done, XSTRING_DATA (newer)); \
676 else if (!NILP (newer)) \
677 message ("Loading %s..." done " (file %s is newer)", \
678 XSTRING_DATA (file), \
679 XSTRING_DATA (newer)); \
680 else if (source_only) \
681 message ("Loading %s..." done " (file %s.elc does not exist)", \
682 XSTRING_DATA (file), \
683 XSTRING_DATA (Ffile_name_nondirectory (file))); \
684 else if (message_p) \
685 message ("Loading %s..." done, XSTRING_DATA (file)); \
688 PRINT_LOADING_MESSAGE ("");
691 /* Lisp_Object's must be malloc'ed, not stack-allocated */
692 Lisp_Object lispstream = Qnil;
693 CONST int block_size = 8192;
694 struct gcpro ngcpro1;
696 NGCPRO1 (lispstream);
697 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
698 /* 64K is used for normal files; 8K should be OK here because Lisp
699 files aren't really all that big. */
700 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
703 lispstream = make_decoding_input_stream
704 (XLSTREAM (lispstream), Fget_coding_system (codesys));
705 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
708 /* NOTE: Order of these is very important. Don't rearrange them. */
709 record_unwind_protect (load_unwind, lispstream);
710 record_unwind_protect (load_descriptor_unwind, Vload_descriptor_list);
711 record_unwind_protect (load_file_name_internal_unwind,
712 Vload_file_name_internal);
713 record_unwind_protect (load_file_name_internal_the_purecopy_unwind,
714 Vload_file_name_internal_the_purecopy);
715 record_unwind_protect (load_force_doc_string_unwind,
716 Vload_force_doc_string_list);
717 Vload_file_name_internal = found;
718 Vload_file_name_internal_the_purecopy = Qnil;
719 specbind (Qload_file_name, found);
720 Vload_descriptor_list = Fcons (make_int (fd), Vload_descriptor_list);
721 Vload_force_doc_string_list = Qnil;
723 record_unwind_protect (restore_file_domain, Vfile_domain);
724 Vfile_domain = Qnil; /* set it to nil; a call to #'domain will set it. */
728 /* Now determine what sort of ELC file we're reading in. */
729 record_unwind_protect (load_byte_code_version_unwind,
730 make_int (load_byte_code_version));
736 num_read = Lstream_read (XLSTREAM (lispstream), elc_header, 8);
738 || strncmp (elc_header, ";ELC", 4))
740 /* Huh? Probably not a valid ELC file. */
741 load_byte_code_version = 100; /* no Ebolification needed */
742 Lstream_unread (XLSTREAM (lispstream), elc_header, num_read);
745 load_byte_code_version = elc_header[4];
748 load_byte_code_version = 100; /* no Ebolification needed */
750 readevalloop (lispstream, file, Feval, 0);
752 if (!NILP (used_codesys))
755 (decoding_stream_coding_system (XLSTREAM (lispstream))));
757 unbind_to (speccount, Qnil);
764 /* #### Disgusting kludge */
765 /* Run any load-hooks for this file. */
766 /* #### An even more disgusting kludge. There is horrible code */
767 /* that is relying on the fact that dumped lisp files are found */
768 /* via `load-path' search. */
769 Lisp_Object name = file;
771 if (!NILP(Ffile_name_absolute_p(file)))
773 name = Ffile_name_nondirectory(file);
777 struct gcpro ngcpro1;
780 tem = Fassoc (name, Vafter_load_alist);
785 struct gcpro ngcpro1;
788 /* Use eval so that errors give a semi-meaningful backtrace. --Stig */
789 tem = Fcons (Qprogn, Fcdr (tem));
795 /*#ifdef DEBUG_XEMACS*/
796 if (purify_flag && noninteractive)
798 if (EQ (last_file_loaded, file))
799 message_append (" (%d)", purespace_usage() - pure_usage);
801 message ("Loading %s ...done (%d)", XSTRING_DATA (file),
802 purespace_usage() - pure_usage);
804 /*#endif / * DEBUG_XEMACS */
807 PRINT_LOADING_MESSAGE ("done");
817 complete_filename_p (Lisp_Object pathname)
819 REGISTER unsigned char *s = XSTRING_DATA (pathname);
820 return (IS_DIRECTORY_SEP (s[0])
821 || (XSTRING_LENGTH (pathname) > 2
822 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))
830 DEFUN ("locate-file", Flocate_file, 2, 4, 0, /*
831 Search for FILENAME through PATH-LIST, expanded by one of the optional
832 SUFFIXES (string of suffixes separated by ":"s), checking for access
833 MODE (0|1|2|4 = exists|executable|writeable|readable), default readable.
835 `locate-file' keeps hash tables of the directories it searches through,
836 in order to speed things up. It tries valiantly to not get confused in
837 the face of a changing and unpredictable environment, but can occasionally
838 get tripped up. In this case, you will have to call
839 `locate-file-clear-hashing' to get it back on track. See that function
842 (filename, path_list, suffixes, mode))
844 /* This function can GC */
847 CHECK_STRING (filename);
848 if (!NILP (suffixes))
849 CHECK_STRING (suffixes);
853 locate_file (path_list, filename,
854 ((NILP (suffixes)) ? "" :
855 (char *) (XSTRING_DATA (suffixes))),
856 &tp, (NILP (mode) ? R_OK : XINT (mode)));
860 /* recalculate the hash table for the given string */
863 locate_file_refresh_hashing (Lisp_Object str)
866 make_directory_hash_table ((char *) XSTRING_DATA (str));
867 Fput (str, Qlocate_file_hash_table, hash);
871 /* find the hash table for the given string, recalculating if necessary */
874 locate_file_find_directory_hash_table (Lisp_Object str)
876 Lisp_Object hash = Fget (str, Qlocate_file_hash_table, Qnil);
877 if (NILP (Fhashtablep (hash)))
878 return locate_file_refresh_hashing (str);
882 /* look for STR in PATH, optionally adding suffixes in SUFFIX */
885 locate_file_in_directory (Lisp_Object path, Lisp_Object str,
886 CONST char *suffix, Lisp_Object *storeptr,
889 /* This function can GC */
896 Lisp_Object filename = Qnil;
897 struct gcpro gcpro1, gcpro2, gcpro3;
900 GCPRO3 (path, str, filename);
902 filename = Fexpand_file_name (str, path);
903 if (NILP (filename) || NILP (Ffile_name_absolute_p (filename)))
904 /* If there are non-absolute elts in PATH (eg ".") */
905 /* Of course, this could conceivably lose if luser sets
906 default-directory to be something non-absolute ... */
909 /* NIL means current dirctory */
910 filename = current_buffer->directory;
912 filename = Fexpand_file_name (filename,
913 current_buffer->directory);
914 if (NILP (Ffile_name_absolute_p (filename)))
916 /* Give up on this path element! */
921 /* Calculate maximum size of any filename made from
922 this path element/specified file name and any possible suffix. */
923 want_size = strlen (suffix) + XSTRING_LENGTH (filename) + 1;
924 if (fn_size < want_size)
925 fn = (char *) alloca (fn_size = 100 + want_size);
929 /* Loop over suffixes. */
932 char *esuffix = (char *) strchr (nsuffix, ':');
933 int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
935 /* Concatenate path element/specified name with the suffix. */
936 strncpy (fn, (char *) XSTRING_DATA (filename),
937 XSTRING_LENGTH (filename));
938 fn[XSTRING_LENGTH (filename)] = 0;
939 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
940 strncat (fn, nsuffix, lsuffix);
942 /* Ignore file if it's a directory. */
943 if (stat (fn, &st) >= 0
944 && (st.st_mode & S_IFMT) != S_IFDIR)
946 /* Check that we can access or open it. */
948 fd = access (fn, mode);
950 fd = open (fn, O_RDONLY | OPEN_BINARY, 0);
954 /* We succeeded; return this descriptor and filename. */
956 *storeptr = build_string (fn);
960 /* If we actually opened the file, set close-on-exec flag
961 on the new descriptor so that subprocesses can't whack
964 (void) fcntl (fd, F_SETFD, FD_CLOEXEC);
971 /* Advance to next suffix. */
974 nsuffix += lsuffix + 1;
981 /* do the same as locate_file() but don't use any hash tables. */
984 locate_file_without_hash (Lisp_Object path, Lisp_Object str,
985 CONST char *suffix, Lisp_Object *storeptr,
988 /* This function can GC */
992 /* is this necessary? */
995 absolute = !NILP (Ffile_name_absolute_p (str));
997 for (; !NILP (path); path = Fcdr (path))
999 int val = locate_file_in_directory (Fcar (path), str, suffix,
1014 /* Construct a list of all files to search for. */
1017 locate_file_construct_suffixed_files (Lisp_Object str, CONST char *suffix)
1023 CONST char *nsuffix;
1024 Lisp_Object suffixtab = Qnil;
1026 /* Calculate maximum size of any filename made from
1027 this path element/specified file name and any possible suffix. */
1028 want_size = strlen (suffix) + XSTRING_LENGTH (str) + 1;
1029 if (fn_size < want_size)
1030 fn = (char *) alloca (fn_size = 100 + want_size);
1036 char *esuffix = (char *) strchr (nsuffix, ':');
1037 int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
1039 /* Concatenate path element/specified name with the suffix. */
1040 strncpy (fn, (char *) XSTRING_DATA (str), XSTRING_LENGTH (str));
1041 fn[XSTRING_LENGTH (str)] = 0;
1042 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
1043 strncat (fn, nsuffix, lsuffix);
1045 suffixtab = Fcons (build_string (fn), suffixtab);
1046 /* Advance to next suffix. */
1049 nsuffix += lsuffix + 1;
1051 return Fnreverse (suffixtab);
1054 DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
1055 Clear the hash records for the specified list of directories.
1056 `locate-file' uses a hashing scheme to speed lookup, and will correctly
1057 track the following environmental changes:
1059 -- changes of any sort to the list of directories to be searched.
1060 -- addition and deletion of non-shadowing files (see below) from the
1061 directories in the list.
1062 -- byte-compilation of a .el file into a .elc file.
1064 `locate-file' will primarily get confused if you add a file that shadows
1065 \(i.e. has the same name as) another file further down in the directory list.
1066 In this case, you must call `locate-file-clear-hashing'.
1070 Lisp_Object pathtail;
1072 for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
1074 Lisp_Object pathel = Fcar (pathtail);
1075 if (!purified (pathel))
1076 Fput (pathel, Qlocate_file_hash_table, Qnil);
1081 /* Search for a file whose name is STR, looking in directories
1082 in the Lisp list PATH, and trying suffixes from SUFFIX.
1083 SUFFIX is a string containing possible suffixes separated by colons.
1084 On success, returns a file descriptor. On failure, returns -1.
1086 MODE nonnegative means don't open the files,
1087 just look for one for which access(file,MODE) succeeds. In this case,
1088 returns 1 on success.
1090 If STOREPTR is nonzero, it points to a slot where the name of
1091 the file actually found should be stored as a Lisp string.
1092 Nil is stored there on failure.
1094 Called openp() in FSFmacs. */
1097 locate_file (Lisp_Object path, Lisp_Object str, CONST char *suffix,
1098 Lisp_Object *storeptr, int mode)
1100 /* This function can GC */
1101 Lisp_Object suffixtab = Qnil;
1102 Lisp_Object pathtail;
1104 struct gcpro gcpro1, gcpro2, gcpro3;
1109 /* if this filename has directory components, it's too complicated
1110 to try and use the hash tables. */
1111 if (!NILP (Ffile_name_directory (str)))
1112 return locate_file_without_hash (path, str, suffix, storeptr,
1115 /* Is it really necessary to gcpro path and str? It shouldn't be
1116 unless some caller has fucked up. */
1117 GCPRO3 (path, str, suffixtab);
1119 suffixtab = locate_file_construct_suffixed_files (str, suffix);
1121 for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
1123 Lisp_Object pathel = Fcar (pathtail);
1124 Lisp_Object hashtab;
1128 /* If this path element is relative, we have to look by hand.
1129 Can't set string property in a pure string. */
1130 if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)) ||
1133 val = locate_file_in_directory (pathel, str, suffix, storeptr,
1143 hashtab = locate_file_find_directory_hash_table (pathel);
1145 /* Loop over suffixes. */
1146 for (tail = suffixtab, found = 0; !found && CONSP (tail);
1149 if (!NILP (Fgethash (XCAR (tail), hashtab, Qnil)))
1155 /* This is a likely candidate. Look by hand in this directory
1156 so we don't get thrown off if someone byte-compiles a file. */
1157 val = locate_file_in_directory (pathel, str, suffix, storeptr,
1165 /* Hmm ... the file isn't actually there. (Or possibly it's
1166 a directory ...) So refresh our hashing. */
1167 locate_file_refresh_hashing (pathel);
1171 /* File is probably not there, but check the hard way just in case. */
1172 val = locate_file_without_hash (path, str, suffix, storeptr,
1176 /* Sneaky user added a file without telling us. */
1177 Flocate_file_clear_hashing (path);
1187 /* Merge the list we've accumulated of globals from the current input source
1188 into the load_history variable. The details depend on whether
1189 the source has an associated file name or not. */
1192 build_load_history (int loading, Lisp_Object source)
1194 REGISTER Lisp_Object tail, prev, newelt;
1195 REGISTER Lisp_Object tem, tem2;
1198 #if !defined(LOADHIST_DUMPED)
1199 /* Don't bother recording anything for preloaded files. */
1204 tail = Vload_history;
1207 while (!NILP (tail))
1211 /* Find the feature's previous assoc list... */
1212 if (internal_equal (source, Fcar (tem), 0))
1216 /* If we're loading, remove it. */
1220 Vload_history = Fcdr (tail);
1222 Fsetcdr (prev, Fcdr (tail));
1225 /* Otherwise, cons on new symbols that are not already members. */
1228 tem2 = Vcurrent_load_list;
1230 while (CONSP (tem2))
1232 newelt = XCAR (tem2);
1234 if (NILP (Fmemq (newelt, tem)))
1235 Fsetcar (tail, Fcons (Fcar (tem),
1236 Fcons (newelt, Fcdr (tem))));
1249 /* If we're loading, cons the new assoc onto the front of load-history,
1250 the most-recently-loaded position. Also do this if we didn't find
1251 an existing member for the current source. */
1252 if (loading || !foundit)
1253 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
1257 #else /* !LOADHIST */
1258 #define build_load_history(x,y)
1259 #endif /* !LOADHIST */
1262 #if 0 /* FSFmacs defun hack */
1264 unreadpure (void) /* Used as unwind-protect function in readevalloop */
1272 readevalloop (Lisp_Object readcharfun,
1273 Lisp_Object sourcename,
1274 Lisp_Object (*evalfun) (Lisp_Object),
1277 /* This function can GC */
1279 REGISTER Lisp_Object val;
1280 int speccount = specpdl_depth ();
1281 struct gcpro gcpro1;
1282 struct buffer *b = 0;
1284 if (BUFFERP (readcharfun))
1285 b = XBUFFER (readcharfun);
1286 else if (MARKERP (readcharfun))
1287 b = XMARKER (readcharfun)->buffer;
1289 /* Don't do this. It is not necessary, and it needlessly exposes
1290 READCHARFUN (which can be a stream) to Lisp. --hniksic */
1291 /*specbind (Qstandard_input, readcharfun);*/
1293 specbind (Qcurrent_load_list, Qnil);
1295 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1296 Vcurrent_compiled_function_annotation = Qnil;
1298 GCPRO1 (sourcename);
1300 LOADHIST_ATTACH (sourcename);
1306 if (b != 0 && !BUFFER_LIVE_P (b))
1307 error ("Reading from killed buffer");
1309 c = readchar (readcharfun);
1313 while ((c = readchar (readcharfun)) != '\n' && c != -1)
1320 /* Ignore whitespace here, so we can detect eof. */
1321 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
1324 #if 0 /* FSFmacs defun hack */
1325 if (purify_flag && c == '(')
1327 int count1 = specpdl_depth ();
1328 record_unwind_protect (unreadpure, Qnil);
1329 val = read_list (readcharfun, ')', -1, 1);
1330 unbind_to (count1, Qnil);
1333 #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
1335 unreadchar (readcharfun, c);
1336 read_objects = Qnil;
1337 if (NILP (Vload_read_function))
1338 val = read0 (readcharfun);
1340 val = call1 (Vload_read_function, readcharfun);
1343 val = (*evalfun) (val);
1346 Vvalues = Fcons (val, Vvalues);
1347 if (EQ (Vstandard_output, Qt))
1354 build_load_history (LSTREAMP (readcharfun) ||
1355 /* This looks weird, but it's what's in FSFmacs */
1356 (b ? BUF_NARROWED (b) : BUF_NARROWED (current_buffer)),
1360 unbind_to (speccount, Qnil);
1363 DEFUN ("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /*
1364 Execute 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 there is no error, point does not move. If there is an error,
1371 point remains at the end of the last character read from the buffer.
1372 Execute BUFFER as Lisp code.
1374 (bufname, printflag))
1376 /* This function can GC */
1377 int speccount = specpdl_depth ();
1378 Lisp_Object tem, buf;
1381 buf = Fcurrent_buffer ();
1383 buf = Fget_buffer (bufname);
1385 error ("No such buffer.");
1387 if (NILP (printflag))
1388 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1391 specbind (Qstandard_output, tem);
1392 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1393 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
1394 readevalloop (buf, XBUFFER (buf)->filename, Feval,
1397 return unbind_to (speccount, Qnil);
1401 xxDEFUN ("eval-current-buffer", Feval_current_buffer, 0, 1, "", /*
1402 Execute the current buffer as Lisp code.
1403 Programs can pass argument PRINTFLAG which controls printing of output:
1404 nil means discard it; anything else is stream for print.
1406 If there is no error, point does not move. If there is an error,
1407 point remains at the end of the last character read from the buffer.
1415 DEFUN ("eval-region", Feval_region, 2, 3, "r", /*
1416 Execute the region as Lisp code.
1417 When called from programs, expects two arguments,
1418 giving starting and ending indices in the current buffer
1419 of the text to be executed.
1420 Programs can pass third argument PRINTFLAG which controls output:
1421 nil means discard it; anything else is stream for printing it.
1423 If there is no error, point does not move. If there is an error,
1424 point remains at the end of the last character read from the buffer.
1426 Note: Before evaling the region, this function narrows the buffer to it.
1427 If the code being eval'd should happen to trigger a redisplay you may
1428 see some text temporarily disappear because of this.
1432 /* This function can GC */
1433 int speccount = specpdl_depth ();
1435 Lisp_Object cbuf = Fcurrent_buffer ();
1437 if (NILP (printflag))
1438 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1441 specbind (Qstandard_output, tem);
1443 if (NILP (printflag))
1444 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1445 record_unwind_protect (save_restriction_restore, save_restriction_save ());
1447 /* This both uses b and checks its type. */
1448 Fgoto_char (b, cbuf);
1449 Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), e, cbuf);
1450 readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,
1453 return unbind_to (speccount, Qnil);
1456 DEFUN ("read", Fread, 0, 1, 0, /*
1457 Read one Lisp expression as text from STREAM, return as Lisp object.
1458 If STREAM is nil, use the value of `standard-input' (which see).
1459 STREAM or the value of `standard-input' may be:
1460 a buffer (read from point and advance it)
1461 a marker (read from where it points and advance it)
1462 a function (call it with no arguments for each character,
1463 call it with a char as argument to push a char back)
1464 a string (takes text from string, starting at the beginning)
1465 t (read text line using minibuffer and use it).
1470 stream = Vstandard_input;
1471 if (EQ (stream, Qt))
1472 stream = Qread_char;
1474 read_objects = Qnil;
1476 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1477 Vcurrent_compiled_function_annotation = Qnil;
1479 if (EQ (stream, Qread_char))
1481 Lisp_Object val = call1 (Qread_from_minibuffer,
1482 build_translated_string ("Lisp expression: "));
1483 return Fcar (Fread_from_string (val, Qnil, Qnil));
1486 if (STRINGP (stream))
1487 return Fcar (Fread_from_string (stream, Qnil, Qnil));
1489 return read0 (stream);
1492 DEFUN ("read-from-string", Fread_from_string, 1, 3, 0, /*
1493 Read one Lisp expression which is represented as text by STRING.
1494 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1495 START and END optionally delimit a substring of STRING from which to read;
1496 they default to 0 and (length STRING) respectively.
1498 (string, start, end))
1500 Bytecount startval, endval;
1502 Lisp_Object lispstream = Qnil;
1503 struct gcpro gcpro1;
1505 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1506 Vcurrent_compiled_function_annotation = Qnil;
1508 GCPRO1 (lispstream);
1509 CHECK_STRING (string);
1510 get_string_range_byte (string, start, end, &startval, &endval,
1511 GB_HISTORICAL_STRING_BEHAVIOR);
1512 lispstream = make_lisp_string_input_stream (string, startval,
1515 read_objects = Qnil;
1517 tem = read0 (lispstream);
1518 /* Yeah, it's ugly. Gonna make something of it?
1519 At least our reader is reentrant ... */
1521 (Fcons (tem, make_int
1522 (bytecount_to_charcount
1523 (XSTRING_DATA (string),
1524 startval + Lstream_byte_count (XLSTREAM (lispstream))))));
1525 Lstream_delete (XLSTREAM (lispstream));
1531 #ifdef LISP_BACKQUOTES
1534 backquote_unwind (Lisp_Object ptr)
1535 { /* used as unwind-protect function in read0() */
1536 int *counter = (int *) get_opaque_ptr (ptr);
1539 free_opaque_ptr (ptr);
1545 /* Use this for recursive reads, in contexts where internal tokens
1546 are not allowed. See also read1(). */
1548 read0 (Lisp_Object readcharfun)
1552 val = read1 (readcharfun);
1553 if (CONSP (val) && UNBOUNDP (XCAR (val)))
1555 Emchar c = XCHAR (XCDR (val));
1556 free_cons (XCONS (val));
1557 return Fsignal (Qinvalid_read_syntax,
1558 list1 (Fchar_to_string (make_char (c))));
1565 read_escape (Lisp_Object readcharfun)
1567 /* This function can GC */
1568 Emchar c = readchar (readcharfun);
1571 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1575 case 'a': return '\007';
1576 case 'b': return '\b';
1577 case 'd': return 0177;
1578 case 'e': return 033;
1579 case 'f': return '\f';
1580 case 'n': return '\n';
1581 case 'r': return '\r';
1582 case 't': return '\t';
1583 case 'v': return '\v';
1584 case '\n': return -1;
1587 c = readchar (readcharfun);
1589 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1591 error ("Invalid escape character syntax");
1592 c = readchar (readcharfun);
1594 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1596 c = read_escape (readcharfun);
1599 /* Originally, FSF_KEYS provided a degree of FSF Emacs
1600 compatibility by defining character "modifiers" alt, super,
1601 hyper and shift to infest the characters (i.e. integers).
1603 However, this doesn't cut it for XEmacs 20, which
1604 distinguishes characters from integers. Without Mule, ?\H-a
1605 simply returns ?a because every character is clipped into
1606 0-255. Under Mule it is much worse -- ?\H-a with FSF_KEYS
1607 produces an illegal character, and moves us to crash-land.
1609 For these reasons, FSF_KEYS hack is useless and without hope
1610 of ever working under XEmacs 20. */
1614 #define alt_modifier (0x040000)
1615 #define super_modifier (0x080000)
1616 #define hyper_modifier (0x100000)
1617 #define shift_modifier (0x200000)
1618 /* fsf uses a different modifiers for meta and control. Possibly
1619 byte_compiled code will still work fsfmacs, though... --Stig
1621 #define ctl_modifier (0x400000)
1622 #define meta_modifier (0x800000)
1624 #define FSF_LOSSAGE(mask) \
1625 if (fail_on_bucky_bit_character_escapes || \
1626 ((c = readchar (readcharfun)) != '-')) \
1627 error ("Invalid escape character syntax"); \
1628 c = readchar (readcharfun); \
1630 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun))); \
1632 c = read_escape (readcharfun); \
1635 case 'S': FSF_LOSSAGE (shift_modifier);
1636 case 'H': FSF_LOSSAGE (hyper_modifier);
1637 case 'A': FSF_LOSSAGE (alt_modifier);
1638 case 's': FSF_LOSSAGE (super_modifier);
1640 #undef super_modifier
1641 #undef hyper_modifier
1642 #undef shift_modifier
1645 #endif /* FSF_KEYS */
1648 c = readchar (readcharfun);
1650 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1652 error ("Invalid escape character syntax");
1654 c = readchar (readcharfun);
1656 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1658 c = read_escape (readcharfun);
1659 /* FSFmacs junk for non-ASCII controls.
1664 return c & (0200 | 037);
1674 /* An octal escape, as in ANSI C. */
1676 REGISTER Emchar i = c - '0';
1677 REGISTER int count = 0;
1680 if ((c = readchar (readcharfun)) >= '0' && c <= '7')
1681 i = (i << 3) + (c - '0');
1684 unreadchar (readcharfun, c);
1692 /* A hex escape, as in ANSI C. */
1694 REGISTER Emchar i = 0;
1697 c = readchar (readcharfun);
1698 /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
1699 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
1700 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
1701 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
1704 unreadchar (readcharfun, c);
1712 /* #### need some way of reading an extended character with
1713 an escape sequence. */
1723 /* read symbol-constituent stuff into `Vread_buffer_stream'. */
1725 read_atom_0 (Lisp_Object readcharfun, Emchar firstchar, int *saw_a_backslash)
1727 /* This function can GC */
1728 Emchar c = ((firstchar) >= 0 ? firstchar : readchar (readcharfun));
1729 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
1731 *saw_a_backslash = 0;
1733 while (c > 040 /* #### - comma should be here as should backquote */
1734 && !(c == '\"' || c == '\'' || c == ';'
1735 || c == '(' || c == ')'
1736 #ifndef LISP_FLOAT_TYPE
1737 /* If we have floating-point support, then we need
1738 to allow <digits><dot><digits>. */
1740 #endif /* not LISP_FLOAT_TYPE */
1741 || c == '[' || c == ']' || c == '#'
1746 c = readchar (readcharfun);
1748 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1749 *saw_a_backslash = 1;
1751 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
1753 c = readchar (readcharfun);
1757 unreadchar (readcharfun, c);
1758 /* blasted terminating 0 */
1759 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), 0);
1760 Lstream_flush (XLSTREAM (Vread_buffer_stream));
1762 return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
1765 static Lisp_Object parse_integer (CONST Bufbyte *buf, Bytecount len, int base);
1768 read_atom (Lisp_Object readcharfun,
1770 int uninterned_symbol)
1772 /* This function can GC */
1773 int saw_a_backslash;
1774 Bytecount len = read_atom_0 (readcharfun, firstchar, &saw_a_backslash);
1775 char *read_ptr = (char *)
1776 resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream));
1778 /* Is it an integer? */
1779 if (! (saw_a_backslash || uninterned_symbol))
1781 /* If a token had any backslashes in it, it is disqualified from
1782 being an integer or a float. This means that 123\456 is a
1783 symbol, as is \123 (which is the way (intern "123") prints).
1784 Also, if token was preceded by #:, it's always a symbol.
1786 char *p = read_ptr + len;
1787 char *p1 = read_ptr;
1789 if (*p1 == '+' || *p1 == '-') p1++;
1794 while (p1 != p && (c = *p1) >= '0' && c <= '9')
1796 #ifdef LISP_FLOAT_TYPE
1797 /* Integers can have trailing decimal points. */
1798 if (p1 > read_ptr && p1 < p && *p1 == '.')
1803 /* It is an integer. */
1804 #ifdef LISP_FLOAT_TYPE
1811 if (sizeof (int) == sizeof (EMACS_INT))
1812 number = atoi (read_buffer);
1813 else if (sizeof (long) == sizeof (EMACS_INT))
1814 number = atol (read_buffer);
1817 return make_int (number);
1820 return parse_integer ((Bufbyte *) read_ptr, len, 10);
1824 #ifdef LISP_FLOAT_TYPE
1825 if (isfloat_string (read_ptr))
1826 return make_float (atof (read_ptr));
1832 if (uninterned_symbol)
1833 sym = (Fmake_symbol ((purify_flag)
1834 ? make_pure_pname ((Bufbyte *) read_ptr, len, 0)
1835 : make_string ((Bufbyte *) read_ptr, len)));
1838 /* intern will purecopy pname if necessary */
1839 Lisp_Object name = make_string ((Bufbyte *) read_ptr, len);
1840 sym = Fintern (name, Qnil);
1842 if (SYMBOL_IS_KEYWORD (sym))
1844 /* the LISP way is to put keywords in their own package,
1845 but we don't have packages, so we do something simpler.
1846 Someday, maybe we'll have packages and then this will
1847 be reworked. --Stig. */
1848 XSYMBOL (sym)->value = sym;
1857 parse_integer (CONST Bufbyte *buf, Bytecount len, int base)
1859 CONST Bufbyte *lim = buf + len;
1860 CONST Bufbyte *p = buf;
1862 int negativland = 0;
1877 for (; (p < lim) && (*p != '\0'); p++)
1884 else if (isupper (c))
1886 else if (islower (c))
1891 if (c < 0 || c >= base)
1895 num = num * base + c;
1901 EMACS_INT int_result = negativland ? - (EMACS_INT) num : (EMACS_INT) num;
1902 Lisp_Object result = make_int (int_result);
1903 if (num && ((XINT (result) < 0) != negativland))
1905 if (XINT (result) != int_result)
1910 return Fsignal (Qinvalid_read_syntax,
1911 list3 (build_translated_string
1912 ("Integer constant overflow in reader"),
1913 make_string (buf, len),
1916 return Fsignal (Qinvalid_read_syntax,
1917 list3 (build_translated_string
1918 ("Invalid integer constant in reader"),
1919 make_string (buf, len),
1925 read_integer (Lisp_Object readcharfun, int base)
1927 /* This function can GC */
1928 int saw_a_backslash;
1929 Bytecount len = read_atom_0 (readcharfun, -1, &saw_a_backslash);
1930 return (parse_integer
1931 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
1933 ? 0 /* make parse_integer signal error */
1939 read_bit_vector (Lisp_Object readcharfun)
1941 unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
1946 c = readchar (readcharfun);
1947 if (c != '0' && c != '1')
1949 Dynarr_add (dyn, (unsigned char) (c - '0'));
1953 unreadchar (readcharfun, c);
1955 return make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
1956 Dynarr_length (dyn));
1963 struct structure_type *
1964 define_structure_type (Lisp_Object type,
1965 int (*validate) (Lisp_Object data,
1966 Error_behavior errb),
1967 Lisp_Object (*instantiate) (Lisp_Object data))
1969 struct structure_type st;
1972 st.keywords = Dynarr_new (structure_keyword_entry);
1973 st.validate = validate;
1974 st.instantiate = instantiate;
1975 Dynarr_add (the_structure_type_dynarr, st);
1977 return Dynarr_atp (the_structure_type_dynarr,
1978 Dynarr_length (the_structure_type_dynarr) - 1);
1982 define_structure_type_keyword (struct structure_type *st, Lisp_Object keyword,
1983 int (*validate) (Lisp_Object keyword,
1985 Error_behavior errb))
1987 struct structure_keyword_entry en;
1989 en.keyword = keyword;
1990 en.validate = validate;
1991 Dynarr_add (st->keywords, en);
1994 static struct structure_type *
1995 recognized_structure_type (Lisp_Object type)
1999 for (i = 0; i < Dynarr_length (the_structure_type_dynarr); i++)
2001 struct structure_type *st = Dynarr_atp (the_structure_type_dynarr, i);
2002 if (EQ (st->type, type))
2010 read_structure (Lisp_Object readcharfun)
2012 Emchar c = readchar (readcharfun);
2013 Lisp_Object list = Qnil;
2014 Lisp_Object orig_list = Qnil;
2015 Lisp_Object already_seen = Qnil;
2017 struct structure_type *st;
2018 struct gcpro gcpro1, gcpro2;
2020 GCPRO2 (orig_list, already_seen);
2022 RETURN_UNGCPRO (continuable_syntax_error ("#s not followed by paren"));
2023 list = read_list (readcharfun, ')', 0, 0);
2026 int len = XINT (Flength (list));
2028 RETURN_UNGCPRO (continuable_syntax_error
2029 ("structure type not specified"));
2032 (continuable_syntax_error
2033 ("structures must have alternating keyword/value pairs"));
2036 st = recognized_structure_type (XCAR (list));
2038 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2039 list2 (build_translated_string
2040 ("unrecognized structure type"),
2044 keyword_count = Dynarr_length (st->keywords);
2045 while (!NILP (list))
2047 Lisp_Object keyword, value;
2049 struct structure_keyword_entry *en = NULL;
2051 keyword = Fcar (list);
2053 value = Fcar (list);
2056 if (!NILP (memq_no_quit (keyword, already_seen)))
2057 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2058 list2 (build_translated_string
2059 ("structure keyword already seen"),
2062 for (i = 0; i < keyword_count; i++)
2064 en = Dynarr_atp (st->keywords, i);
2065 if (EQ (keyword, en->keyword))
2069 if (i == keyword_count)
2070 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2071 list2 (build_translated_string
2072 ("unrecognized structure keyword"),
2075 if (en->validate && ! (en->validate) (keyword, value, ERROR_ME))
2077 (Fsignal (Qinvalid_read_syntax,
2078 list3 (build_translated_string
2079 ("invalid value for structure keyword"),
2082 already_seen = Fcons (keyword, already_seen);
2085 if (st->validate && ! (st->validate) (orig_list, ERROR_ME))
2086 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2087 list2 (build_translated_string
2088 ("invalid structure initializer"),
2091 RETURN_UNGCPRO ((st->instantiate) (XCDR (orig_list)));
2095 static Lisp_Object read_compiled_function (Lisp_Object readcharfun,
2097 static Lisp_Object read_vector (Lisp_Object readcharfun, int terminator);
2099 /* Get the next character; filter out whitespace and comments */
2102 reader_nextchar (Lisp_Object readcharfun)
2104 /* This function can GC */
2109 c = readchar (readcharfun);
2111 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2117 /* Ignore whitespace and control characters */
2126 while ((c = readchar (readcharfun)) >= 0 && c != '\n')
2135 list2_pure (int pure, Lisp_Object a, Lisp_Object b)
2137 return pure ? pure_cons (a, pure_cons (b, Qnil)) : list2 (a, b);
2141 /* Read the next Lisp object from the stream READCHARFUN and return it.
2142 If the return value is a cons whose car is Qunbound, then read1()
2143 encountered a misplaced token (e.g. a right bracket, right paren,
2144 or dot followed by a non-number). To filter this stuff out,
2148 read1 (Lisp_Object readcharfun)
2153 c = reader_nextchar (readcharfun);
2159 #ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
2160 /* if this is disabled, then other code in eval.c must be enabled */
2161 Emchar ch = reader_nextchar (readcharfun);
2167 int speccount = specpdl_depth ();
2168 ++old_backquote_flag;
2169 record_unwind_protect (backquote_unwind,
2170 make_opaque_ptr (&old_backquote_flag));
2171 tem = read0 (readcharfun);
2172 unbind_to (speccount, Qnil);
2173 ch = reader_nextchar (readcharfun);
2176 unreadchar (readcharfun, ch);
2177 return Fsignal (Qinvalid_read_syntax,
2179 ("Weird old-backquote syntax")));
2181 return list2 (Qbacktick, tem);
2185 if (old_backquote_flag)
2187 Lisp_Object tem, comma_type;
2188 ch = readchar (readcharfun);
2190 comma_type = Qcomma_at;
2194 unreadchar (readcharfun, ch);
2195 comma_type = Qcomma;
2197 tem = read0 (readcharfun);
2198 ch = reader_nextchar (readcharfun);
2201 unreadchar (readcharfun, ch);
2202 return Fsignal (Qinvalid_read_syntax,
2204 ("Weird old-backquote syntax")));
2206 return list2 (comma_type, tem);
2210 unreadchar (readcharfun, ch);
2212 return Fsignal (Qinvalid_read_syntax,
2213 list1 (build_string ("Comma outside of backquote")));
2215 /* #### - yuck....but this is reverse compatible. */
2216 /* mostly this is required by edebug, which does its own
2217 annotated reading. We need to have an annotated_read
2218 function that records (with markers) the buffer
2219 positions of the elements that make up lists, then that
2220 can be used in edebug and bytecomp and the check above
2221 can go back in. --Stig */
2227 unreadchar (readcharfun, ch);
2229 #endif /* old backquote crap... */
2230 return read_list (readcharfun, ')', 1, 1);
2233 return read_vector (readcharfun, ']');
2237 /* #### - huh? these don't do what they seem... */
2238 return noseeum_cons (Qunbound, make_char (c));
2241 #ifdef LISP_FLOAT_TYPE
2242 /* If a period is followed by a number, then we should read it
2243 as a floating point number. Otherwise, it denotes a dotted
2246 c = readchar (readcharfun);
2247 unreadchar (readcharfun, c);
2249 /* Can't use isdigit on Emchars */
2250 if (c < '0' || c > '9')
2251 return noseeum_cons (Qunbound, make_char ('.'));
2253 /* Note that read_atom will loop
2254 at least once, assuring that we will not try to UNREAD
2255 two characters in a row.
2256 (I think this doesn't matter anymore because there should
2257 be no more danger in unreading multiple characters) */
2258 return read_atom (readcharfun, '.', 0);
2260 #else /* ! LISP_FLOAT_TYPE */
2261 return noseeum_cons (Qunbound, make_char ('.'));
2262 #endif /* ! LISP_FLOAT_TYPE */
2267 c = readchar (readcharfun);
2270 #if 0 /* FSFmacs silly char-table syntax */
2273 #if 0 /* FSFmacs silly bool-vector syntax */
2276 /* "#["-- byte-code constant syntax */
2277 /* purecons #[...] syntax */
2278 case '[': return read_compiled_function (readcharfun, ']'
2279 /*, purify_flag */ );
2280 /* "#:"-- gensym syntax */
2281 case ':': return read_atom (readcharfun, -1, 1);
2282 /* #'x => (function x) */
2283 case '\'': return list2 (Qfunction, read0 (readcharfun));
2285 /* RMS uses this syntax for fat-strings.
2286 If we use it for vectors, then obscure bugs happen.
2288 /* "#(" -- Scheme/CL vector syntax */
2289 case '(': return read_vector (readcharfun, ')');
2295 struct gcpro gcpro1;
2297 /* Read the string itself. */
2298 tmp = read1 (readcharfun);
2301 if (CONSP (tmp) && UNBOUNDP (XCAR (tmp)))
2302 free_cons (XCONS (tmp));
2303 return Fsignal (Qinvalid_read_syntax,
2304 list1 (build_string ("#")));
2307 /* Read the intervals and their properties. */
2310 Lisp_Object beg, end, plist;
2314 beg = read1 (readcharfun);
2315 if (CONSP (beg) && UNBOUNDP (XCAR (beg)))
2317 ch = XCHAR (XCDR (beg));
2318 free_cons (XCONS (beg));
2326 end = read1 (readcharfun);
2327 if (CONSP (end) && UNBOUNDP (XCAR (end)))
2329 free_cons (XCONS (end));
2335 plist = read1 (readcharfun);
2336 if (CONSP (plist) && UNBOUNDP (XCAR (plist)))
2338 free_cons (XCONS (plist));
2344 (Fsignal (Qinvalid_read_syntax,
2346 (build_string ("invalid string property list"),
2348 Fset_text_properties (beg, end, plist, tmp);
2356 /* #@NUMBER is used to skip NUMBER following characters.
2357 That's used in .elc files to skip over doc strings
2358 and function definitions. */
2361 /* Read a decimal integer. */
2362 while ((c = readchar (readcharfun)) >= 0
2363 && c >= '0' && c <= '9')
2364 nskip = (10 * nskip) + (c - '0');
2366 unreadchar (readcharfun, c);
2368 /* FSF has code here that maybe caches the skipped
2369 string. See above for why this is totally
2370 losing. We handle this differently. */
2372 /* Skip that many characters. */
2373 for (i = 0; i < nskip && c >= 0; i++)
2374 c = readchar (readcharfun);
2378 case '$': return Vload_file_name_internal;
2380 case '*': return read_bit_vector (readcharfun);
2381 /* #o10 => 8 -- octal constant syntax */
2382 case 'o': return read_integer (readcharfun, 8);
2383 /* #xdead => 57005 -- hex constant syntax */
2384 case 'x': return read_integer (readcharfun, 16);
2385 /* #b010 => 2 -- binary constant syntax */
2386 case 'b': return read_integer (readcharfun, 2);
2387 /* #s(foobar key1 val1 key2 val2) -- structure syntax */
2388 case 's': return read_structure (readcharfun);
2391 unreadchar (readcharfun, c);
2392 return Fsignal (Qinvalid_read_syntax,
2393 list1 (build_string ("Cannot read unreadable object")));
2395 #ifdef FEATUREP_SYNTAX
2399 Lisp_Object fexp, obj, tem;
2400 struct gcpro gcpro1, gcpro2;
2402 fexp = read0(readcharfun);
2403 obj = read0(readcharfun);
2405 /* the call to `featurep' may GC. */
2407 tem = call1(Qfeaturep, fexp);
2410 if (c == '+' && NILP(tem)) goto retry;
2411 if (c == '-' && !NILP(tem)) goto retry;
2415 case '0': case '1': case '2': case '3': case '4':
2416 case '5': case '6': case '7': case '8': case '9':
2417 /* Reader forms that can reuse previously read objects. */
2422 /* Using read_integer() here is impossible, because it
2423 chokes on `='. Using parse_integer() is too hard.
2424 So we simply read it in, and ignore overflows, which
2426 while (c >= '0' && c <= '9')
2430 c = readchar (readcharfun);
2432 found = assq_no_quit (make_int (n), read_objects);
2435 /* #n=object returns object, but associates it with
2439 return Fsignal (Qinvalid_read_syntax,
2440 list2 (build_translated_string
2441 ("Multiply defined symbol label"),
2443 obj = read0 (readcharfun);
2444 read_objects = Fcons (Fcons (make_int (n), obj), read_objects);
2449 /* #n# returns a previously read object. */
2451 return XCDR (found);
2453 return Fsignal (Qinvalid_read_syntax,
2454 list2 (build_translated_string
2455 ("Undefined symbol label"),
2458 return Fsignal (Qinvalid_read_syntax,
2459 list1 (build_string ("#")));
2463 unreadchar (readcharfun, c);
2464 return Fsignal (Qinvalid_read_syntax,
2465 list1 (build_string ("#")));
2471 case '\'': return list2 (Qquote, read0 (readcharfun));
2473 #ifdef LISP_BACKQUOTES
2477 int speccount = specpdl_depth ();
2478 ++new_backquote_flag;
2479 record_unwind_protect (backquote_unwind,
2480 make_opaque_ptr (&new_backquote_flag));
2481 tem = read0 (readcharfun);
2482 unbind_to (speccount, Qnil);
2483 return list2 (Qbackquote, tem);
2488 if (new_backquote_flag)
2490 Lisp_Object comma_type = Qnil;
2491 int ch = readchar (readcharfun);
2494 comma_type = Qcomma_at;
2496 comma_type = Qcomma_dot;
2500 unreadchar (readcharfun, ch);
2501 comma_type = Qcomma;
2503 return list2 (comma_type, read0 (readcharfun));
2507 /* YUCK. 99.999% backwards compatibility. The Right
2508 Thing(tm) is to signal an error here, because it's
2509 really invalid read syntax. Instead, this permits
2510 commas to begin symbols (unless they're inside
2511 backquotes). If an error is signalled here in the
2512 future, then commas should be invalid read syntax
2513 outside of backquotes anywhere they're found (i.e.
2514 they must be quoted in symbols) -- Stig */
2515 return read_atom (readcharfun, c, 0);
2522 /* Evil GNU Emacs "character" (ie integer) syntax */
2523 c = readchar (readcharfun);
2525 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2528 c = read_escape (readcharfun);
2529 return make_char (c);
2536 /* #### If the input stream is translating, then the string
2537 should be marked as translatable by setting its
2538 `string-translatable' property to t. .el and .elc files
2539 normally are translating input streams. See Fgettext()
2540 and print_internal(). */
2544 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
2545 while ((c = readchar (readcharfun)) >= 0
2549 c = read_escape (readcharfun);
2550 /* c is -1 if \ newline has just been seen */
2553 if (Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) == 0)
2557 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
2561 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2563 /* If purifying, and string starts with \ newline,
2564 return zero instead. This is for doc strings
2565 that we are really going to find in lib-src/DOC.nn.nn */
2566 if (purify_flag && NILP (Vinternal_doc_file_name) && cancel)
2569 Lstream_flush (XLSTREAM (Vread_buffer_stream));
2570 #if 0 /* FSFmacs defun hack */
2574 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
2575 Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
2580 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
2581 Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
2586 /* Ignore whitespace and control characters */
2589 return read_atom (readcharfun, c, 0);
2596 #ifdef LISP_FLOAT_TYPE
2605 isfloat_string (CONST char *cp)
2608 CONST Bufbyte *ucp = (CONST Bufbyte *) cp;
2610 if (*ucp == '+' || *ucp == '-')
2613 if (*ucp >= '0' && *ucp <= '9')
2616 while (*ucp >= '0' && *ucp <= '9')
2624 if (*ucp >= '0' && *ucp <= '9')
2627 while (*ucp >= '0' && *ucp <= '9')
2630 if (*ucp == 'e' || *ucp == 'E')
2634 if ((*ucp == '+') || (*ucp == '-'))
2638 if (*ucp >= '0' && *ucp <= '9')
2641 while (*ucp >= '0' && *ucp <= '9')
2644 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') || (*ucp == '\n')
2645 || (*ucp == '\r') || (*ucp == '\f'))
2646 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
2647 || state == (DOT_CHAR|TRAIL_INT)
2648 || state == (LEAD_INT|E_CHAR|EXP_INT)
2649 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
2650 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
2652 #endif /* LISP_FLOAT_TYPE */
2655 sequence_reader (Lisp_Object readcharfun,
2658 void * (*conser) (Lisp_Object readcharfun,
2659 void *state, Charcount len))
2663 for (len = 0; ; len++)
2668 ch = reader_nextchar (readcharfun);
2670 if (ch == terminator)
2673 unreadchar (readcharfun, ch);
2674 #ifdef FEATUREP_SYNTAX
2676 syntax_error ("\"]\" in a list");
2678 syntax_error ("\")\" in a vector");
2680 state = ((conser) (readcharfun, state, len));
2685 struct read_list_state
2690 int allow_dotted_lists;
2695 read_list_conser (Lisp_Object readcharfun, void *state, Charcount len)
2697 struct read_list_state *s = (struct read_list_state *) state;
2700 elt = read1 (readcharfun);
2702 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
2704 Lisp_Object tem = elt;
2708 free_cons (XCONS (tem));
2711 #ifdef FEATUREP_SYNTAX
2712 if (ch == s->terminator) /* deal with #+, #- reader macros */
2714 unreadchar (readcharfun, s->terminator);
2718 syntax_error ("']' in a list");
2720 syntax_error ("')' in a vector");
2724 signal_simple_error ("BUG! Internal reader error", elt);
2725 else if (!s->allow_dotted_lists)
2726 syntax_error ("\".\" in a vector");
2729 if (!NILP (s->tail))
2730 XCDR (s->tail) = read0 (readcharfun);
2732 s->head = read0 (readcharfun);
2733 elt = read1 (readcharfun);
2734 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
2736 ch = XCHAR (XCDR (elt));
2737 free_cons (XCONS (elt));
2738 if (ch == s->terminator)
2740 unreadchar (readcharfun, s->terminator);
2744 syntax_error (". in wrong context");
2748 #if 0 /* FSFmacs defun hack, or something ... */
2749 if (NILP (tail) && defun_hack && EQ (elt, Qdefun) && !read_pure)
2751 record_unwind_protect (unreadpure, Qzero);
2756 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2757 if (s->length == 1 && s->allow_dotted_lists && EQ (XCAR (s->head), Qfset))
2759 if (CONSP (elt) && EQ (XCAR (elt), Qquote) && CONSP (XCDR (elt)))
2760 Vcurrent_compiled_function_annotation = XCAR (XCDR (elt));
2762 Vcurrent_compiled_function_annotation = elt;
2766 elt = Fcons (elt, Qnil);
2767 if (!NILP (s->tail))
2768 XCDR (s->tail) = elt;
2778 #if 0 /* FSFmacs defun hack */
2779 /* -1 for allow_dotted_lists means allow_dotted_lists and check
2780 for starting with defun and make structure pure. */
2784 read_list (Lisp_Object readcharfun,
2786 int allow_dotted_lists,
2787 int check_for_doc_references)
2789 struct read_list_state s;
2790 struct gcpro gcpro1, gcpro2;
2791 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2792 Lisp_Object old_compiled_function_annotation =
2793 Vcurrent_compiled_function_annotation;
2799 s.allow_dotted_lists = allow_dotted_lists;
2800 s.terminator = terminator;
2801 GCPRO2 (s.head, s.tail);
2803 sequence_reader (readcharfun, terminator, &s, read_list_conser);
2804 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2805 Vcurrent_compiled_function_annotation = old_compiled_function_annotation;
2808 if ((purify_flag || load_force_doc_strings) && check_for_doc_references)
2810 /* check now for any doc string references and record them
2814 /* We might be dealing with an imperfect list so don't
2816 for (tail = s.head; CONSP (tail); tail = XCDR (tail))
2818 Lisp_Object holding_cons = Qnil;
2821 Lisp_Object elem = XCAR (tail);
2822 /* elem might be (#$ . INT) ... */
2823 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
2824 holding_cons = tail;
2825 /* or it might be (quote (#$ . INT)) i.e.
2826 (quote . ((#$ . INT) . nil)) in the case of
2827 `autoload' (autoload evaluates its arguments, while
2828 `defvar', `defun', etc. don't). */
2829 if (CONSP (elem) && EQ (XCAR (elem), Qquote)
2830 && CONSP (XCDR (elem)))
2832 elem = XCAR (XCDR (elem));
2833 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
2834 holding_cons = XCDR (XCAR (tail));
2838 if (CONSP (holding_cons))
2842 if (NILP (Vinternal_doc_file_name))
2843 /* We have not yet called Snarf-documentation, so
2844 assume this file is described in the DOC file
2845 and Snarf-documentation will fill in the right
2846 value later. For now, replace the whole list
2848 XCAR (holding_cons) = Qzero;
2850 /* We have already called Snarf-documentation, so
2851 make a relative file name for this file, so it
2852 can be found properly in the installed Lisp
2853 directory. We don't use Fexpand_file_name
2854 because that would make the directory absolute
2856 XCAR (XCAR (holding_cons)) =
2857 concat2 (build_string ("../lisp/"),
2858 Ffile_name_nondirectory
2859 (Vload_file_name_internal));
2862 /* Not pure. Just add to Vload_force_doc_string_list,
2863 and the string will be filled in properly in
2864 load_force_doc_string_unwind(). */
2865 Vload_force_doc_string_list =
2866 /* We pass the cons that holds the (#$ . INT) so we
2867 can modify it in-place. */
2868 Fcons (holding_cons, Vload_force_doc_string_list);
2878 read_vector (Lisp_Object readcharfun,
2885 struct read_list_state s;
2886 struct gcpro gcpro1, gcpro2;
2891 s.allow_dotted_lists = 0;
2892 GCPRO2 (s.head, s.tail);
2894 sequence_reader (readcharfun, terminator, &s, read_list_conser);
2898 len = XINT (Flength (tem));
2900 #if 0 /* FSFmacs defun hack */
2902 s.head = make_pure_vector (len, Qnil);
2905 s.head = make_vector (len, Qnil);
2907 for (i = 0, p = &(XVECTOR_DATA (s.head)[0]);
2911 struct Lisp_Cons *otem = XCONS (tem);
2912 #if 0 /* FSFmacs defun hack */
2914 tem = Fpurecopy (Fcar (tem));
2926 read_compiled_function (Lisp_Object readcharfun, Emchar terminator)
2928 /* Accept compiled functions at read-time so that we don't
2929 have to build them at load-time. */
2931 Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
2932 struct gcpro gcpro1;
2935 int saw_a_doc_ref = 0;
2937 /* Note: we tell read_list not to search for doc references
2938 because we need to handle the "doc reference" for the
2939 instructions and constants differently. */
2940 stuff = read_list (readcharfun, terminator, 0, 0);
2941 len = XINT (Flength (stuff));
2942 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
2944 continuable_syntax_error ("#[...] used with wrong number of elements");
2946 for (iii = 0; CONSP (stuff); iii++)
2948 struct Lisp_Cons *victim = XCONS (stuff);
2949 make_byte_code_args[iii] = Fcar (stuff);
2950 if ((purify_flag || load_force_doc_strings)
2951 && CONSP (make_byte_code_args[iii])
2952 && EQ (XCAR (make_byte_code_args[iii]), Vload_file_name_internal))
2954 if (purify_flag && iii == COMPILED_DOC_STRING)
2956 /* same as in read_list(). */
2957 if (NILP (Vinternal_doc_file_name))
2958 make_byte_code_args[iii] = Qzero;
2960 XCAR (make_byte_code_args[iii]) =
2961 concat2 (build_string ("../lisp/"),
2962 Ffile_name_nondirectory
2963 (Vload_file_name_internal));
2968 stuff = Fcdr (stuff);
2971 GCPRO1 (make_byte_code_args[0]);
2974 /* v18 or v19 bytecode file. Need to Ebolify. */
2975 if (load_byte_code_version < 20 && VECTORP (make_byte_code_args[2]))
2976 ebolify_bytecode_constants (make_byte_code_args[2]);
2978 /* make-byte-code looks at purify_flag, which should have the same
2979 * value as our "read-pure" argument */
2980 stuff = Fmake_byte_code (len, make_byte_code_args);
2981 XCOMPILED_FUNCTION (stuff)->flags.ebolified = (load_byte_code_version < 20);
2983 Vload_force_doc_string_list = Fcons (stuff, Vload_force_doc_string_list);
2995 load_in_progress = 0;
2997 Vload_descriptor_list = Qnil;
2999 /* kludge: locate-file does not work for a null load-path, even if
3000 the file name is absolute. */
3002 Vload_path = Fcons (build_string (""), Qnil);
3004 /* This used to get initialized in init_lread because all streams
3005 got closed when dumping occurs. This is no longer true --
3006 Vread_buffer_stream is a resizing output stream, and there is no
3007 reason to close it at dump-time.
3009 Vread_buffer_stream is set to Qnil in vars_of_lread, and this
3010 will initialize it only once, at dump-time. */
3011 if (NILP (Vread_buffer_stream))
3012 Vread_buffer_stream = make_resizing_buffer_output_stream ();
3014 Vload_force_doc_string_list = Qnil;
3018 syms_of_lread (void)
3021 DEFSUBR (Fread_from_string);
3022 DEFSUBR (Fload_internal);
3023 DEFSUBR (Flocate_file);
3024 DEFSUBR (Flocate_file_clear_hashing);
3025 DEFSUBR (Feval_buffer);
3026 DEFSUBR (Feval_region);
3028 defsymbol (&Qstandard_input, "standard-input");
3029 defsymbol (&Qread_char, "read-char");
3030 defsymbol (&Qcurrent_load_list, "current-load-list");
3031 defsymbol (&Qload, "load");
3032 defsymbol (&Qload_file_name, "load-file-name");
3033 defsymbol (&Qlocate_file_hash_table, "locate-file-hash-table");
3034 defsymbol (&Qfset, "fset");
3036 #ifdef LISP_BACKQUOTES
3037 defsymbol (&Qbackquote, "backquote");
3038 defsymbol (&Qbacktick, "`");
3039 defsymbol (&Qcomma, ",");
3040 defsymbol (&Qcomma_at, ",@");
3041 defsymbol (&Qcomma_dot, ",.");
3046 structure_type_create (void)
3048 the_structure_type_dynarr = Dynarr_new (structure_type);
3052 vars_of_lread (void)
3054 DEFVAR_LISP ("values", &Vvalues /*
3055 List of values of all expressions which were read, evaluated and printed.
3056 Order is reverse chronological.
3059 DEFVAR_LISP ("standard-input", &Vstandard_input /*
3060 Stream for read to get input from.
3061 See documentation of `read' for possible values.
3063 Vstandard_input = Qt;
3065 DEFVAR_LISP ("load-path", &Vload_path /*
3066 *List of directories to search for files to load.
3067 Each element is a string (directory name) or nil (try default directory).
3069 Note that the elements of this list *may not* begin with "~", so you must
3070 call `expand-file-name' on them before adding them to this list.
3072 Initialized based on EMACSLOADPATH environment variable, if any,
3073 otherwise to default specified in by file `paths.h' when XEmacs was built.
3074 If there were no paths specified in `paths.h', then XEmacs chooses a default
3075 value for this variable by looking around in the file-system near the
3076 directory in which the XEmacs executable resides.
3080 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
3081 "*Location of lisp files to be used when dumping ONLY."); */
3083 DEFVAR_BOOL ("load-in-progress", &load_in_progress /*
3084 Non-nil iff inside of `load'.
3087 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist /*
3088 An alist of expressions to be evalled when particular files are loaded.
3089 Each element looks like (FILENAME FORMS...).
3090 When `load' is run and the file-name argument is FILENAME,
3091 the FORMS in the corresponding element are executed at the end of loading.
3093 FILENAME must match exactly! Normally FILENAME is the name of a library,
3094 with no directory specified, since that is how `load' is normally called.
3095 An error in FORMS does not undo the load,
3096 but does prevent execution of the rest of the FORMS.
3098 Vafter_load_alist = Qnil;
3100 DEFVAR_BOOL ("load-warn-when-source-newer", &load_warn_when_source_newer /*
3101 *Whether `load' should check whether the source is newer than the binary.
3102 If this variable is true, then when a `.elc' file is being loaded and the
3103 corresponding `.el' is newer, a warning message will be printed.
3105 load_warn_when_source_newer = 0;
3107 DEFVAR_BOOL ("load-warn-when-source-only", &load_warn_when_source_only /*
3108 *Whether `load' should warn when loading a `.el' file instead of an `.elc'.
3109 If this variable is true, then when `load' is called with a filename without
3110 an extension, and the `.elc' version doesn't exist but the `.el' version does,
3111 then a message will be printed. If an explicit extension is passed to `load',
3112 no warning will be printed.
3114 load_warn_when_source_only = 0;
3116 DEFVAR_BOOL ("load-ignore-elc-files", &load_ignore_elc_files /*
3117 *Whether `load' should ignore `.elc' files when a suffix is not given.
3118 This is normally used only to bootstrap the `.elc' files when building XEmacs.
3120 load_ignore_elc_files = 0;
3123 DEFVAR_LISP ("load-history", &Vload_history /*
3124 Alist mapping source file names to symbols and features.
3125 Each alist element is a list that starts with a file name,
3126 except for one element (optional) that starts with nil and describes
3127 definitions evaluated from buffers not visiting files.
3128 The remaining elements of each list are symbols defined as functions
3129 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
3131 Vload_history = Qnil;
3133 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list /*
3134 Used for internal purposes by `load'.
3136 Vcurrent_load_list = Qnil;
3139 DEFVAR_LISP ("load-file-name", &Vload_file_name /*
3140 Full name of file being loaded by `load'.
3142 Vload_file_name = Qnil;
3144 DEFVAR_LISP ("load-read-function", &Vload_read_function /*
3145 Function used by `load' and `eval-region' for reading expressions.
3146 The default is nil, which means use the function `read'.
3148 Vload_read_function = Qnil;
3150 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings /*
3151 Non-nil means `load' should force-load all dynamic doc strings.
3152 This is useful when the file being loaded is a temporary copy.
3154 load_force_doc_strings = 0;
3156 DEFVAR_LISP ("source-directory", &Vsource_directory /*
3157 Directory in which XEmacs sources were found when XEmacs was built.
3158 You cannot count on them to still be there!
3160 Vsource_directory = Qnil;
3162 /* See read_escape(). */
3164 /* Used to be named `puke-on-fsf-keys' */
3165 DEFVAR_BOOL ("fail-on-bucky-bit-character-escapes",
3166 &fail_on_bucky_bit_character_escapes /*
3167 Whether `read' should signal an error when it encounters unsupported
3168 character escape syntaxes or just read them incorrectly.
3170 fail_on_bucky_bit_character_escapes = 0;
3173 /* This must be initialized in init_lread otherwise it may start out
3174 with values saved when the image is dumped. */
3175 staticpro (&Vload_descriptor_list);
3177 Vread_buffer_stream = Qnil;
3178 staticpro (&Vread_buffer_stream);
3180 /* Initialized in init_lread. */
3181 staticpro (&Vload_force_doc_string_list);
3183 Vload_file_name_internal = Qnil;
3184 staticpro (&Vload_file_name_internal);
3186 Vload_file_name_internal_the_purecopy = Qnil;
3187 staticpro (&Vload_file_name_internal_the_purecopy);
3189 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3190 Vcurrent_compiled_function_annotation = Qnil;
3191 staticpro (&Vcurrent_compiled_function_annotation);
3194 /* So that early-early stuff will work */
3195 Ffset (Qload, intern ("load-internal"));
3197 #ifdef FEATUREP_SYNTAX
3198 defsymbol (&Qfeaturep, "featurep");
3199 Fprovide(intern("xemacs"));
3201 Fprovide(intern("infodock"));
3202 #endif /* INFODOCK */
3203 #endif /* FEATUREP_SYNTAX */
3205 #ifdef LISP_BACKQUOTES
3206 old_backquote_flag = new_backquote_flag = 0;
3210 Vfile_domain = Qnil;
3213 read_objects = Qnil;
3214 staticpro (&read_objects);