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. */
36 #include "file-coding.h"
41 #ifdef LISP_FLOAT_TYPE
42 #define THIS_FILENAME lread
44 #endif /* LISP_FLOAT_TYPE */
46 Lisp_Object Qread_char, Qstandard_input;
47 Lisp_Object Qvariable_documentation;
48 #define LISP_BACKQUOTES
49 #ifdef LISP_BACKQUOTES
51 Nonzero means inside a new-style backquote
52 with no surrounding parentheses.
53 Fread initializes this to zero, so we need not specbind it
54 or worry about what happens to it when there is an error.
57 Nested backquotes are perfectly legal and fail utterly with
59 static int new_backquote_flag, old_backquote_flag;
60 Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot;
62 Lisp_Object Qvariable_domain; /* I18N3 */
63 Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
64 Lisp_Object Qcurrent_load_list;
65 Lisp_Object Qload, Qload_file_name;
68 /* Hash-table that maps directory names to hashes of their contents. */
69 static Lisp_Object Vlocate_file_hash_table;
71 Lisp_Object Qexists, Qreadable, Qwritable, Qexecutable;
73 /* See read_escape() for an explanation of this. */
75 int fail_on_bucky_bit_character_escapes;
78 /* This symbol is also used in fns.c */
79 #define FEATUREP_SYNTAX
81 #ifdef FEATUREP_SYNTAX
82 Lisp_Object Qfeaturep;
85 /* non-zero if inside `load' */
88 /* Whether Fload_internal() should check whether the .el is newer
90 int load_warn_when_source_newer;
91 /* Whether Fload_internal() should check whether the .elc doesn't exist */
92 int load_warn_when_source_only;
93 /* Whether Fload_internal() should ignore .elc files when no suffix is given */
94 int load_ignore_elc_files;
96 /* Search path for files to be loaded. */
97 Lisp_Object Vload_path;
99 /* Search path for files when dumping. */
100 /* Lisp_Object Vdump_load_path; */
102 /* This is the user-visible association list that maps features to
103 lists of defs in their load files. */
104 Lisp_Object Vload_history;
106 /* This is used to build the load history. */
107 Lisp_Object Vcurrent_load_list;
109 /* Name of file actually being read by `load'. */
110 Lisp_Object Vload_file_name;
112 /* Same as Vload_file_name but not Lisp-accessible. This ensures that
113 our #$ checks are reliable. */
114 Lisp_Object Vload_file_name_internal;
116 Lisp_Object Vload_file_name_internal_the_purecopy;
118 /* Function to use for reading, in `load' and friends. */
119 Lisp_Object Vload_read_function;
121 /* The association list of objects read with the #n=object form.
122 Each member of the list has the form (n . object), and is used to
123 look up the object for the corresponding #n# construct.
124 It must be set to nil before all top-level calls to read0. */
125 Lisp_Object Vread_objects;
127 /* Nonzero means load should forcibly load all dynamic doc strings. */
128 /* Note that this always happens (with some special behavior) when
129 purify_flag is set. */
130 static int load_force_doc_strings;
132 /* List of descriptors now open for Fload_internal. */
133 static Lisp_Object Vload_descriptor_list;
135 /* In order to implement "load_force_doc_strings", we keep
136 a list of all the compiled-function objects and such
137 that we have created in the process of loading this file.
140 We specbind this just like Vload_file_name, so there's no
141 problems with recursive loading. */
142 static Lisp_Object Vload_force_doc_string_list;
144 /* A resizing-buffer stream used to temporarily hold data while reading */
145 static Lisp_Object Vread_buffer_stream;
147 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
148 Lisp_Object Vcurrent_compiled_function_annotation;
151 static int load_byte_code_version;
153 /* An array describing all known built-in structure types */
154 static structure_type_dynarr *the_structure_type_dynarr;
156 #if 0 /* FSF defun hack */
157 /* When nonzero, read conses in pure space */
158 static int read_pure;
161 #if 0 /* FSF stuff */
162 /* For use within read-from-string (this reader is non-reentrant!!) */
163 static int read_from_string_index;
164 static int read_from_string_limit;
167 #if 0 /* More FSF implementation kludges. */
168 /* In order to implement load-force-doc-string, FSF saves the
169 #@-quoted string when it's seen, and goes back and retrieves
172 This approach is not only kludgy, but it in general won't work
173 correctly because there's no stack of remembered #@-quoted-strings
174 and those strings don't generally appear in the file in the same
175 order as their #$ references. (Yes, that is amazingly stupid too.
177 It would be trivially easy to always encode the #@ string
178 [which is a comment, anyway] in the middle of the (#$ . INT) cons
179 reference. That way, it would be really easy to implement
180 load-force-doc-string in a non-kludgy way by just retrieving the
181 string immediately, because it's delivered on a silver platter.)
183 And finally, this stupid approach doesn't work under Mule, or
184 under MS-DOS or Windows NT, or under VMS, or any other place
185 where you either can't do an ftell() or don't get back a byte
188 Oh, and one more lossage in this approach: If you attempt to
189 dump any ELC files that were compiled with `byte-compile-dynamic'
190 (as opposed to just `byte-compile-dynamic-docstring'), you
191 get hosed. FMH! (as the illustrious JWZ was prone to utter)
193 The approach we use is clean, solves all of these problems, and is
194 probably easier to implement anyway. We just save a list of all
195 the containing objects that have (#$ . INT) conses in them (this
196 will only be compiled-function objects and lists), and when the
197 file is finished loading, we go through and fill in all the
198 doc strings at once. */
200 /* This contains the last string skipped with #@. */
201 static char *saved_doc_string;
202 /* Length of buffer allocated in saved_doc_string. */
203 static int saved_doc_string_size;
204 /* Length of actual data in saved_doc_string. */
205 static int saved_doc_string_length;
206 /* This is the file position that string came from. */
207 static int saved_doc_string_position;
210 EXFUN (Fread_from_string, 3);
212 /* When errors are signaled, the actual readcharfun should not be used
213 as an argument if it is an lstream, so that lstreams don't escape
214 to the Lisp level. */
215 #define READCHARFUN_MAYBE(x) (LSTREAMP (x) \
216 ? (build_string ("internal input stream")) \
221 syntax_error (CONST char *string)
223 signal_error (Qinvalid_read_syntax,
224 list1 (build_translated_string (string)));
228 continuable_syntax_error (CONST char *string)
230 return Fsignal (Qinvalid_read_syntax,
231 list1 (build_translated_string (string)));
235 /* Handle unreading and rereading of characters. */
237 readchar (Lisp_Object readcharfun)
239 /* This function can GC */
241 if (BUFFERP (readcharfun))
244 struct buffer *b = XBUFFER (readcharfun);
246 if (!BUFFER_LIVE_P (b))
247 error ("Reading from killed buffer");
249 if (BUF_PT (b) >= BUF_ZV (b))
251 c = BUF_FETCH_CHAR (b, BUF_PT (b));
252 BUF_SET_PT (b, BUF_PT (b) + 1);
256 else if (LSTREAMP (readcharfun))
258 Emchar c = Lstream_get_emchar (XLSTREAM (readcharfun));
259 #ifdef DEBUG_XEMACS /* testing Mule */
260 static int testing_mule = 0; /* Change via debugger */
262 if (c >= 0x20 && c <= 0x7E) fprintf (stderr, "%c", c);
263 else if (c == '\n') fprintf (stderr, "\\n\n");
264 else fprintf (stderr, "\\%o ", c);
269 else if (MARKERP (readcharfun))
272 Bufpos mpos = marker_position (readcharfun);
273 struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
275 if (mpos >= BUF_ZV (inbuffer))
277 c = BUF_FETCH_CHAR (inbuffer, mpos);
278 set_marker_position (readcharfun, mpos + 1);
283 Lisp_Object tem = call0 (readcharfun);
285 if (!CHAR_OR_CHAR_INTP (tem))
287 return XCHAR_OR_CHAR_INT (tem);
291 /* Unread the character C in the way appropriate for the stream READCHARFUN.
292 If the stream is a user function, call it with the char as argument. */
295 unreadchar (Lisp_Object readcharfun, Emchar c)
298 /* Don't back up the pointer if we're unreading the end-of-input mark,
299 since readchar didn't advance it when we read it. */
301 else if (BUFFERP (readcharfun))
302 BUF_SET_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1);
303 else if (LSTREAMP (readcharfun))
305 Lstream_unget_emchar (XLSTREAM (readcharfun), c);
306 #ifdef DEBUG_XEMACS /* testing Mule */
308 static int testing_mule = 0; /* Set this using debugger */
311 (c >= 0x20 && c <= 0x7E) ? "UU%c" :
312 ((c == '\n') ? "UU\\n\n" : "UU\\%o"), c);
316 else if (MARKERP (readcharfun))
317 set_marker_position (readcharfun, marker_position (readcharfun) - 1);
319 call1 (readcharfun, make_char (c));
322 static Lisp_Object read0 (Lisp_Object readcharfun);
323 static Lisp_Object read1 (Lisp_Object readcharfun);
324 /* allow_dotted_lists means that something like (foo bar . baz)
325 is acceptable. If -1, means check for starting with defun
326 and make structure pure. (not implemented, probably for very
330 If check_for_doc_references, look for (#$ . INT) doc references
331 in the list and record if load_force_doc_strings is non-zero.
332 (Such doc references will be destroyed during the loadup phase
333 by replacing with Qzero, because Snarf-documentation will fill
336 WARNING: If you set this, you sure as hell better not call
337 free_list() on the returned list here. */
339 static Lisp_Object read_list (Lisp_Object readcharfun,
341 int allow_dotted_lists,
342 int check_for_doc_references);
344 static void readevalloop (Lisp_Object readcharfun,
345 Lisp_Object sourcefile,
346 Lisp_Object (*evalfun) (Lisp_Object),
350 load_unwind (Lisp_Object stream) /* used as unwind-protect function in load */
352 Lstream_close (XLSTREAM (stream));
353 if (--load_in_progress < 0)
354 load_in_progress = 0;
359 load_descriptor_unwind (Lisp_Object oldlist)
361 Vload_descriptor_list = oldlist;
366 load_file_name_internal_unwind (Lisp_Object oldval)
368 Vload_file_name_internal = oldval;
373 load_file_name_internal_the_purecopy_unwind (Lisp_Object oldval)
375 Vload_file_name_internal_the_purecopy = oldval;
380 load_byte_code_version_unwind (Lisp_Object oldval)
382 load_byte_code_version = XINT (oldval);
386 /* The plague is coming.
388 Ring around the rosy, pocket full of posy,
389 Ashes ashes, they all fall down.
392 ebolify_bytecode_constants (Lisp_Object vector)
394 int len = XVECTOR_LENGTH (vector);
397 for (i = 0; i < len; i++)
399 Lisp_Object el = XVECTOR_DATA (vector)[i];
401 /* We don't check for `eq', `equal', and the others that have
402 bytecode opcodes. This might lose if someone passes #'eq or
403 something to `funcall', but who would really do that? As
404 they say in law, we've made a "good-faith effort" to
405 unfuckify ourselves. And doing it this way avoids screwing
406 up args to `make-hash-table' and such. As it is, we have to
407 add an extra Ebola check in decode_weak_list_type(). --ben */
408 if (EQ (el, Qassoc)) el = Qold_assoc;
409 else if (EQ (el, Qdelq)) el = Qold_delq;
411 /* I think this is a bad idea because it will probably mess
413 else if (EQ (el, Qdelete)) el = Qold_delete;
415 else if (EQ (el, Qrassq)) el = Qold_rassq;
416 else if (EQ (el, Qrassoc)) el = Qold_rassoc;
418 XVECTOR_DATA (vector)[i] = el;
423 pas_de_lache_ici (int fd, Lisp_Object victim)
428 if (!INTP (XCDR (victim)))
429 signal_simple_error ("Bogus doc string reference", victim);
430 pos = XINT (XCDR (victim));
432 pos = -pos; /* kludge to mark a user variable */
433 tem = unparesseuxify_doc_string (fd, pos, 0, Vload_file_name_internal);
435 signal_error (Qerror, tem);
440 load_force_doc_string_unwind (Lisp_Object oldlist)
443 Lisp_Object list = Vload_force_doc_string_list;
445 int fd = XINT (XCAR (Vload_descriptor_list));
446 /* NOTE: If purify_flag is true, we're in-place modifying objects that
447 may be in purespace (and if not, they will be). Therefore, we have
448 to be VERY careful to make sure that all objects that we create
449 are purecopied -- objects in purespace are not marked for GC, and
450 if we leave any impure objects inside of pure ones, we're really
454 /* restore the old value first just in case an error occurs. */
455 Vload_force_doc_string_list = oldlist;
457 LIST_LOOP (tail, list)
459 Lisp_Object john = Fcar (tail);
462 assert (CONSP (XCAR (john)));
463 assert (!purify_flag); /* should have been handled in read_list() */
464 XCAR (john) = pas_de_lache_ici (fd, XCAR (john));
470 assert (COMPILED_FUNCTIONP (john));
471 if (CONSP (XCOMPILED_FUNCTION (john)->instructions))
473 struct gcpro ngcpro1;
474 Lisp_Object juan = (pas_de_lache_ici
475 (fd, XCOMPILED_FUNCTION (john)->instructions));
481 signal_simple_error ("invalid lazy-loaded byte code", ivan);
482 /* Remember to purecopy; see above. */
483 XCOMPILED_FUNCTION (john)->instructions = Fpurecopy (XCAR (ivan));
484 /* v18 or v19 bytecode file. Need to Ebolify. */
485 if (XCOMPILED_FUNCTION (john)->flags.ebolified
486 && VECTORP (XCDR (ivan)))
487 ebolify_bytecode_constants (XCDR (ivan));
488 XCOMPILED_FUNCTION (john)->constants = Fpurecopy (XCDR (ivan));
491 doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
494 assert (!purify_flag); /* should have been handled in
495 read_compiled_function() */
496 doc = pas_de_lache_ici (fd, doc);
497 set_compiled_function_documentation (XCOMPILED_FUNCTION (john),
510 /* Close all descriptors in use for Fload_internal.
511 This is used when starting a subprocess. */
514 close_load_descs (void)
517 LIST_LOOP (tail, Vload_descriptor_list)
518 close (XINT (XCAR (tail)));
522 Lisp_Object Vfile_domain;
525 restore_file_domain (Lisp_Object val)
532 DEFUN ("load-internal", Fload_internal, 1, 6, 0, /*
533 Execute a file of Lisp code named FILE; no coding-system frobbing.
534 This function is identical to `load' except for the handling of the
535 CODESYS and USED-CODESYS arguments under XEmacs/Mule. (When Mule
536 support is not present, both functions are identical and ignore the
537 CODESYS and USED-CODESYS arguments.)
539 If support for Mule exists in this Emacs, the file is decoded
540 according to CODESYS; if omitted, no conversion happens. If
541 USED-CODESYS is non-nil, it should be a symbol, and the actual coding
542 system that was used for the decoding is stored into it. It will in
543 general be different from CODESYS if CODESYS specifies automatic
544 encoding detection or end-of-line detection.
546 (file, no_error, nomessage, nosuffix, codesys, used_codesys))
548 /* This function can GC */
550 int speccount = specpdl_depth ();
552 Lisp_Object newer = Qnil;
553 Lisp_Object handler = Qnil;
554 Lisp_Object found = Qnil;
555 struct gcpro gcpro1, gcpro2, gcpro3;
557 int message_p = NILP (nomessage);
558 /*#ifdef DEBUG_XEMACS*/
559 static Lisp_Object last_file_loaded;
562 GCPRO3 (file, newer, found);
566 /*#ifdef DEBUG_XEMACS*/
567 if (purify_flag && noninteractive)
570 last_file_loaded = file;
572 /*#endif / * DEBUG_XEMACS */
574 /* If file name is magic, call the handler. */
575 handler = Ffind_file_name_handler (file, Qload);
577 RETURN_UNGCPRO (call5 (handler, Qload, file, no_error,
578 nomessage, nosuffix));
580 /* Do this after the handler to avoid
581 the need to gcpro noerror, nomessage and nosuffix.
582 (Below here, we care only whether they are nil or not.) */
583 file = Fsubstitute_in_file_name (file);
585 if (!NILP (used_codesys))
586 CHECK_SYMBOL (used_codesys);
589 /* Avoid weird lossage with null string as arg,
590 since it would try to load a directory as a Lisp file.
592 if (XSTRING_LENGTH (file) > 0)
597 fd = locate_file (Vload_path, file,
598 ((!NILP (nosuffix)) ? Qnil :
599 build_string (load_ignore_elc_files ? ".el:" :
607 signal_file_error ("Cannot open load file", file);
615 foundstr = (char *) alloca (XSTRING_LENGTH (found) + 1);
616 strcpy (foundstr, (char *) XSTRING_DATA (found));
617 foundlen = strlen (foundstr);
619 /* The omniscient JWZ thinks this is worthless, but I beg to
621 if (load_ignore_elc_files)
623 newer = Ffile_name_nondirectory (found);
625 else if (load_warn_when_source_newer &&
626 !memcmp (".elc", foundstr + foundlen - 4, 4))
628 if (! fstat (fd, &s1)) /* can't fail, right? */
631 /* temporarily hack the 'c' off the end of the filename */
632 foundstr[foundlen - 1] = '\0';
633 result = stat (foundstr, &s2);
635 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
637 Lisp_Object newer_name = make_string ((Bufbyte *) foundstr,
639 struct gcpro nngcpro1;
640 NNGCPRO1 (newer_name);
641 newer = Ffile_name_nondirectory (newer_name);
644 /* put the 'c' back on (kludge-o-rama) */
645 foundstr[foundlen - 1] = 'c';
648 else if (load_warn_when_source_only &&
649 /* `found' ends in ".el" */
650 !memcmp (".el", foundstr + foundlen - 3, 3) &&
651 /* `file' does not end in ".el" */
653 XSTRING_DATA (file) + XSTRING_LENGTH (file) - 3,
659 if (!memcmp (".elc", foundstr + foundlen - 4, 4))
663 #define PRINT_LOADING_MESSAGE(done) do { \
664 if (load_ignore_elc_files) \
667 message ("Loading %s..." done, XSTRING_DATA (newer)); \
669 else if (!NILP (newer)) \
670 message ("Loading %s..." done " (file %s is newer)", \
671 XSTRING_DATA (file), \
672 XSTRING_DATA (newer)); \
673 else if (source_only) \
674 message ("Loading %s..." done " (file %s.elc does not exist)", \
675 XSTRING_DATA (file), \
676 XSTRING_DATA (Ffile_name_nondirectory (file))); \
677 else if (message_p) \
678 message ("Loading %s..." done, XSTRING_DATA (file)); \
681 PRINT_LOADING_MESSAGE ("");
684 /* Lisp_Object's must be malloc'ed, not stack-allocated */
685 Lisp_Object lispstream = Qnil;
686 CONST int block_size = 8192;
687 struct gcpro ngcpro1;
689 NGCPRO1 (lispstream);
690 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
691 /* 64K is used for normal files; 8K should be OK here because Lisp
692 files aren't really all that big. */
693 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
696 lispstream = make_decoding_input_stream
697 (XLSTREAM (lispstream), Fget_coding_system (codesys));
698 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
701 /* NOTE: Order of these is very important. Don't rearrange them. */
702 record_unwind_protect (load_unwind, lispstream);
703 record_unwind_protect (load_descriptor_unwind, Vload_descriptor_list);
704 record_unwind_protect (load_file_name_internal_unwind,
705 Vload_file_name_internal);
706 record_unwind_protect (load_file_name_internal_the_purecopy_unwind,
707 Vload_file_name_internal_the_purecopy);
708 record_unwind_protect (load_force_doc_string_unwind,
709 Vload_force_doc_string_list);
710 Vload_file_name_internal = found;
711 Vload_file_name_internal_the_purecopy = Qnil;
712 specbind (Qload_file_name, found);
713 Vload_descriptor_list = Fcons (make_int (fd), Vload_descriptor_list);
714 Vload_force_doc_string_list = Qnil;
716 record_unwind_protect (restore_file_domain, Vfile_domain);
717 Vfile_domain = Qnil; /* set it to nil; a call to #'domain will set it. */
721 /* Now determine what sort of ELC file we're reading in. */
722 record_unwind_protect (load_byte_code_version_unwind,
723 make_int (load_byte_code_version));
729 num_read = Lstream_read (XLSTREAM (lispstream), elc_header, 8);
731 || strncmp (elc_header, ";ELC", 4))
733 /* Huh? Probably not a valid ELC file. */
734 load_byte_code_version = 100; /* no Ebolification needed */
735 Lstream_unread (XLSTREAM (lispstream), elc_header, num_read);
738 load_byte_code_version = elc_header[4];
741 load_byte_code_version = 100; /* no Ebolification needed */
743 readevalloop (lispstream, file, Feval, 0);
745 if (!NILP (used_codesys))
748 (decoding_stream_coding_system (XLSTREAM (lispstream))));
750 unbind_to (speccount, Qnil);
757 /* #### Disgusting kludge */
758 /* Run any load-hooks for this file. */
759 /* #### An even more disgusting kludge. There is horrible code */
760 /* that is relying on the fact that dumped lisp files are found */
761 /* via `load-path' search. */
762 Lisp_Object name = file;
764 if (!NILP(Ffile_name_absolute_p(file)))
766 name = Ffile_name_nondirectory(file);
770 struct gcpro ngcpro1;
773 tem = Fassoc (name, Vafter_load_alist);
778 struct gcpro ngcpro1;
781 /* Use eval so that errors give a semi-meaningful backtrace. --Stig */
782 tem = Fcons (Qprogn, Fcdr (tem));
788 /*#ifdef DEBUG_XEMACS*/
789 if (purify_flag && noninteractive)
791 if (!EQ (last_file_loaded, file))
792 message ("Loading %s ...done", XSTRING_DATA (file));
794 /*#endif / * DEBUG_XEMACS */
797 PRINT_LOADING_MESSAGE ("done");
804 /* ------------------------------- */
806 /* ------------------------------- */
809 decode_mode_1 (Lisp_Object mode)
811 if (EQ (mode, Qexists))
813 else if (EQ (mode, Qexecutable))
815 else if (EQ (mode, Qwritable))
817 else if (EQ (mode, Qreadable))
819 else if (INTP (mode))
821 check_int_range (XINT (mode), 0, 7);
825 signal_simple_error ("Invalid value", mode);
826 return 0; /* unreached */
830 decode_mode (Lisp_Object mode)
834 else if (CONSP (mode))
838 EXTERNAL_LIST_LOOP (tail, mode)
839 mask |= decode_mode_1 (XCAR (tail));
843 return decode_mode_1 (mode);
846 DEFUN ("locate-file", Flocate_file, 2, 4, 0, /*
847 Search for FILENAME through PATH-LIST.
849 If SUFFIXES is non-nil, it should be a list of suffixes to append to
850 file name when searching.
852 If MODE is non-nil, it should be a symbol or a list of symbol representing
853 requirements. Allowed symbols are `exists', `executable', `writable', and
854 `readable'. If MODE is nil, it defaults to `readable'.
856 `locate-file' keeps hash tables of the directories it searches through,
857 in order to speed things up. It tries valiantly to not get confused in
858 the face of a changing and unpredictable environment, but can occasionally
859 get tripped up. In this case, you will have to call
860 `locate-file-clear-hashing' to get it back on track. See that function
863 (filename, path_list, suffixes, mode))
865 /* This function can GC */
868 CHECK_STRING (filename);
870 if (LISTP (suffixes))
873 EXTERNAL_LIST_LOOP (tail, suffixes)
874 CHECK_STRING (XCAR (tail));
877 CHECK_STRING (suffixes);
879 locate_file (path_list, filename, suffixes, &tp, decode_mode (mode));
883 /* Recalculate the hash table for the given string. DIRECTORY should
884 better have been through Fexpand_file_name() by now. */
887 locate_file_refresh_hashing (Lisp_Object directory)
890 make_directory_hash_table ((char *) XSTRING_DATA (directory));
893 Fputhash (directory, hash, Vlocate_file_hash_table);
897 /* find the hash table for the given directory, recalculating if necessary */
900 locate_file_find_directory_hash_table (Lisp_Object directory)
902 Lisp_Object hash = Fgethash (directory, Vlocate_file_hash_table, Qnil);
904 return locate_file_refresh_hashing (directory);
909 /* The SUFFIXES argument in any of the locate_file* functions can be
910 nil, a list, or a string (for backward compatibility), with the
913 a) nil - no suffix, just search for file name intact (semantically
914 different from "empty suffix list")
915 b) list - list of suffixes to append to file name. Each of these
917 c) string - colon-separated suffixes to append to file name (backward
920 All of this got hairy, so I decided to use write a mapper. Calling
921 a function for each suffix shouldn't slow things down, since
922 locate_file is rarely call with enough suffixes for it to make a
925 /* Map FUN over SUFFIXES, as described above. FUN will be called with a
926 char * containing the current file name, and ARG. Mapping stops when
927 FUN returns non-zero. */
929 locate_file_map_suffixes (Lisp_Object filename, Lisp_Object suffixes,
930 int (*fun) (char *, void *),
933 /* This function can GC */
937 /* Calculate maximum size of any filename made from
938 this path element/specified file name and any possible suffix. */
939 if (CONSP (suffixes))
941 /* We must traverse the list, so why not do it right. */
944 LIST_LOOP (tail, suffixes)
946 if (XSTRING_LENGTH (XCAR (tail)) > max)
947 max = XSTRING_LENGTH (XCAR (tail));
950 else if (NILP (suffixes))
953 /* Just take the easy way out */
954 max = XSTRING_LENGTH (suffixes);
956 fn_len = XSTRING_LENGTH (filename);
957 fn = (char *) alloca (max + fn_len + 1);
958 memcpy (fn, (char *) XSTRING_DATA (filename), fn_len);
960 /* Loop over suffixes. */
961 if (!STRINGP (suffixes))
965 /* Case a) discussed in the comment above. */
967 if ((*fun) (fn, arg))
974 LIST_LOOP (tail, suffixes)
976 memcpy (fn + fn_len, XSTRING_DATA (XCAR (tail)),
977 XSTRING_LENGTH (XCAR (tail)));
978 fn[fn_len + XSTRING_LENGTH (XCAR (tail))] = 0;
979 if ((*fun) (fn, arg))
987 CONST char *nsuffix = XSTRING_DATA (suffixes);
991 char *esuffix = (char *) strchr (nsuffix, ':');
992 int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
994 /* Concatenate path element/specified name with the suffix. */
995 strncpy (fn + fn_len, nsuffix, lsuffix);
996 fn[fn_len + lsuffix] = 0;
998 if ((*fun) (fn, arg))
1001 /* Advance to next suffix. */
1004 nsuffix += lsuffix + 1;
1009 struct locate_file_in_directory_mapper_closure {
1011 Lisp_Object *storeptr;
1016 locate_file_in_directory_mapper (char *fn, void *arg)
1018 struct locate_file_in_directory_mapper_closure *closure =
1019 (struct locate_file_in_directory_mapper_closure *)arg;
1022 /* Ignore file if it's a directory. */
1023 if (stat (fn, &st) >= 0
1024 && (st.st_mode & S_IFMT) != S_IFDIR)
1026 /* Check that we can access or open it. */
1027 if (closure->mode >= 0)
1028 closure->fd = access (fn, closure->mode);
1030 closure->fd = open (fn, O_RDONLY | OPEN_BINARY, 0);
1032 if (closure->fd >= 0)
1034 /* We succeeded; return this descriptor and filename. */
1035 if (closure->storeptr)
1036 *closure->storeptr = build_string (fn);
1039 /* If we actually opened the file, set close-on-exec flag
1040 on the new descriptor so that subprocesses can't whack
1042 if (closure->mode < 0)
1043 (void) fcntl (closure->fd, F_SETFD, FD_CLOEXEC);
1054 /* look for STR in PATH, optionally adding SUFFIXES. DIRECTORY need
1055 not have been expanded. */
1058 locate_file_in_directory (Lisp_Object directory, Lisp_Object str,
1059 Lisp_Object suffixes, Lisp_Object *storeptr,
1062 /* This function can GC */
1063 struct locate_file_in_directory_mapper_closure closure;
1064 Lisp_Object filename = Qnil;
1065 struct gcpro gcpro1, gcpro2, gcpro3;
1067 GCPRO3 (directory, str, filename);
1069 filename = Fexpand_file_name (str, directory);
1070 if (NILP (filename) || NILP (Ffile_name_absolute_p (filename)))
1071 /* If there are non-absolute elts in PATH (eg ".") */
1072 /* Of course, this could conceivably lose if luser sets
1073 default-directory to be something non-absolute ... */
1075 if (NILP (filename))
1076 /* NIL means current directory */
1077 filename = current_buffer->directory;
1079 filename = Fexpand_file_name (filename,
1080 current_buffer->directory);
1081 if (NILP (Ffile_name_absolute_p (filename)))
1083 /* Give up on this directory! */
1090 closure.storeptr = storeptr;
1091 closure.mode = mode;
1093 locate_file_map_suffixes (filename, suffixes, locate_file_in_directory_mapper,
1100 /* do the same as locate_file() but don't use any hash tables. */
1103 locate_file_without_hash (Lisp_Object path, Lisp_Object str,
1104 Lisp_Object suffixes, Lisp_Object *storeptr,
1107 /* This function can GC */
1108 int absolute = !NILP (Ffile_name_absolute_p (str));
1110 EXTERNAL_LIST_LOOP (path, path)
1112 int val = locate_file_in_directory (XCAR (path), str, suffixes, storeptr,
1123 locate_file_construct_suffixed_files_mapper (char *fn, void *arg)
1125 Lisp_Object *tail = (Lisp_Object *)arg;
1126 *tail = Fcons (build_string (fn), *tail);
1130 /* Construct a list of all files to search for.
1131 It makes sense to have this despite locate_file_map_suffixes()
1132 because we need Lisp strings to access the hash-table, and it would
1133 be inefficient to create them on the fly, again and again for each
1134 path component. See locate_file(). */
1137 locate_file_construct_suffixed_files (Lisp_Object filename,
1138 Lisp_Object suffixes)
1140 Lisp_Object tail = Qnil;
1141 struct gcpro gcpro1;
1144 locate_file_map_suffixes (filename, suffixes,
1145 locate_file_construct_suffixed_files_mapper,
1149 return Fnreverse (tail);
1152 DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
1153 Clear the hash records for the specified list of directories.
1154 `locate-file' uses a hashing scheme to speed lookup, and will correctly
1155 track the following environmental changes:
1157 -- changes of any sort to the list of directories to be searched.
1158 -- addition and deletion of non-shadowing files (see below) from the
1159 directories in the list.
1160 -- byte-compilation of a .el file into a .elc file.
1162 `locate-file' will primarily get confused if you add a file that shadows
1163 \(i.e. has the same name as) another file further down in the directory list.
1164 In this case, you must call `locate-file-clear-hashing'.
1166 If PATH is t, it means to fully clear all the accumulated hashes. This
1167 can be used if the internal tables grow too large, or when dumping.
1172 Fclrhash (Vlocate_file_hash_table);
1175 Lisp_Object pathtail;
1176 EXTERNAL_LIST_LOOP (pathtail, path)
1178 Lisp_Object pathel = Fexpand_file_name (XCAR (pathtail), Qnil);
1179 Fremhash (pathel, Vlocate_file_hash_table);
1185 /* Search for a file whose name is STR, looking in directories
1186 in the Lisp list PATH, and trying suffixes from SUFFIXES.
1187 SUFFIXES is a list of possible suffixes, or (for backward
1188 compatibility) a string containing possible suffixes separated by
1190 On success, returns a file descriptor. On failure, returns -1.
1192 MODE nonnegative means don't open the files,
1193 just look for one for which access(file,MODE) succeeds. In this case,
1194 returns 1 on success.
1196 If STOREPTR is nonzero, it points to a slot where the name of
1197 the file actually found should be stored as a Lisp string.
1198 Nil is stored there on failure.
1200 Called openp() in FSFmacs. */
1203 locate_file (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1204 Lisp_Object *storeptr, int mode)
1206 /* This function can GC */
1207 Lisp_Object suffixtab = Qnil;
1208 Lisp_Object pathtail, pathel_expanded;
1210 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1215 /* Is it really necessary to gcpro path and str? It shouldn't be
1216 unless some caller has fucked up. There are known instances that
1217 call us with build_string("foo:bar") as SUFFIXES, though. */
1218 GCPRO4 (path, str, suffixes, suffixtab);
1220 /* if this filename has directory components, it's too complicated
1221 to try and use the hash tables. */
1222 if (!NILP (Ffile_name_directory (str)))
1224 val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
1229 suffixtab = locate_file_construct_suffixed_files (str, suffixes);
1231 EXTERNAL_LIST_LOOP (pathtail, path)
1233 Lisp_Object pathel = XCAR (pathtail);
1234 Lisp_Object hash_table;
1238 /* If this path element is relative, we have to look by hand. */
1239 if (NILP (Ffile_name_absolute_p (pathel)))
1241 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
1251 pathel_expanded = Fexpand_file_name (pathel, Qnil);
1252 hash_table = locate_file_find_directory_hash_table (pathel_expanded);
1254 if (!NILP (hash_table))
1256 /* Loop over suffixes. */
1257 LIST_LOOP (tail, suffixtab)
1258 if (!NILP (Fgethash (XCAR (tail), hash_table, Qnil)))
1267 /* This is a likely candidate. Look by hand in this directory
1268 so we don't get thrown off if someone byte-compiles a file. */
1269 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
1277 /* Hmm ... the file isn't actually there. (Or possibly it's
1278 a directory ...) So refresh our hashing. */
1279 locate_file_refresh_hashing (pathel_expanded);
1283 /* File is probably not there, but check the hard way just in case. */
1284 val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
1287 /* Sneaky user added a file without telling us. */
1288 Flocate_file_clear_hashing (path);
1298 /* Merge the list we've accumulated of globals from the current input source
1299 into the load_history variable. The details depend on whether
1300 the source has an associated file name or not. */
1303 build_load_history (int loading, Lisp_Object source)
1305 REGISTER Lisp_Object tail, prev, newelt;
1306 REGISTER Lisp_Object tem, tem2;
1309 #if !defined(LOADHIST_DUMPED)
1310 /* Don't bother recording anything for preloaded files. */
1315 tail = Vload_history;
1318 while (!NILP (tail))
1322 /* Find the feature's previous assoc list... */
1323 if (internal_equal (source, Fcar (tem), 0))
1327 /* If we're loading, remove it. */
1331 Vload_history = Fcdr (tail);
1333 Fsetcdr (prev, Fcdr (tail));
1336 /* Otherwise, cons on new symbols that are not already members. */
1339 tem2 = Vcurrent_load_list;
1341 while (CONSP (tem2))
1343 newelt = XCAR (tem2);
1345 if (NILP (Fmemq (newelt, tem)))
1346 Fsetcar (tail, Fcons (Fcar (tem),
1347 Fcons (newelt, Fcdr (tem))));
1360 /* If we're loading, cons the new assoc onto the front of load-history,
1361 the most-recently-loaded position. Also do this if we didn't find
1362 an existing member for the current source. */
1363 if (loading || !foundit)
1364 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
1368 #else /* !LOADHIST */
1369 #define build_load_history(x,y)
1370 #endif /* !LOADHIST */
1373 #if 0 /* FSFmacs defun hack */
1375 unreadpure (void) /* Used as unwind-protect function in readevalloop */
1383 readevalloop (Lisp_Object readcharfun,
1384 Lisp_Object sourcename,
1385 Lisp_Object (*evalfun) (Lisp_Object),
1388 /* This function can GC */
1390 REGISTER Lisp_Object val = Qnil;
1391 int speccount = specpdl_depth ();
1392 struct gcpro gcpro1, gcpro2;
1393 struct buffer *b = 0;
1395 if (BUFFERP (readcharfun))
1396 b = XBUFFER (readcharfun);
1397 else if (MARKERP (readcharfun))
1398 b = XMARKER (readcharfun)->buffer;
1400 /* Don't do this. It is not necessary, and it needlessly exposes
1401 READCHARFUN (which can be a stream) to Lisp. --hniksic */
1402 /*specbind (Qstandard_input, readcharfun);*/
1404 specbind (Qcurrent_load_list, Qnil);
1406 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1407 Vcurrent_compiled_function_annotation = Qnil;
1409 GCPRO2 (val, sourcename);
1411 LOADHIST_ATTACH (sourcename);
1417 if (b != 0 && !BUFFER_LIVE_P (b))
1418 error ("Reading from killed buffer");
1420 c = readchar (readcharfun);
1424 while ((c = readchar (readcharfun)) != '\n' && c != -1)
1431 /* Ignore whitespace here, so we can detect eof. */
1432 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
1435 #if 0 /* FSFmacs defun hack */
1436 if (purify_flag && c == '(')
1438 int count1 = specpdl_depth ();
1439 record_unwind_protect (unreadpure, Qnil);
1440 val = read_list (readcharfun, ')', -1, 1);
1441 unbind_to (count1, Qnil);
1444 #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
1446 unreadchar (readcharfun, c);
1447 Vread_objects = Qnil;
1448 if (NILP (Vload_read_function))
1449 val = read0 (readcharfun);
1451 val = call1 (Vload_read_function, readcharfun);
1454 val = (*evalfun) (val);
1457 Vvalues = Fcons (val, Vvalues);
1458 if (EQ (Vstandard_output, Qt))
1465 build_load_history (LSTREAMP (readcharfun) ||
1466 /* This looks weird, but it's what's in FSFmacs */
1467 (b ? BUF_NARROWED (b) : BUF_NARROWED (current_buffer)),
1471 unbind_to (speccount, Qnil);
1474 DEFUN ("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /*
1475 Execute BUFFER as Lisp code.
1476 Programs can pass two arguments, BUFFER and PRINTFLAG.
1477 BUFFER is the buffer to evaluate (nil means use current buffer).
1478 PRINTFLAG controls printing of output:
1479 nil means discard it; anything else is stream for print.
1481 If there is no error, point does not move. If there is an error,
1482 point remains at the end of the last character read from the buffer.
1483 Execute BUFFER as Lisp code.
1485 (bufname, printflag))
1487 /* This function can GC */
1488 int speccount = specpdl_depth ();
1489 Lisp_Object tem, buf;
1492 buf = Fcurrent_buffer ();
1494 buf = Fget_buffer (bufname);
1496 error ("No such buffer.");
1498 if (NILP (printflag))
1499 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1502 specbind (Qstandard_output, tem);
1503 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1504 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
1505 readevalloop (buf, XBUFFER (buf)->filename, Feval,
1508 return unbind_to (speccount, Qnil);
1512 xxDEFUN ("eval-current-buffer", Feval_current_buffer, 0, 1, "", /*
1513 Execute the current buffer as Lisp code.
1514 Programs can pass argument PRINTFLAG which controls printing of output:
1515 nil means discard it; anything else is stream for print.
1517 If there is no error, point does not move. If there is an error,
1518 point remains at the end of the last character read from the buffer.
1526 DEFUN ("eval-region", Feval_region, 2, 3, "r", /*
1527 Execute the region as Lisp code.
1528 When called from programs, expects two arguments,
1529 giving starting and ending indices in the current buffer
1530 of the text to be executed.
1531 Programs can pass third argument PRINTFLAG which controls output:
1532 nil means discard it; anything else is stream for printing it.
1534 If there is no error, point does not move. If there is an error,
1535 point remains at the end of the last character read from the buffer.
1537 Note: Before evaling the region, this function narrows the buffer to it.
1538 If the code being eval'd should happen to trigger a redisplay you may
1539 see some text temporarily disappear because of this.
1543 /* This function can GC */
1544 int speccount = specpdl_depth ();
1546 Lisp_Object cbuf = Fcurrent_buffer ();
1548 if (NILP (printflag))
1549 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1552 specbind (Qstandard_output, tem);
1554 if (NILP (printflag))
1555 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1556 record_unwind_protect (save_restriction_restore, save_restriction_save ());
1558 /* This both uses b and checks its type. */
1559 Fgoto_char (b, cbuf);
1560 Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), e, cbuf);
1561 readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,
1564 return unbind_to (speccount, Qnil);
1567 DEFUN ("read", Fread, 0, 1, 0, /*
1568 Read one Lisp expression as text from STREAM, return as Lisp object.
1569 If STREAM is nil, use the value of `standard-input' (which see).
1570 STREAM or the value of `standard-input' may be:
1571 a buffer (read from point and advance it)
1572 a marker (read from where it points and advance it)
1573 a function (call it with no arguments for each character,
1574 call it with a char as argument to push a char back)
1575 a string (takes text from string, starting at the beginning)
1576 t (read text line using minibuffer and use it).
1581 stream = Vstandard_input;
1582 if (EQ (stream, Qt))
1583 stream = Qread_char;
1585 Vread_objects = Qnil;
1587 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1588 Vcurrent_compiled_function_annotation = Qnil;
1590 if (EQ (stream, Qread_char))
1592 Lisp_Object val = call1 (Qread_from_minibuffer,
1593 build_translated_string ("Lisp expression: "));
1594 return Fcar (Fread_from_string (val, Qnil, Qnil));
1597 if (STRINGP (stream))
1598 return Fcar (Fread_from_string (stream, Qnil, Qnil));
1600 return read0 (stream);
1603 DEFUN ("read-from-string", Fread_from_string, 1, 3, 0, /*
1604 Read one Lisp expression which is represented as text by STRING.
1605 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1606 START and END optionally delimit a substring of STRING from which to read;
1607 they default to 0 and (length STRING) respectively.
1609 (string, start, end))
1611 Bytecount startval, endval;
1613 Lisp_Object lispstream = Qnil;
1614 struct gcpro gcpro1;
1616 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1617 Vcurrent_compiled_function_annotation = Qnil;
1619 GCPRO1 (lispstream);
1620 CHECK_STRING (string);
1621 get_string_range_byte (string, start, end, &startval, &endval,
1622 GB_HISTORICAL_STRING_BEHAVIOR);
1623 lispstream = make_lisp_string_input_stream (string, startval,
1626 Vread_objects = Qnil;
1628 tem = read0 (lispstream);
1629 /* Yeah, it's ugly. Gonna make something of it?
1630 At least our reader is reentrant ... */
1632 (Fcons (tem, make_int
1633 (bytecount_to_charcount
1634 (XSTRING_DATA (string),
1635 startval + Lstream_byte_count (XLSTREAM (lispstream))))));
1636 Lstream_delete (XLSTREAM (lispstream));
1642 #ifdef LISP_BACKQUOTES
1645 backquote_unwind (Lisp_Object ptr)
1646 { /* used as unwind-protect function in read0() */
1647 int *counter = (int *) get_opaque_ptr (ptr);
1650 free_opaque_ptr (ptr);
1656 /* Use this for recursive reads, in contexts where internal tokens
1657 are not allowed. See also read1(). */
1659 read0 (Lisp_Object readcharfun)
1661 Lisp_Object val = read1 (readcharfun);
1663 if (CONSP (val) && UNBOUNDP (XCAR (val)))
1665 Emchar c = XCHAR (XCDR (val));
1666 free_cons (XCONS (val));
1667 return Fsignal (Qinvalid_read_syntax,
1668 list1 (Fchar_to_string (make_char (c))));
1675 read_escape (Lisp_Object readcharfun)
1677 /* This function can GC */
1678 Emchar c = readchar (readcharfun);
1681 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1685 case 'a': return '\007';
1686 case 'b': return '\b';
1687 case 'd': return 0177;
1688 case 'e': return 033;
1689 case 'f': return '\f';
1690 case 'n': return '\n';
1691 case 'r': return '\r';
1692 case 't': return '\t';
1693 case 'v': return '\v';
1694 case '\n': return -1;
1697 c = readchar (readcharfun);
1699 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1701 error ("Invalid escape character syntax");
1702 c = readchar (readcharfun);
1704 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1706 c = read_escape (readcharfun);
1709 /* Originally, FSF_KEYS provided a degree of FSF Emacs
1710 compatibility by defining character "modifiers" alt, super,
1711 hyper and shift to infest the characters (i.e. integers).
1713 However, this doesn't cut it for XEmacs 20, which
1714 distinguishes characters from integers. Without Mule, ?\H-a
1715 simply returns ?a because every character is clipped into
1716 0-255. Under Mule it is much worse -- ?\H-a with FSF_KEYS
1717 produces an illegal character, and moves us to crash-land.
1719 For these reasons, FSF_KEYS hack is useless and without hope
1720 of ever working under XEmacs 20. */
1724 #define alt_modifier (0x040000)
1725 #define super_modifier (0x080000)
1726 #define hyper_modifier (0x100000)
1727 #define shift_modifier (0x200000)
1728 /* fsf uses a different modifiers for meta and control. Possibly
1729 byte_compiled code will still work fsfmacs, though... --Stig
1731 #define ctl_modifier (0x400000)
1732 #define meta_modifier (0x800000)
1734 #define FSF_LOSSAGE(mask) \
1735 if (fail_on_bucky_bit_character_escapes || \
1736 ((c = readchar (readcharfun)) != '-')) \
1737 error ("Invalid escape character syntax"); \
1738 c = readchar (readcharfun); \
1740 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun))); \
1742 c = read_escape (readcharfun); \
1745 case 'S': FSF_LOSSAGE (shift_modifier);
1746 case 'H': FSF_LOSSAGE (hyper_modifier);
1747 case 'A': FSF_LOSSAGE (alt_modifier);
1748 case 's': FSF_LOSSAGE (super_modifier);
1750 #undef super_modifier
1751 #undef hyper_modifier
1752 #undef shift_modifier
1755 #endif /* FSF_KEYS */
1758 c = readchar (readcharfun);
1760 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1762 error ("Invalid escape character syntax");
1764 c = readchar (readcharfun);
1766 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1768 c = read_escape (readcharfun);
1769 /* FSFmacs junk for non-ASCII controls.
1774 return c & (0200 | 037);
1784 /* An octal escape, as in ANSI C. */
1786 REGISTER Emchar i = c - '0';
1787 REGISTER int count = 0;
1790 if ((c = readchar (readcharfun)) >= '0' && c <= '7')
1791 i = (i << 3) + (c - '0');
1794 unreadchar (readcharfun, c);
1802 /* A hex escape, as in ANSI C, except that we only allow latin-1
1803 characters to be read this way. What is "\x4e03" supposed to
1804 mean, anyways, if the internal representation is hidden?
1805 This is also consistent with the treatment of octal escapes. */
1807 REGISTER Emchar i = 0;
1808 REGISTER int count = 0;
1809 while (++count <= 2)
1811 c = readchar (readcharfun);
1812 /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
1813 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
1814 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
1815 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
1818 unreadchar (readcharfun, c);
1826 REGISTER Emchar i = 0;
1827 REGISTER int count = 0;
1828 while (++count <= 6)
1830 c = readchar (readcharfun);
1831 /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
1832 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
1833 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
1834 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
1837 unreadchar (readcharfun, c);
1845 /* #### need some way of reading an extended character with
1846 an escape sequence. */
1856 /* read symbol-constituent stuff into `Vread_buffer_stream'. */
1858 read_atom_0 (Lisp_Object readcharfun, Emchar firstchar, int *saw_a_backslash)
1860 /* This function can GC */
1861 Emchar c = ((firstchar) >= 0 ? firstchar : readchar (readcharfun));
1862 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
1864 *saw_a_backslash = 0;
1866 while (c > 040 /* #### - comma should be here as should backquote */
1867 && !(c == '\"' || c == '\'' || c == ';'
1868 || c == '(' || c == ')'
1869 #ifndef LISP_FLOAT_TYPE
1870 /* If we have floating-point support, then we need
1871 to allow <digits><dot><digits>. */
1873 #endif /* not LISP_FLOAT_TYPE */
1874 || c == '[' || c == ']' || c == '#'
1879 c = readchar (readcharfun);
1881 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1882 *saw_a_backslash = 1;
1884 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
1886 c = readchar (readcharfun);
1890 unreadchar (readcharfun, c);
1891 /* blasted terminating 0 */
1892 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), 0);
1893 Lstream_flush (XLSTREAM (Vread_buffer_stream));
1895 return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
1898 static Lisp_Object parse_integer (CONST Bufbyte *buf, Bytecount len, int base);
1901 read_atom (Lisp_Object readcharfun,
1903 int uninterned_symbol)
1905 /* This function can GC */
1906 int saw_a_backslash;
1907 Bytecount len = read_atom_0 (readcharfun, firstchar, &saw_a_backslash);
1908 char *read_ptr = (char *)
1909 resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream));
1911 /* Is it an integer? */
1912 if (! (saw_a_backslash || uninterned_symbol))
1914 /* If a token had any backslashes in it, it is disqualified from
1915 being an integer or a float. This means that 123\456 is a
1916 symbol, as is \123 (which is the way (intern "123") prints).
1917 Also, if token was preceded by #:, it's always a symbol.
1919 char *p = read_ptr + len;
1920 char *p1 = read_ptr;
1922 if (*p1 == '+' || *p1 == '-') p1++;
1927 while (p1 != p && (c = *p1) >= '0' && c <= '9')
1929 #ifdef LISP_FLOAT_TYPE
1930 /* Integers can have trailing decimal points. */
1931 if (p1 > read_ptr && p1 < p && *p1 == '.')
1936 /* It is an integer. */
1937 #ifdef LISP_FLOAT_TYPE
1944 if (sizeof (int) == sizeof (EMACS_INT))
1945 number = atoi (read_buffer);
1946 else if (sizeof (long) == sizeof (EMACS_INT))
1947 number = atol (read_buffer);
1950 return make_int (number);
1953 return parse_integer ((Bufbyte *) read_ptr, len, 10);
1957 #ifdef LISP_FLOAT_TYPE
1958 if (isfloat_string (read_ptr))
1959 return make_float (atof (read_ptr));
1965 if (uninterned_symbol)
1966 sym = Fmake_symbol ( make_string ((Bufbyte *) read_ptr, len));
1969 /* intern will purecopy pname if necessary */
1970 Lisp_Object name = make_string ((Bufbyte *) read_ptr, len);
1971 sym = Fintern (name, Qnil);
1979 parse_integer (CONST Bufbyte *buf, Bytecount len, int base)
1981 CONST Bufbyte *lim = buf + len;
1982 CONST Bufbyte *p = buf;
1984 int negativland = 0;
1999 for (; (p < lim) && (*p != '\0'); p++)
2006 else if (isupper (c))
2008 else if (islower (c))
2013 if (c < 0 || c >= base)
2017 num = num * base + c;
2023 EMACS_INT int_result = negativland ? - (EMACS_INT) num : (EMACS_INT) num;
2024 Lisp_Object result = make_int (int_result);
2025 if (num && ((XINT (result) < 0) != negativland))
2027 if (XINT (result) != int_result)
2032 return Fsignal (Qinvalid_read_syntax,
2033 list3 (build_translated_string
2034 ("Integer constant overflow in reader"),
2035 make_string (buf, len),
2038 return Fsignal (Qinvalid_read_syntax,
2039 list3 (build_translated_string
2040 ("Invalid integer constant in reader"),
2041 make_string (buf, len),
2047 read_integer (Lisp_Object readcharfun, int base)
2049 /* This function can GC */
2050 int saw_a_backslash;
2051 Bytecount len = read_atom_0 (readcharfun, -1, &saw_a_backslash);
2052 return (parse_integer
2053 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
2055 ? 0 /* make parse_integer signal error */
2061 read_bit_vector (Lisp_Object readcharfun)
2063 unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
2068 c = readchar (readcharfun);
2069 if (c != '0' && c != '1')
2071 Dynarr_add (dyn, (unsigned char) (c - '0'));
2075 unreadchar (readcharfun, c);
2077 return make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
2078 Dynarr_length (dyn));
2085 struct structure_type *
2086 define_structure_type (Lisp_Object type,
2087 int (*validate) (Lisp_Object data,
2088 Error_behavior errb),
2089 Lisp_Object (*instantiate) (Lisp_Object data))
2091 struct structure_type st;
2094 st.keywords = Dynarr_new (structure_keyword_entry);
2095 st.validate = validate;
2096 st.instantiate = instantiate;
2097 Dynarr_add (the_structure_type_dynarr, st);
2099 return Dynarr_atp (the_structure_type_dynarr,
2100 Dynarr_length (the_structure_type_dynarr) - 1);
2104 define_structure_type_keyword (struct structure_type *st, Lisp_Object keyword,
2105 int (*validate) (Lisp_Object keyword,
2107 Error_behavior errb))
2109 struct structure_keyword_entry en;
2111 en.keyword = keyword;
2112 en.validate = validate;
2113 Dynarr_add (st->keywords, en);
2116 static struct structure_type *
2117 recognized_structure_type (Lisp_Object type)
2121 for (i = 0; i < Dynarr_length (the_structure_type_dynarr); i++)
2123 struct structure_type *st = Dynarr_atp (the_structure_type_dynarr, i);
2124 if (EQ (st->type, type))
2132 read_structure (Lisp_Object readcharfun)
2134 Emchar c = readchar (readcharfun);
2135 Lisp_Object list = Qnil;
2136 Lisp_Object orig_list = Qnil;
2137 Lisp_Object already_seen = Qnil;
2139 struct structure_type *st;
2140 struct gcpro gcpro1, gcpro2;
2142 GCPRO2 (orig_list, already_seen);
2144 RETURN_UNGCPRO (continuable_syntax_error ("#s not followed by paren"));
2145 list = read_list (readcharfun, ')', 0, 0);
2148 int len = XINT (Flength (list));
2150 RETURN_UNGCPRO (continuable_syntax_error
2151 ("structure type not specified"));
2154 (continuable_syntax_error
2155 ("structures must have alternating keyword/value pairs"));
2158 st = recognized_structure_type (XCAR (list));
2160 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2161 list2 (build_translated_string
2162 ("unrecognized structure type"),
2166 keyword_count = Dynarr_length (st->keywords);
2167 while (!NILP (list))
2169 Lisp_Object keyword, value;
2171 struct structure_keyword_entry *en = NULL;
2173 keyword = Fcar (list);
2175 value = Fcar (list);
2178 if (!NILP (memq_no_quit (keyword, already_seen)))
2179 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2180 list2 (build_translated_string
2181 ("structure keyword already seen"),
2184 for (i = 0; i < keyword_count; i++)
2186 en = Dynarr_atp (st->keywords, i);
2187 if (EQ (keyword, en->keyword))
2191 if (i == keyword_count)
2192 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2193 list2 (build_translated_string
2194 ("unrecognized structure keyword"),
2197 if (en->validate && ! (en->validate) (keyword, value, ERROR_ME))
2199 (Fsignal (Qinvalid_read_syntax,
2200 list3 (build_translated_string
2201 ("invalid value for structure keyword"),
2204 already_seen = Fcons (keyword, already_seen);
2207 if (st->validate && ! (st->validate) (orig_list, ERROR_ME))
2208 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2209 list2 (build_translated_string
2210 ("invalid structure initializer"),
2213 RETURN_UNGCPRO ((st->instantiate) (XCDR (orig_list)));
2217 static Lisp_Object read_compiled_function (Lisp_Object readcharfun,
2219 static Lisp_Object read_vector (Lisp_Object readcharfun, int terminator);
2221 /* Get the next character; filter out whitespace and comments */
2224 reader_nextchar (Lisp_Object readcharfun)
2226 /* This function can GC */
2231 c = readchar (readcharfun);
2233 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2239 /* Ignore whitespace and control characters */
2248 while ((c = readchar (readcharfun)) >= 0 && c != '\n')
2257 list2_pure (int pure, Lisp_Object a, Lisp_Object b)
2259 return pure ? pure_cons (a, pure_cons (b, Qnil)) : list2 (a, b);
2263 /* Read the next Lisp object from the stream READCHARFUN and return it.
2264 If the return value is a cons whose car is Qunbound, then read1()
2265 encountered a misplaced token (e.g. a right bracket, right paren,
2266 or dot followed by a non-number). To filter this stuff out,
2270 read1 (Lisp_Object readcharfun)
2275 c = reader_nextchar (readcharfun);
2281 #ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
2282 /* if this is disabled, then other code in eval.c must be enabled */
2283 Emchar ch = reader_nextchar (readcharfun);
2289 int speccount = specpdl_depth ();
2290 ++old_backquote_flag;
2291 record_unwind_protect (backquote_unwind,
2292 make_opaque_ptr (&old_backquote_flag));
2293 tem = read0 (readcharfun);
2294 unbind_to (speccount, Qnil);
2295 ch = reader_nextchar (readcharfun);
2298 unreadchar (readcharfun, ch);
2299 return Fsignal (Qinvalid_read_syntax,
2301 ("Weird old-backquote syntax")));
2303 return list2 (Qbacktick, tem);
2307 if (old_backquote_flag)
2309 Lisp_Object tem, comma_type;
2310 ch = readchar (readcharfun);
2312 comma_type = Qcomma_at;
2316 unreadchar (readcharfun, ch);
2317 comma_type = Qcomma;
2319 tem = read0 (readcharfun);
2320 ch = reader_nextchar (readcharfun);
2323 unreadchar (readcharfun, ch);
2324 return Fsignal (Qinvalid_read_syntax,
2326 ("Weird old-backquote syntax")));
2328 return list2 (comma_type, tem);
2332 unreadchar (readcharfun, ch);
2334 return Fsignal (Qinvalid_read_syntax,
2335 list1 (build_string ("Comma outside of backquote")));
2337 /* #### - yuck....but this is reverse compatible. */
2338 /* mostly this is required by edebug, which does its own
2339 annotated reading. We need to have an annotated_read
2340 function that records (with markers) the buffer
2341 positions of the elements that make up lists, then that
2342 can be used in edebug and bytecomp and the check above
2343 can go back in. --Stig */
2349 unreadchar (readcharfun, ch);
2351 #endif /* old backquote crap... */
2352 return read_list (readcharfun, ')', 1, 1);
2355 return read_vector (readcharfun, ']');
2359 /* #### - huh? these don't do what they seem... */
2360 return noseeum_cons (Qunbound, make_char (c));
2363 #ifdef LISP_FLOAT_TYPE
2364 /* If a period is followed by a number, then we should read it
2365 as a floating point number. Otherwise, it denotes a dotted
2368 c = readchar (readcharfun);
2369 unreadchar (readcharfun, c);
2371 /* Can't use isdigit on Emchars */
2372 if (c < '0' || c > '9')
2373 return noseeum_cons (Qunbound, make_char ('.'));
2375 /* Note that read_atom will loop
2376 at least once, assuring that we will not try to UNREAD
2377 two characters in a row.
2378 (I think this doesn't matter anymore because there should
2379 be no more danger in unreading multiple characters) */
2380 return read_atom (readcharfun, '.', 0);
2382 #else /* ! LISP_FLOAT_TYPE */
2383 return noseeum_cons (Qunbound, make_char ('.'));
2384 #endif /* ! LISP_FLOAT_TYPE */
2389 c = readchar (readcharfun);
2392 #if 0 /* FSFmacs silly char-table syntax */
2395 #if 0 /* FSFmacs silly bool-vector syntax */
2398 /* "#["-- byte-code constant syntax */
2399 /* purecons #[...] syntax */
2400 case '[': return read_compiled_function (readcharfun, ']'
2401 /*, purify_flag */ );
2402 /* "#:"-- gensym syntax */
2403 case ':': return read_atom (readcharfun, -1, 1);
2404 /* #'x => (function x) */
2405 case '\'': return list2 (Qfunction, read0 (readcharfun));
2407 /* RMS uses this syntax for fat-strings.
2408 If we use it for vectors, then obscure bugs happen.
2410 /* "#(" -- Scheme/CL vector syntax */
2411 case '(': return read_vector (readcharfun, ')');
2417 struct gcpro gcpro1;
2419 /* Read the string itself. */
2420 tmp = read1 (readcharfun);
2423 if (CONSP (tmp) && UNBOUNDP (XCAR (tmp)))
2424 free_cons (XCONS (tmp));
2425 return Fsignal (Qinvalid_read_syntax,
2426 list1 (build_string ("#")));
2429 /* Read the intervals and their properties. */
2432 Lisp_Object beg, end, plist;
2436 beg = read1 (readcharfun);
2437 if (CONSP (beg) && UNBOUNDP (XCAR (beg)))
2439 ch = XCHAR (XCDR (beg));
2440 free_cons (XCONS (beg));
2448 end = read1 (readcharfun);
2449 if (CONSP (end) && UNBOUNDP (XCAR (end)))
2451 free_cons (XCONS (end));
2457 plist = read1 (readcharfun);
2458 if (CONSP (plist) && UNBOUNDP (XCAR (plist)))
2460 free_cons (XCONS (plist));
2466 (Fsignal (Qinvalid_read_syntax,
2468 (build_string ("invalid string property list"),
2470 Fset_text_properties (beg, end, plist, tmp);
2478 /* #@NUMBER is used to skip NUMBER following characters.
2479 That's used in .elc files to skip over doc strings
2480 and function definitions. */
2483 /* Read a decimal integer. */
2484 while ((c = readchar (readcharfun)) >= 0
2485 && c >= '0' && c <= '9')
2486 nskip = (10 * nskip) + (c - '0');
2488 unreadchar (readcharfun, c);
2490 /* FSF has code here that maybe caches the skipped
2491 string. See above for why this is totally
2492 losing. We handle this differently. */
2494 /* Skip that many characters. */
2495 for (i = 0; i < nskip && c >= 0; i++)
2496 c = readchar (readcharfun);
2500 case '$': return Vload_file_name_internal;
2502 case '*': return read_bit_vector (readcharfun);
2503 /* #o10 => 8 -- octal constant syntax */
2504 case 'o': return read_integer (readcharfun, 8);
2505 /* #xdead => 57005 -- hex constant syntax */
2506 case 'x': return read_integer (readcharfun, 16);
2507 /* #b010 => 2 -- binary constant syntax */
2508 case 'b': return read_integer (readcharfun, 2);
2509 /* #s(foobar key1 val1 key2 val2) -- structure syntax */
2510 case 's': return read_structure (readcharfun);
2513 unreadchar (readcharfun, c);
2514 return Fsignal (Qinvalid_read_syntax,
2515 list1 (build_string ("Cannot read unreadable object")));
2517 #ifdef FEATUREP_SYNTAX
2521 Lisp_Object fexp, obj, tem;
2522 struct gcpro gcpro1, gcpro2;
2524 fexp = read0(readcharfun);
2525 obj = read0(readcharfun);
2527 /* the call to `featurep' may GC. */
2529 tem = call1 (Qfeaturep, fexp);
2532 if (c == '+' && NILP(tem)) goto retry;
2533 if (c == '-' && !NILP(tem)) goto retry;
2537 case '0': case '1': case '2': case '3': case '4':
2538 case '5': case '6': case '7': case '8': case '9':
2539 /* Reader forms that can reuse previously read objects. */
2544 /* Using read_integer() here is impossible, because it
2545 chokes on `='. Using parse_integer() is too hard.
2546 So we simply read it in, and ignore overflows, which
2548 while (c >= '0' && c <= '9')
2552 c = readchar (readcharfun);
2554 found = assq_no_quit (make_int (n), Vread_objects);
2557 /* #n=object returns object, but associates it with
2561 return Fsignal (Qinvalid_read_syntax,
2562 list2 (build_translated_string
2563 ("Multiply defined symbol label"),
2565 obj = read0 (readcharfun);
2566 Vread_objects = Fcons (Fcons (make_int (n), obj),
2572 /* #n# returns a previously read object. */
2574 return XCDR (found);
2576 return Fsignal (Qinvalid_read_syntax,
2577 list2 (build_translated_string
2578 ("Undefined symbol label"),
2581 return Fsignal (Qinvalid_read_syntax,
2582 list1 (build_string ("#")));
2586 unreadchar (readcharfun, c);
2587 return Fsignal (Qinvalid_read_syntax,
2588 list1 (build_string ("#")));
2594 case '\'': return list2 (Qquote, read0 (readcharfun));
2596 #ifdef LISP_BACKQUOTES
2600 int speccount = specpdl_depth ();
2601 ++new_backquote_flag;
2602 record_unwind_protect (backquote_unwind,
2603 make_opaque_ptr (&new_backquote_flag));
2604 tem = read0 (readcharfun);
2605 unbind_to (speccount, Qnil);
2606 return list2 (Qbackquote, tem);
2611 if (new_backquote_flag)
2613 Lisp_Object comma_type = Qnil;
2614 int ch = readchar (readcharfun);
2617 comma_type = Qcomma_at;
2619 comma_type = Qcomma_dot;
2623 unreadchar (readcharfun, ch);
2624 comma_type = Qcomma;
2626 return list2 (comma_type, read0 (readcharfun));
2630 /* YUCK. 99.999% backwards compatibility. The Right
2631 Thing(tm) is to signal an error here, because it's
2632 really invalid read syntax. Instead, this permits
2633 commas to begin symbols (unless they're inside
2634 backquotes). If an error is signalled here in the
2635 future, then commas should be invalid read syntax
2636 outside of backquotes anywhere they're found (i.e.
2637 they must be quoted in symbols) -- Stig */
2638 return read_atom (readcharfun, c, 0);
2645 /* Evil GNU Emacs "character" (ie integer) syntax */
2646 c = readchar (readcharfun);
2648 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2651 c = read_escape (readcharfun);
2652 return make_char (c);
2659 /* #### If the input stream is translating, then the string
2660 should be marked as translatable by setting its
2661 `string-translatable' property to t. .el and .elc files
2662 normally are translating input streams. See Fgettext()
2663 and print_internal(). */
2667 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
2668 while ((c = readchar (readcharfun)) >= 0
2672 c = read_escape (readcharfun);
2673 /* c is -1 if \ newline has just been seen */
2676 if (Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) == 0)
2680 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
2684 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2686 /* If purifying, and string starts with \ newline,
2687 return zero instead. This is for doc strings
2688 that we are really going to find in lib-src/DOC.nn.nn */
2689 if (purify_flag && NILP (Vinternal_doc_file_name) && cancel)
2692 Lstream_flush (XLSTREAM (Vread_buffer_stream));
2695 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
2696 Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
2701 /* Ignore whitespace and control characters */
2704 return read_atom (readcharfun, c, 0);
2711 #ifdef LISP_FLOAT_TYPE
2720 isfloat_string (CONST char *cp)
2723 CONST Bufbyte *ucp = (CONST Bufbyte *) cp;
2725 if (*ucp == '+' || *ucp == '-')
2728 if (*ucp >= '0' && *ucp <= '9')
2731 while (*ucp >= '0' && *ucp <= '9')
2739 if (*ucp >= '0' && *ucp <= '9')
2742 while (*ucp >= '0' && *ucp <= '9')
2745 if (*ucp == 'e' || *ucp == 'E')
2749 if ((*ucp == '+') || (*ucp == '-'))
2753 if (*ucp >= '0' && *ucp <= '9')
2756 while (*ucp >= '0' && *ucp <= '9')
2759 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') || (*ucp == '\n')
2760 || (*ucp == '\r') || (*ucp == '\f'))
2761 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
2762 || state == (DOT_CHAR|TRAIL_INT)
2763 || state == (LEAD_INT|E_CHAR|EXP_INT)
2764 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
2765 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
2767 #endif /* LISP_FLOAT_TYPE */
2770 sequence_reader (Lisp_Object readcharfun,
2773 void * (*conser) (Lisp_Object readcharfun,
2774 void *state, Charcount len))
2778 for (len = 0; ; len++)
2783 ch = reader_nextchar (readcharfun);
2785 if (ch == terminator)
2788 unreadchar (readcharfun, ch);
2789 #ifdef FEATUREP_SYNTAX
2791 syntax_error ("\"]\" in a list");
2793 syntax_error ("\")\" in a vector");
2795 state = ((conser) (readcharfun, state, len));
2800 struct read_list_state
2805 int allow_dotted_lists;
2810 read_list_conser (Lisp_Object readcharfun, void *state, Charcount len)
2812 struct read_list_state *s = (struct read_list_state *) state;
2815 elt = read1 (readcharfun);
2817 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
2819 Lisp_Object tem = elt;
2823 free_cons (XCONS (tem));
2826 #ifdef FEATUREP_SYNTAX
2827 if (ch == s->terminator) /* deal with #+, #- reader macros */
2829 unreadchar (readcharfun, s->terminator);
2833 syntax_error ("']' in a list");
2835 syntax_error ("')' in a vector");
2839 signal_simple_error ("BUG! Internal reader error", elt);
2840 else if (!s->allow_dotted_lists)
2841 syntax_error ("\".\" in a vector");
2844 if (!NILP (s->tail))
2845 XCDR (s->tail) = read0 (readcharfun);
2847 s->head = read0 (readcharfun);
2848 elt = read1 (readcharfun);
2849 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
2851 ch = XCHAR (XCDR (elt));
2852 free_cons (XCONS (elt));
2853 if (ch == s->terminator)
2855 unreadchar (readcharfun, s->terminator);
2859 syntax_error (". in wrong context");
2863 #if 0 /* FSFmacs defun hack, or something ... */
2864 if (NILP (tail) && defun_hack && EQ (elt, Qdefun) && !read_pure)
2866 record_unwind_protect (unreadpure, Qzero);
2871 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2872 if (s->length == 1 && s->allow_dotted_lists && EQ (XCAR (s->head), Qfset))
2874 if (CONSP (elt) && EQ (XCAR (elt), Qquote) && CONSP (XCDR (elt)))
2875 Vcurrent_compiled_function_annotation = XCAR (XCDR (elt));
2877 Vcurrent_compiled_function_annotation = elt;
2881 elt = Fcons (elt, Qnil);
2882 if (!NILP (s->tail))
2883 XCDR (s->tail) = elt;
2893 #if 0 /* FSFmacs defun hack */
2894 /* -1 for allow_dotted_lists means allow_dotted_lists and check
2895 for starting with defun and make structure pure. */
2899 read_list (Lisp_Object readcharfun,
2901 int allow_dotted_lists,
2902 int check_for_doc_references)
2904 struct read_list_state s;
2905 struct gcpro gcpro1, gcpro2;
2906 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2907 Lisp_Object old_compiled_function_annotation =
2908 Vcurrent_compiled_function_annotation;
2914 s.allow_dotted_lists = allow_dotted_lists;
2915 s.terminator = terminator;
2916 GCPRO2 (s.head, s.tail);
2918 sequence_reader (readcharfun, terminator, &s, read_list_conser);
2919 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2920 Vcurrent_compiled_function_annotation = old_compiled_function_annotation;
2923 if ((purify_flag || load_force_doc_strings) && check_for_doc_references)
2925 /* check now for any doc string references and record them
2929 /* We might be dealing with an imperfect list so don't
2931 for (tail = s.head; CONSP (tail); tail = XCDR (tail))
2933 Lisp_Object holding_cons = Qnil;
2936 Lisp_Object elem = XCAR (tail);
2937 /* elem might be (#$ . INT) ... */
2938 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
2939 holding_cons = tail;
2940 /* or it might be (quote (#$ . INT)) i.e.
2941 (quote . ((#$ . INT) . nil)) in the case of
2942 `autoload' (autoload evaluates its arguments, while
2943 `defvar', `defun', etc. don't). */
2944 if (CONSP (elem) && EQ (XCAR (elem), Qquote)
2945 && CONSP (XCDR (elem)))
2947 elem = XCAR (XCDR (elem));
2948 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
2949 holding_cons = XCDR (XCAR (tail));
2953 if (CONSP (holding_cons))
2957 if (NILP (Vinternal_doc_file_name))
2958 /* We have not yet called Snarf-documentation, so
2959 assume this file is described in the DOC file
2960 and Snarf-documentation will fill in the right
2961 value later. For now, replace the whole list
2963 XCAR (holding_cons) = Qzero;
2965 /* We have already called Snarf-documentation, so
2966 make a relative file name for this file, so it
2967 can be found properly in the installed Lisp
2968 directory. We don't use Fexpand_file_name
2969 because that would make the directory absolute
2971 XCAR (XCAR (holding_cons)) =
2972 concat2 (build_string ("../lisp/"),
2973 Ffile_name_nondirectory
2974 (Vload_file_name_internal));
2977 /* Not pure. Just add to Vload_force_doc_string_list,
2978 and the string will be filled in properly in
2979 load_force_doc_string_unwind(). */
2980 Vload_force_doc_string_list =
2981 /* We pass the cons that holds the (#$ . INT) so we
2982 can modify it in-place. */
2983 Fcons (holding_cons, Vload_force_doc_string_list);
2993 read_vector (Lisp_Object readcharfun,
3000 struct read_list_state s;
3001 struct gcpro gcpro1, gcpro2;
3006 s.allow_dotted_lists = 0;
3007 GCPRO2 (s.head, s.tail);
3009 sequence_reader (readcharfun, terminator, &s, read_list_conser);
3013 len = XINT (Flength (tem));
3015 #if 0 /* FSFmacs defun hack */
3017 s.head = make_pure_vector (len, Qnil);
3020 s.head = make_vector (len, Qnil);
3022 for (i = 0, p = &(XVECTOR_DATA (s.head)[0]);
3026 struct Lisp_Cons *otem = XCONS (tem);
3027 #if 0 /* FSFmacs defun hack */
3029 tem = Fpurecopy (Fcar (tem));
3041 read_compiled_function (Lisp_Object readcharfun, Emchar terminator)
3043 /* Accept compiled functions at read-time so that we don't
3044 have to build them at load-time. */
3046 Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
3047 struct gcpro gcpro1;
3050 int saw_a_doc_ref = 0;
3052 /* Note: we tell read_list not to search for doc references
3053 because we need to handle the "doc reference" for the
3054 instructions and constants differently. */
3055 stuff = read_list (readcharfun, terminator, 0, 0);
3056 len = XINT (Flength (stuff));
3057 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
3059 continuable_syntax_error ("#[...] used with wrong number of elements");
3061 for (iii = 0; CONSP (stuff); iii++)
3063 struct Lisp_Cons *victim = XCONS (stuff);
3064 make_byte_code_args[iii] = Fcar (stuff);
3065 if ((purify_flag || load_force_doc_strings)
3066 && CONSP (make_byte_code_args[iii])
3067 && EQ (XCAR (make_byte_code_args[iii]), Vload_file_name_internal))
3069 if (purify_flag && iii == COMPILED_DOC_STRING)
3071 /* same as in read_list(). */
3072 if (NILP (Vinternal_doc_file_name))
3073 make_byte_code_args[iii] = Qzero;
3075 XCAR (make_byte_code_args[iii]) =
3076 concat2 (build_string ("../lisp/"),
3077 Ffile_name_nondirectory
3078 (Vload_file_name_internal));
3083 stuff = Fcdr (stuff);
3086 GCPRO1 (make_byte_code_args[0]);
3089 /* v18 or v19 bytecode file. Need to Ebolify. */
3090 if (load_byte_code_version < 20 && VECTORP (make_byte_code_args[2]))
3091 ebolify_bytecode_constants (make_byte_code_args[2]);
3093 /* make-byte-code looks at purify_flag, which should have the same
3094 * value as our "read-pure" argument */
3095 stuff = Fmake_byte_code (len, make_byte_code_args);
3096 XCOMPILED_FUNCTION (stuff)->flags.ebolified = (load_byte_code_version < 20);
3098 Vload_force_doc_string_list = Fcons (stuff, Vload_force_doc_string_list);
3110 load_in_progress = 0;
3112 Vload_descriptor_list = Qnil;
3114 /* kludge: locate-file does not work for a null load-path, even if
3115 the file name is absolute. */
3117 Vload_path = Fcons (build_string (""), Qnil);
3119 /* This used to get initialized in init_lread because all streams
3120 got closed when dumping occurs. This is no longer true --
3121 Vread_buffer_stream is a resizing output stream, and there is no
3122 reason to close it at dump-time.
3124 Vread_buffer_stream is set to Qnil in vars_of_lread, and this
3125 will initialize it only once, at dump-time. */
3126 if (NILP (Vread_buffer_stream))
3127 Vread_buffer_stream = make_resizing_buffer_output_stream ();
3129 Vload_force_doc_string_list = Qnil;
3133 syms_of_lread (void)
3136 DEFSUBR (Fread_from_string);
3137 DEFSUBR (Fload_internal);
3138 DEFSUBR (Flocate_file);
3139 DEFSUBR (Flocate_file_clear_hashing);
3140 DEFSUBR (Feval_buffer);
3141 DEFSUBR (Feval_region);
3143 defsymbol (&Qstandard_input, "standard-input");
3144 defsymbol (&Qread_char, "read-char");
3145 defsymbol (&Qcurrent_load_list, "current-load-list");
3146 defsymbol (&Qload, "load");
3147 defsymbol (&Qload_file_name, "load-file-name");
3148 defsymbol (&Qfset, "fset");
3150 #ifdef LISP_BACKQUOTES
3151 defsymbol (&Qbackquote, "backquote");
3152 defsymbol (&Qbacktick, "`");
3153 defsymbol (&Qcomma, ",");
3154 defsymbol (&Qcomma_at, ",@");
3155 defsymbol (&Qcomma_dot, ",.");
3158 defsymbol (&Qexists, "exists");
3159 defsymbol (&Qreadable, "readable");
3160 defsymbol (&Qwritable, "writable");
3161 defsymbol (&Qexecutable, "executable");
3165 structure_type_create (void)
3167 the_structure_type_dynarr = Dynarr_new (structure_type);
3171 vars_of_lread (void)
3173 DEFVAR_LISP ("values", &Vvalues /*
3174 List of values of all expressions which were read, evaluated and printed.
3175 Order is reverse chronological.
3178 DEFVAR_LISP ("standard-input", &Vstandard_input /*
3179 Stream for read to get input from.
3180 See documentation of `read' for possible values.
3182 Vstandard_input = Qt;
3184 DEFVAR_LISP ("load-path", &Vload_path /*
3185 *List of directories to search for files to load.
3186 Each element is a string (directory name) or nil (try default directory).
3188 Note that the elements of this list *may not* begin with "~", so you must
3189 call `expand-file-name' on them before adding them to this list.
3191 Initialized based on EMACSLOADPATH environment variable, if any,
3192 otherwise to default specified in by file `paths.h' when XEmacs was built.
3193 If there were no paths specified in `paths.h', then XEmacs chooses a default
3194 value for this variable by looking around in the file-system near the
3195 directory in which the XEmacs executable resides.
3199 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
3200 "*Location of lisp files to be used when dumping ONLY."); */
3202 DEFVAR_BOOL ("load-in-progress", &load_in_progress /*
3203 Non-nil iff inside of `load'.
3206 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist /*
3207 An alist of expressions to be evalled when particular files are loaded.
3208 Each element looks like (FILENAME FORMS...).
3209 When `load' is run and the file-name argument is FILENAME,
3210 the FORMS in the corresponding element are executed at the end of loading.
3212 FILENAME must match exactly! Normally FILENAME is the name of a library,
3213 with no directory specified, since that is how `load' is normally called.
3214 An error in FORMS does not undo the load,
3215 but does prevent execution of the rest of the FORMS.
3217 Vafter_load_alist = Qnil;
3219 DEFVAR_BOOL ("load-warn-when-source-newer", &load_warn_when_source_newer /*
3220 *Whether `load' should check whether the source is newer than the binary.
3221 If this variable is true, then when a `.elc' file is being loaded and the
3222 corresponding `.el' is newer, a warning message will be printed.
3224 load_warn_when_source_newer = 0;
3226 DEFVAR_BOOL ("load-warn-when-source-only", &load_warn_when_source_only /*
3227 *Whether `load' should warn when loading a `.el' file instead of an `.elc'.
3228 If this variable is true, then when `load' is called with a filename without
3229 an extension, and the `.elc' version doesn't exist but the `.el' version does,
3230 then a message will be printed. If an explicit extension is passed to `load',
3231 no warning will be printed.
3233 load_warn_when_source_only = 0;
3235 DEFVAR_BOOL ("load-ignore-elc-files", &load_ignore_elc_files /*
3236 *Whether `load' should ignore `.elc' files when a suffix is not given.
3237 This is normally used only to bootstrap the `.elc' files when building XEmacs.
3239 load_ignore_elc_files = 0;
3242 DEFVAR_LISP ("load-history", &Vload_history /*
3243 Alist mapping source file names to symbols and features.
3244 Each alist element is a list that starts with a file name,
3245 except for one element (optional) that starts with nil and describes
3246 definitions evaluated from buffers not visiting files.
3247 The remaining elements of each list are symbols defined as functions
3248 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
3250 Vload_history = Qnil;
3252 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list /*
3253 Used for internal purposes by `load'.
3255 Vcurrent_load_list = Qnil;
3258 DEFVAR_LISP ("load-file-name", &Vload_file_name /*
3259 Full name of file being loaded by `load'.
3261 Vload_file_name = Qnil;
3263 DEFVAR_LISP ("load-read-function", &Vload_read_function /*
3264 Function used by `load' and `eval-region' for reading expressions.
3265 The default is nil, which means use the function `read'.
3267 Vload_read_function = Qnil;
3269 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings /*
3270 Non-nil means `load' should force-load all dynamic doc strings.
3271 This is useful when the file being loaded is a temporary copy.
3273 load_force_doc_strings = 0;
3275 /* See read_escape(). */
3277 /* Used to be named `puke-on-fsf-keys' */
3278 DEFVAR_BOOL ("fail-on-bucky-bit-character-escapes",
3279 &fail_on_bucky_bit_character_escapes /*
3280 Whether `read' should signal an error when it encounters unsupported
3281 character escape syntaxes or just read them incorrectly.
3283 fail_on_bucky_bit_character_escapes = 0;
3286 /* This must be initialized in init_lread otherwise it may start out
3287 with values saved when the image is dumped. */
3288 staticpro (&Vload_descriptor_list);
3290 Vread_buffer_stream = Qnil;
3291 staticpro (&Vread_buffer_stream);
3293 /* Initialized in init_lread. */
3294 staticpro (&Vload_force_doc_string_list);
3296 Vload_file_name_internal = Qnil;
3297 staticpro (&Vload_file_name_internal);
3299 Vload_file_name_internal_the_purecopy = Qnil;
3300 staticpro (&Vload_file_name_internal_the_purecopy);
3302 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3303 Vcurrent_compiled_function_annotation = Qnil;
3304 staticpro (&Vcurrent_compiled_function_annotation);
3307 /* So that early-early stuff will work */
3308 Ffset (Qload, intern ("load-internal"));
3310 #ifdef FEATUREP_SYNTAX
3311 defsymbol (&Qfeaturep, "featurep");
3312 Fprovide(intern("xemacs"));
3314 Fprovide(intern("infodock"));
3315 #endif /* INFODOCK */
3316 #endif /* FEATUREP_SYNTAX */
3318 #ifdef LISP_BACKQUOTES
3319 old_backquote_flag = new_backquote_flag = 0;
3323 Vfile_domain = Qnil;
3326 Vread_objects = Qnil;
3327 staticpro (&Vread_objects);
3329 Vlocate_file_hash_table = make_lisp_hash_table (200,
3330 HASH_TABLE_NON_WEAK,
3332 staticpro (&Vlocate_file_hash_table);
3334 symbol_value (XSYMBOL (intern ("Vlocate-file-hash-table")))
3335 = Vlocate_file_hash_table;