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.
5 Copyright (C) 2004 Steve Youngs.
7 This file is part of SXEmacs
9 SXEmacs is free software: you can redistribute it and/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation, either version 3 of the License, or
12 (at your option) any later version.
14 SXEmacs is distributed in the hope that it will be useful,
15 but WITHOUT ANY WARRANTY; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program. If not, see <http://www.gnu.org/licenses/>. */
23 /* Synched up with: Mule 2.0, FSF 19.30. */
25 /* This file has been Mule-ized. */
36 #include "mule/file-coding.h"
42 Lisp_Object Qread_char, Qstandard_input;
43 Lisp_Object Qvariable_documentation;
44 #define LISP_BACKQUOTES
45 #ifdef LISP_BACKQUOTES
47 Nonzero means inside a new-style backquote
48 with no surrounding parentheses.
49 Fread initializes this to zero, so we need not specbind it
50 or worry about what happens to it when there is an error.
53 Nested backquotes are perfectly legal and fail utterly with
55 static int new_backquote_flag, old_backquote_flag;
56 Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot;
58 Lisp_Object Qvariable_domain; /* I18N3 */
59 Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
60 Lisp_Object Qcurrent_load_list;
61 Lisp_Object Qload, Qload_file_name;
63 Lisp_Object Vload_suppress_alist;
65 /* Hash-table that maps directory names to hashes of their contents. */
66 static Lisp_Object Vlocate_file_hash_table;
68 Lisp_Object Qexists, Qreadable, Qwritable, Qexecutable;
70 Lisp_Object Vureaders;
72 /* See read_escape() for an explanation of this. */
74 int fail_on_bucky_bit_character_escapes;
77 /* This symbol is also used in fns.c */
78 #define FEATUREP_SYNTAX
80 #ifdef FEATUREP_SYNTAX
81 Lisp_Object Qfeaturep;
84 /* non-zero if inside `load' */
87 /* Whether Fload_internal() should check whether the .el is newer
89 int load_warn_when_source_newer;
90 /* Whether Fload_internal() should check whether the .elc doesn't exist */
91 int load_warn_when_source_only;
92 /* Whether Fload_internal() should ignore .elc files when no suffix is given */
93 int load_ignore_elc_files;
95 /* Search path for files to be loaded. */
96 Lisp_Object Vload_path;
98 /* Search path for files when dumping. */
99 /* Lisp_Object Vdump_load_path; */
101 /* This is the user-visible association list that maps features to
102 lists of defs in their load files. */
103 Lisp_Object Vload_history;
105 /* This is used to build the load history. */
106 Lisp_Object Vcurrent_load_list;
108 /* Name of file actually being read by `load'. */
109 Lisp_Object Vload_file_name;
111 /* Same as Vload_file_name but not Lisp-accessible. This ensures that
112 our #$ checks are reliable. */
113 Lisp_Object Vload_file_name_internal;
115 Lisp_Object Vload_file_name_internal_the_purecopy;
117 /* Function to use for reading, in `load' and friends. */
118 Lisp_Object Vload_read_function;
120 /* The association list of objects read with the #n=object form.
121 Each member of the list has the form (n . object), and is used to
122 look up the object for the corresponding #n# construct.
123 It must be set to nil before all top-level calls to read0. */
124 Lisp_Object Vread_objects;
126 /* Nonzero means load should forcibly load all dynamic doc strings. */
127 /* Note that this always happens (with some special behavior) when
128 purify_flag is set. */
129 static int load_force_doc_strings;
131 /* List of descriptors now open for Fload_internal. */
132 static Lisp_Object Vload_descriptor_list;
134 /* In order to implement "load_force_doc_strings", we keep
135 a list of all the compiled-function objects and such
136 that we have created in the process of loading this file.
139 We specbind this just like Vload_file_name, so there's no
140 problems with recursive loading. */
141 static Lisp_Object Vload_force_doc_string_list;
143 /* A resizing-buffer stream used to temporarily hold data while reading */
144 static Lisp_Object Vread_buffer_stream;
146 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
147 Lisp_Object Vcurrent_compiled_function_annotation;
150 static int load_byte_code_version;
152 /* An array describing all known built-in structure types */
153 static structure_type_dynarr *the_structure_type_dynarr;
155 #if 0 /* FSF defun hack */
156 /* When nonzero, read conses in pure space */
157 static int read_pure;
160 #if 0 /* FSF stuff */
161 /* For use within read-from-string (this reader is non-reentrant!!) */
162 static int read_from_string_index;
163 static int read_from_string_limit;
166 /* parser hook for resclass objects */
167 int(*ase_resc_rng_pred_f)(const char *cp) = NULL;
168 int(*ase_resc_elm_pred_f)(const char *cp) = NULL;
169 Lisp_Object(*ase_resc_rng_f)(char *cp) = NULL;
170 Lisp_Object(*ase_resc_elm_f)(char *cp) = NULL;
171 /* parser hook for perms */
172 Lisp_Object(*ase_permutation_f)(Lisp_Object);
175 #if 0 /* More FSF implementation kludges. */
176 /* In order to implement load-force-doc-string, FSF saves the
177 #@-quoted string when it's seen, and goes back and retrieves
180 This approach is not only kludgy, but it in general won't work
181 correctly because there's no stack of remembered #@-quoted-strings
182 and those strings don't generally appear in the file in the same
183 order as their #$ references. (Yes, that is amazingly stupid too.
185 It would be trivially easy to always encode the #@ string
186 [which is a comment, anyway] in the middle of the (#$ . INT) cons
187 reference. That way, it would be really easy to implement
188 load-force-doc-string in a non-kludgy way by just retrieving the
189 string immediately, because it's delivered on a silver platter.)
191 And finally, this stupid approach doesn't work under Mule, or
192 under MS-DOS or Windows NT, or under VMS, or any other place
193 where you either can't do an ftell() or don't get back a byte
196 Oh, and one more lossage in this approach: If you attempt to
197 dump any ELC files that were compiled with `byte-compile-dynamic'
198 (as opposed to just `byte-compile-dynamic-docstring'), you
199 get hosed. FMH! (as the illustrious JWZ was prone to utter)
201 The approach we use is clean, solves all of these problems, and is
202 probably easier to implement anyway. We just save a list of all
203 the containing objects that have (#$ . INT) conses in them (this
204 will only be compiled-function objects and lists), and when the
205 file is finished loading, we go through and fill in all the
206 doc strings at once. */
208 /* This contains the last string skipped with #@. */
209 static char *saved_doc_string;
210 /* Length of buffer allocated in saved_doc_string. */
211 static int saved_doc_string_size;
212 /* Length of actual data in saved_doc_string. */
213 static int saved_doc_string_length;
214 /* This is the file position that string came from. */
215 static int saved_doc_string_position;
218 EXFUN(Fread_from_string, 3);
220 /* When errors are signaled, the actual readcharfun should not be used
221 as an argument if it is an lstream, so that lstreams don't escape
222 to the Lisp level. */
223 #define READCHARFUN_MAYBE(x) (LSTREAMP (x) \
224 ? (build_string ("internal input stream")) \
227 static DOESNT_RETURN read_syntax_error(const char *string)
229 signal_error(Qinvalid_read_syntax,
230 list1(build_translated_string(string)));
233 static Lisp_Object continuable_read_syntax_error(const char *string)
235 return Fsignal(Qinvalid_read_syntax,
236 list1(build_translated_string(string)));
239 /* Handle unreading and rereading of characters. */
240 static Emchar readchar(Lisp_Object readcharfun)
242 /* This function can GC */
244 if (BUFFERP(readcharfun)) {
246 struct buffer *b = XBUFFER(readcharfun);
248 if (!BUFFER_LIVE_P(b))
249 error("Reading from killed buffer");
251 if (BUF_PT(b) >= BUF_ZV(b))
253 c = BUF_FETCH_CHAR(b, BUF_PT(b));
254 BUF_SET_PT(b, BUF_PT(b) + 1);
257 } else if (LSTREAMP(readcharfun)) {
258 Emchar c = Lstream_get_emchar(XLSTREAM(readcharfun));
259 #ifdef DEBUG_SXEMACS /* testing Mule */
260 static int testing_mule = 0; /* Change via debugger */
262 if (c >= 0x20 && c <= 0x7E)
267 stderr_out("\\%o ", c);
269 #endif /* testing Mule */
271 } 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);
282 Lisp_Object tem = call0(readcharfun);
284 if (!CHAR_OR_CHAR_INTP(tem))
286 return XCHAR_OR_CHAR_INT(tem);
290 /* Unread the character C in the way appropriate for the stream READCHARFUN.
291 If the stream is a user function, call it with the char as argument. */
293 static void unreadchar(Lisp_Object readcharfun, Emchar c)
296 /* Don't back up the pointer if we're unreading the end-of-input mark,
297 since readchar didn't advance it when we read it. */
299 else if (BUFFERP(readcharfun))
300 BUF_SET_PT(XBUFFER(readcharfun),
301 BUF_PT(XBUFFER(readcharfun)) - 1);
302 else if (LSTREAMP(readcharfun)) {
303 Lstream_unget_emchar(XLSTREAM(readcharfun), c);
304 #ifdef DEBUG_SXEMACS /* testing Mule */
306 static int testing_mule = 0; /* Set this using debugger */
309 (c >= 0x20 && c <= 0x7E) ? "UU%c" :
310 ((c == '\n') ? "UU\\n\n" : "UU\\%o"),
314 } else if (MARKERP(readcharfun))
315 set_marker_position(readcharfun,
316 marker_position(readcharfun) - 1);
318 call1(readcharfun, make_char(c));
321 static Lisp_Object read0(Lisp_Object readcharfun);
322 static Lisp_Object read1(Lisp_Object readcharfun);
323 /* allow_dotted_lists means that something like (foo bar . baz)
324 is acceptable. If -1, means check for starting with defun
325 and make structure pure. (not implemented, probably for very
329 If check_for_doc_references, look for (#$ . INT) doc references
330 in the list and record if load_force_doc_strings is non-zero.
331 (Such doc references will be destroyed during the loadup phase
332 by replacing with Qzero, because Snarf-documentation will fill
335 WARNING: If you set this, you sure as hell better not call
336 free_list() on the returned list here. */
338 static Lisp_Object read_list(Lisp_Object readcharfun,
340 int allow_dotted_lists,
341 int check_for_doc_references);
343 static void readevalloop(Lisp_Object readcharfun,
344 Lisp_Object sourcefile,
345 Lisp_Object(*evalfun) (Lisp_Object), int printflag);
347 static Lisp_Object load_unwind(Lisp_Object stream)
348 { /* used as unwind-protect function in load */
349 Lstream_close(XLSTREAM(stream));
350 if (--load_in_progress < 0)
351 load_in_progress = 0;
355 static Lisp_Object load_descriptor_unwind(Lisp_Object oldlist)
357 Vload_descriptor_list = oldlist;
361 static Lisp_Object load_file_name_internal_unwind(Lisp_Object oldval)
363 Vload_file_name_internal = oldval;
368 load_file_name_internal_the_purecopy_unwind(Lisp_Object oldval)
370 Vload_file_name_internal_the_purecopy = oldval;
374 static Lisp_Object load_byte_code_version_unwind(Lisp_Object oldval)
376 load_byte_code_version = XINT(oldval);
381 suppressedp_loop(int len, char *nonreloc, Lisp_Object reloc)
383 EXTERNAL_LIST_LOOP_2(_acons_, Vload_suppress_alist) {
384 if (CONSP(_acons_) && STRINGP(XCAR(_acons_))) {
385 Lisp_Object name = XCAR(_acons_);
386 if (XSTRING_LENGTH(name) == len &&
387 !memcmp(XSTRING_DATA(name), nonreloc, len)) {
392 val = Feval(XCDR(_acons_));
404 suppressedp(char *nonreloc, Lisp_Object reloc)
406 /* Check if NONRELOC/RELOC (an absolute filename) is suppressed according
407 to load-suppress-alist. */
411 nonreloc = (char*)XSTRING_DATA(reloc);
412 len = XSTRING_LENGTH(reloc);
414 len = strlen(nonreloc);
416 if (len >= 4 && !strcmp(nonreloc + len - 4, ".elc"))
418 else if (len >= 3 && !strcmp(nonreloc + len - 3, ".el"))
421 return suppressedp_loop(len, nonreloc, reloc);
424 /* The plague is coming.
426 Ring around the rosy, pocket full of posy,
427 Ashes ashes, they all fall down.
429 void ebolify_bytecode_constants(Lisp_Object vector)
431 int len = XVECTOR_LENGTH(vector);
434 for (i = 0; i < len; i++) {
435 Lisp_Object el = XVECTOR_DATA(vector)[i];
437 /* We don't check for `eq', `equal', and the others that have
438 bytecode opcodes. This might lose if someone passes #'eq or
439 something to `funcall', but who would really do that? As
440 they say in law, we've made a "good-faith effort" to
441 unfuckify ourselves. And doing it this way avoids screwing
442 up args to `make-hash-table' and such. As it is, we have to
443 add an extra Ebola check in decode_weak_list_type(). --ben */
446 else if (EQ(el, Qdelq))
449 /* I think this is a bad idea because it will probably mess
451 else if (EQ(el, Qdelete))
454 else if (EQ(el, Qrassq))
456 else if (EQ(el, Qrassoc))
459 XVECTOR_DATA(vector)[i] = el;
463 static Lisp_Object pas_de_lache_ici(int fd, Lisp_Object victim)
468 if (!INTP(XCDR(victim)))
469 signal_simple_error("Bogus doc string reference", victim);
470 pos = XINT(XCDR(victim));
472 pos = -pos; /* kludge to mark a user variable */
473 tem = unparesseuxify_doc_string(fd, pos, 0, Vload_file_name_internal);
475 signal_error(Qerror, tem);
479 static Lisp_Object load_force_doc_string_unwind(Lisp_Object oldlist)
482 Lisp_Object list = Vload_force_doc_string_list;
484 int fd = XINT(XCAR(Vload_descriptor_list));
487 /* restore the old value first just in case an error occurs. */
488 Vload_force_doc_string_list = oldlist;
490 LIST_LOOP(tail, list) {
491 Lisp_Object john = Fcar(tail);
493 assert(CONSP(XCAR(john)));
494 assert(!purify_flag); /* should have been handled in read_list() */
495 XCAR(john) = pas_de_lache_ici(fd, XCAR(john));
499 assert(COMPILED_FUNCTIONP(john));
500 if (CONSP(XCOMPILED_FUNCTION(john)->instructions)) {
501 struct gcpro ngcpro1;
502 Lisp_Object juan = (pas_de_lache_ici
504 XCOMPILED_FUNCTION(john)->
512 ("invalid lazy-loaded byte code",
514 XCOMPILED_FUNCTION(john)->instructions =
516 /* v18 or v19 bytecode file. Need to Ebolify. */
517 if (XCOMPILED_FUNCTION(john)->flags.ebolified
518 && VECTORP(XCDR(ivan)))
519 ebolify_bytecode_constants(XCDR(ivan));
520 XCOMPILED_FUNCTION(john)->constants =
525 compiled_function_documentation(XCOMPILED_FUNCTION
528 assert(!purify_flag); /* should have been handled in
529 read_compiled_function() */
530 doc = pas_de_lache_ici(fd, doc);
531 set_compiled_function_documentation
532 (XCOMPILED_FUNCTION(john), doc);
544 /* Close all descriptors in use for Fload_internal.
545 This is used when starting a subprocess. */
547 void close_load_descs(void)
550 LIST_LOOP(tail, Vload_descriptor_list)
551 close(XINT(XCAR(tail)));
555 Lisp_Object Vfile_domain;
557 Lisp_Object restore_file_domain(Lisp_Object val)
564 DEFUN("load-internal", Fload_internal, 1, 6, 0, /*
565 Execute a file of Lisp code named FILE; no coding-system frobbing.
566 This function is identical to `load' except for the handling of the
567 CODESYS and USED-CODESYS arguments under SXEmacs/Mule. (When Mule
568 support is not present, both functions are identical and ignore the
569 CODESYS and USED-CODESYS arguments.)
571 If support for Mule exists in this Emacs, the file is decoded
572 according to CODESYS; if omitted, no conversion happens. If
573 USED-CODESYS is non-nil, it should be a symbol, and the actual coding
574 system that was used for the decoding is stored into it. It will in
575 general be different from CODESYS if CODESYS specifies automatic
576 encoding detection or end-of-line detection.
578 (file, noerror, nomessage, nosuffix, codesys, used_codesys))
580 /* This function can GC */
582 int speccount = specpdl_depth();
584 Lisp_Object newer = Qnil;
585 Lisp_Object handler = Qnil;
586 Lisp_Object found = Qnil;
587 struct gcpro gcpro1, gcpro2, gcpro3;
589 int message_p = NILP(nomessage);
590 /*#ifdef DEBUG_SXEMACS*/
591 static Lisp_Object last_file_loaded;
594 GCPRO3(file, newer, found);
598 /*#ifdef DEBUG_SXEMACS*/
599 if (purify_flag && noninteractive) {
601 last_file_loaded = file;
603 /*#endif / * DEBUG_SXEMACS */
605 /* If file name is magic, call the handler. */
606 handler = Ffind_file_name_handler(file, Qload);
608 RETURN_UNGCPRO(call5(handler, Qload, file, noerror,
609 nomessage, nosuffix));
611 /* Do this after the handler to avoid
612 the need to gcpro noerror, nomessage and nosuffix.
613 (Below here, we care only whether they are nil or not.) */
614 file = Fsubstitute_in_file_name(file);
616 if (!NILP(used_codesys))
617 CHECK_SYMBOL(used_codesys);
620 /* Avoid weird lossage with null string as arg,
621 since it would try to load a directory as a Lisp file.
623 if (XSTRING_LENGTH(file) > 0) {
627 fd = locate_file(Vload_path, file,
630 : build_string(load_ignore_elc_files
632 : ".elc:.el:")), &found, -1);
636 signal_file_error("Cannot open load file",
644 foundlen = XSTRING_LENGTH(found);
645 foundstr = (char *)alloca( foundlen+ 1);
646 strncpy(foundstr, (char *)XSTRING_DATA(found), foundlen+1);
649 /* The omniscient JWZ thinks this is worthless, but I beg to
651 if (load_ignore_elc_files) {
652 newer = Ffile_name_nondirectory(found);
653 } else if (load_warn_when_source_newer &&
654 !memcmp(".elc", foundstr + foundlen - 4, 4)) {
655 if (!fstat(fd, &s1)) { /* can't fail, right? */
657 /* temporarily hack the 'c' off the end of the
659 foundstr[foundlen - 1] = '\0';
660 result = sxemacs_stat(foundstr, &s2);
662 (unsigned)s1.st_mtime <
663 (unsigned)s2.st_mtime) {
664 Lisp_Object newer_name =
665 make_string((Bufbyte*)foundstr,
667 struct gcpro nngcpro1;
668 NNGCPRO1(newer_name);
669 newer = Ffile_name_nondirectory(
673 /* put the 'c' back on (kludge-o-rama) */
674 foundstr[foundlen - 1] = 'c';
676 } else if (load_warn_when_source_only &&
677 /* `found' ends in ".el" */
678 !memcmp(".el", foundstr + foundlen - 3, 3) &&
679 /* `file' does not end in ".el" */
681 XSTRING_DATA(file) + XSTRING_LENGTH(file) - 3,
686 if (!memcmp(".elc", foundstr + foundlen - 4, 4))
689 #define PRINT_LOADING_MESSAGE(done) \
691 if (load_ignore_elc_files) { \
693 message("Loading %s..." done, \
694 XSTRING_DATA(newer)); \
696 } else if (!NILP(newer)) { \
697 message("Loading %s..." done " (file %s is newer)", \
698 XSTRING_DATA(file), \
699 XSTRING_DATA(newer)); \
700 } else if (source_only) { \
701 Lisp_Object tmp = Ffile_name_nondirectory(file); \
702 message("Loading %s..." done \
703 " (file %s.elc does not exist)", \
704 XSTRING_DATA(file), \
705 XSTRING_DATA(tmp)); \
706 } else if (message_p) { \
707 message("Loading %s..." done, \
708 XSTRING_DATA(file)); \
712 PRINT_LOADING_MESSAGE("");
715 /* Lisp_Object's must be malloc'ed, not stack-allocated */
716 Lisp_Object lstrm = Qnil;
717 const int block_size = 8192;
718 struct gcpro ngcpro1;
722 signal_file_error("Cannot open load file", file);
724 lstrm = make_filedesc_input_stream(fd, 0, -1, LSTR_CLOSING);
725 /* 64K is used for normal files; 8K should be OK here because
726 * Lisp files aren't really all that big. */
727 Lstream_set_buffering(XLSTREAM(lstrm),
728 LSTREAM_BLOCKN_BUFFERED, block_size);
730 lstrm = make_decoding_input_stream(
731 XLSTREAM(lstrm), Fget_coding_system(codesys));
732 Lstream_set_buffering(XLSTREAM(lstrm),
733 LSTREAM_BLOCKN_BUFFERED, block_size);
735 /* NOTE: Order of these is very important.
736 * Don't rearrange them. */
737 record_unwind_protect(load_unwind, lstrm);
738 record_unwind_protect(load_descriptor_unwind,
739 Vload_descriptor_list);
740 record_unwind_protect(load_file_name_internal_unwind,
741 Vload_file_name_internal);
742 record_unwind_protect(
743 load_file_name_internal_the_purecopy_unwind,
744 Vload_file_name_internal_the_purecopy);
745 record_unwind_protect(load_force_doc_string_unwind,
746 Vload_force_doc_string_list);
747 Vload_file_name_internal = found;
748 Vload_file_name_internal_the_purecopy = Qnil;
749 specbind(Qload_file_name, found);
750 Vload_descriptor_list =
751 Fcons(make_int(fd), Vload_descriptor_list);
752 Vload_force_doc_string_list = Qnil;
754 record_unwind_protect(restore_file_domain, Vfile_domain);
755 /* set it to nil; a call to #'domain will set it. */
760 /* Now determine what sort of ELC file we're reading in. */
761 record_unwind_protect(load_byte_code_version_unwind,
762 make_int(load_byte_code_version));
767 num_read = Lstream_read(XLSTREAM(lstrm), elc_header, 8);
768 if (num_read < 8 || strncmp(elc_header, ";ELC", 4)) {
769 /* Huh? Probably not a valid ELC file. */
770 /* no Ebolification needed */
771 load_byte_code_version = 100;
772 Lstream_unread(XLSTREAM(lstrm), elc_header,
775 load_byte_code_version = elc_header[4];
778 /* no Ebolification needed */
779 load_byte_code_version = 100;
782 readevalloop(lstrm, file, Feval, 0);
784 if (!NILP(used_codesys)) {
786 decoding_stream_coding_system(XLSTREAM(lstrm));
787 Fset(used_codesys, XCODING_SYSTEM_NAME(tmp));
790 unbind_to(speccount, Qnil);
797 /* #### Disgusting kludge */
798 /* Run any load-hooks for this file. */
799 /* #### An even more disgusting kludge. There is horrible code */
800 /* that is relying on the fact that dumped lisp files are found */
801 /* via `load-path' search. */
802 Lisp_Object name = file;
804 if (!NILP(Ffile_name_absolute_p(file))) {
805 name = Ffile_name_nondirectory(file);
809 struct gcpro ngcpro1;
812 tem = Fassoc(name, Vafter_load_alist);
816 struct gcpro ngcpro1;
819 /* Use eval so that errors give a semi-meaningful
820 * backtrace. --Stig */
821 tem = Fcons(Qprogn, Fcdr(tem));
827 /*#ifdef DEBUG_SXEMACS*/
828 if (purify_flag && noninteractive) {
829 if (!EQ(last_file_loaded, file)) {
830 message("Loading %s ...done", XSTRING_DATA(file));
833 /*#endif / * DEBUG_SXEMACS */
835 if (!noninteractive) {
836 PRINT_LOADING_MESSAGE("done");
842 /* ------------------------------- */
844 /* ------------------------------- */
846 static int decode_mode_1(Lisp_Object mode)
848 if (EQ(mode, Qexists))
850 else if (EQ(mode, Qexecutable))
852 else if (EQ(mode, Qwritable))
854 else if (EQ(mode, Qreadable))
856 else if (INTP(mode)) {
857 check_int_range(XINT(mode), 0, 7);
860 signal_simple_error("Invalid value", mode);
861 return 0; /* unreached */
864 static int decode_mode(Lisp_Object mode)
868 else if (CONSP(mode)) {
871 EXTERNAL_LIST_LOOP(tail, mode)
872 mask |= decode_mode_1(XCAR(tail));
875 return decode_mode_1(mode);
878 DEFUN("locate-file", Flocate_file, 2, 4, 0, /*
879 Search for FILENAME through PATH-LIST.
880 If SUFFIXES is non-nil, it should be a list of suffixes to append to
881 file name when searching.
883 If MODE is non-nil, it should be a symbol or a list of symbol representing
884 requirements. Allowed symbols are `exists', `executable', `writable', and
885 `readable'. If MODE is nil, it defaults to `readable'.
887 Filenames are checked against `load-suppress-alist' to determine if they
890 `locate-file' keeps hash tables of the directories it searches through,
891 in order to speed things up. It tries valiantly to not get confused in
892 the face of a changing and unpredictable environment, but can occasionally
893 get tripped up. In this case, you will have to call
894 `locate-file-clear-hashing' to get it back on track. See that function
897 (filename, path_list, suffixes, mode))
899 /* This function can GC */
902 CHECK_STRING(filename);
904 if (LISTP(suffixes)) {
906 EXTERNAL_LIST_LOOP(tail, suffixes)
907 CHECK_STRING(XCAR(tail));
909 CHECK_STRING(suffixes);
911 locate_file(path_list, filename, suffixes, &tp, decode_mode(mode));
915 /* Recalculate the hash table for the given string. DIRECTORY should
916 better have been through Fexpand_file_name() by now. */
918 static Lisp_Object locate_file_refresh_hashing(Lisp_Object directory)
921 make_directory_hash_table((char *)XSTRING_DATA(directory));
924 Fputhash(directory, hash, Vlocate_file_hash_table);
928 /* find the hash table for the given directory, recalculating if necessary */
930 static Lisp_Object locate_file_find_directory_hash_table(Lisp_Object directory)
932 Lisp_Object hash = Fgethash(directory, Vlocate_file_hash_table, Qnil);
934 return locate_file_refresh_hashing(directory);
939 /* The SUFFIXES argument in any of the locate_file* functions can be
940 nil, a list, or a string (for backward compatibility), with the
943 a) nil - no suffix, just search for file name intact
944 (semantically different from "empty suffix list", which
945 would be meaningless.)
946 b) list - list of suffixes to append to file name. Each of these
948 c) string - colon-separated suffixes to append to file name (backward
951 All of this got hairy, so I decided to use a mapper. Calling a
952 function for each suffix shouldn't slow things down, since
953 locate_file is rarely called with enough suffixes for funcalls to
954 make any difference. */
956 /* Map FUN over SUFFIXES, as described above. FUN will be called with a
957 char * containing the current file name, and ARG. Mapping stops when
958 FUN returns non-zero. */
960 locate_file_map_suffixes(Lisp_Object filename, Lisp_Object suffixes,
961 int (*fun) (char *, void *), void *arg)
963 /* This function can GC */
967 /* Calculate maximum size of any filename made from
968 this path element/specified file name and any possible suffix. */
969 if (CONSP(suffixes)) {
970 /* We must traverse the list, so why not do it right. */
973 LIST_LOOP(tail, suffixes) {
974 if (XSTRING_LENGTH(XCAR(tail)) > max)
975 max = XSTRING_LENGTH(XCAR(tail));
977 } else if (NILP(suffixes))
980 /* Just take the easy way out */
981 max = XSTRING_LENGTH(suffixes);
983 fn_len = XSTRING_LENGTH(filename);
984 fn = (char *)alloca(max + fn_len + 1);
985 memcpy(fn, (char *)XSTRING_DATA(filename), fn_len);
987 /* Loop over suffixes. */
988 if (!STRINGP(suffixes)) {
989 if (NILP(suffixes)) {
990 /* Case a) discussed in the comment above. */
992 if ((*fun) (fn, arg))
997 LIST_LOOP(tail, suffixes) {
998 memcpy(fn + fn_len, XSTRING_DATA(XCAR(tail)),
999 XSTRING_LENGTH(XCAR(tail)));
1000 fn[fn_len + XSTRING_LENGTH(XCAR(tail))] = 0;
1001 if ((*fun) (fn, arg))
1007 const char *nsuffix = (const char *)XSTRING_DATA(suffixes);
1010 char *esuffix = (char *)strchr(nsuffix, ':');
1012 esuffix ? esuffix - nsuffix : (int)strlen(nsuffix);
1014 /* Concatenate path element/specified name with the suffix. */
1015 strncpy(fn + fn_len, nsuffix, lsuffix);
1016 fn[fn_len + lsuffix] = '\0';
1018 if ((*fun) (fn, arg))
1021 /* Advance to next suffix. */
1024 nsuffix += lsuffix + 1;
1029 struct locate_file_in_directory_mapper_closure {
1031 Lisp_Object *storeptr;
1035 static int locate_file_in_directory_mapper(char *fn, void *arg)
1037 struct locate_file_in_directory_mapper_closure *closure =
1038 (struct locate_file_in_directory_mapper_closure *)arg;
1041 /* Ignore file if it's a directory. */
1042 if (sxemacs_stat(fn, &st) >= 0 && (st.st_mode & S_IFMT) != S_IFDIR) {
1043 /* Check that we can access or open it. */
1044 if (closure->mode >= 0)
1045 closure->fd = access(fn, closure->mode);
1047 closure->fd = open(fn, O_RDONLY | OPEN_BINARY, 0);
1049 if (closure->fd >= 0) {
1050 if (!suppressedp(fn, Qnil)) {
1051 /* We succeeded; return this descriptor and
1053 if (closure->storeptr)
1054 *closure->storeptr = build_string(fn);
1056 /* If we actually opened the file, set
1057 close-on-exec flag on the new descriptor so
1058 that subprocesses can't whack at it. */
1059 if (closure->mode < 0)
1060 (void)fcntl(closure->fd,
1061 F_SETFD, FD_CLOEXEC);
1065 /* Avoid closing stdin upon success of
1066 access, where closure->fd would be
1067 0 but the file is not open on that
1080 /* look for STR in PATH, optionally adding SUFFIXES. DIRECTORY need
1081 not have been expanded. */
1084 locate_file_in_directory(Lisp_Object directory, Lisp_Object str,
1085 Lisp_Object suffixes, Lisp_Object * storeptr, int mode)
1087 /* This function can GC */
1088 struct locate_file_in_directory_mapper_closure closure;
1089 Lisp_Object filename = Qnil;
1090 struct gcpro gcpro1, gcpro2, gcpro3;
1092 GCPRO3(directory, str, filename);
1094 filename = Fexpand_file_name(str, directory);
1095 if (NILP(filename) || NILP(Ffile_name_absolute_p(filename)))
1096 /* If there are non-absolute elts in PATH (eg ".") */
1097 /* Of course, this could conceivably lose if luser sets
1098 default-directory to be something non-absolute ... */
1101 /* NIL means current directory */
1102 filename = current_buffer->directory;
1104 filename = Fexpand_file_name(filename,
1105 current_buffer->directory);
1106 if (NILP(Ffile_name_absolute_p(filename))) {
1107 /* Give up on this directory! */
1114 closure.storeptr = storeptr;
1115 closure.mode = mode;
1117 locate_file_map_suffixes(filename, suffixes,
1118 locate_file_in_directory_mapper, &closure);
1124 /* do the same as locate_file() but don't use any hash tables. */
1127 locate_file_without_hash(Lisp_Object path, Lisp_Object str,
1128 Lisp_Object suffixes, Lisp_Object * storeptr, int mode)
1130 /* This function can GC */
1131 int absolute = !NILP(Ffile_name_absolute_p(str));
1133 EXTERNAL_LIST_LOOP(path, path) {
1135 locate_file_in_directory(XCAR(path), str, suffixes,
1146 static int locate_file_construct_suffixed_files_mapper(char *fn, void *arg)
1148 Lisp_Object *tail = (Lisp_Object *) arg;
1149 *tail = Fcons(build_string(fn), *tail);
1153 /* Construct a list of all files to search for.
1154 It makes sense to have this despite locate_file_map_suffixes()
1155 because we need Lisp strings to access the hash-table, and it would
1156 be inefficient to create them on the fly, again and again for each
1157 path component. See locate_file(). */
1160 locate_file_construct_suffixed_files(Lisp_Object filename, Lisp_Object suffixes)
1162 Lisp_Object tail = Qnil;
1163 struct gcpro gcpro1;
1166 locate_file_map_suffixes(filename, suffixes,
1167 locate_file_construct_suffixed_files_mapper,
1171 return Fnreverse(tail);
1174 DEFUN("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
1175 Clear the hash records for the specified list of directories.
1176 `locate-file' uses a hashing scheme to speed lookup, and will correctly
1177 track the following environmental changes:
1179 -- changes of any sort to the list of directories to be searched.
1180 -- addition and deletion of non-shadowing files (see below) from the
1181 directories in the list.
1182 -- byte-compilation of a .el file into a .elc file.
1184 `locate-file' will primarily get confused if you add a file that shadows
1185 \(i.e. has the same name as) another file further down in the directory list.
1186 In this case, you must call `locate-file-clear-hashing'.
1188 If PATH is t, it means to fully clear all the accumulated hashes. This
1189 can be used if the internal tables grow too large, or when dumping.
1194 Fclrhash(Vlocate_file_hash_table);
1196 Lisp_Object pathtail;
1197 EXTERNAL_LIST_LOOP(pathtail, path) {
1198 Lisp_Object pathel =
1199 Fexpand_file_name(XCAR(pathtail), Qnil);
1200 Fremhash(pathel, Vlocate_file_hash_table);
1206 /* Search for a file whose name is STR, looking in directories
1207 in the Lisp list PATH, and trying suffixes from SUFFIXES.
1208 SUFFIXES is a list of possible suffixes, or (for backward
1209 compatibility) a string containing possible suffixes separated by
1211 On success, returns a file descriptor. On failure, returns -1.
1213 MODE nonnegative means don't open the files,
1214 just look for one for which access(file,MODE) succeeds. In this case,
1215 returns a nonnegative value on success. On failure, returns -1.
1217 If STOREPTR is nonzero, it points to a slot where the name of
1218 the file actually found should be stored as a Lisp string.
1219 Nil is stored there on failure.
1221 Called openp() in FSFmacs. */
1224 locate_file(Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1225 Lisp_Object * storeptr, int mode)
1227 /* This function can GC */
1228 Lisp_Object suffixtab = Qnil;
1229 Lisp_Object pathtail, pathel_expanded;
1231 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1236 /* Is it really necessary to gcpro path and str? It shouldn't be
1237 unless some caller has fucked up. There are known instances that
1238 call us with build_string("foo:bar") as SUFFIXES, though. */
1239 GCPRO4(path, str, suffixes, suffixtab);
1241 /* if this filename has directory components, it's too complicated
1242 to try and use the hash tables. */
1243 if (!NILP(Ffile_name_directory(str))) {
1245 locate_file_without_hash(path, str, suffixes, storeptr,
1251 suffixtab = locate_file_construct_suffixed_files(str, suffixes);
1253 EXTERNAL_LIST_LOOP(pathtail, path) {
1254 Lisp_Object pathel = XCAR(pathtail);
1255 Lisp_Object hash_table;
1259 /* If this path element is relative, we have to look by hand. */
1260 if (NILP(pathel) || NILP(Ffile_name_absolute_p(pathel))) {
1262 locate_file_in_directory(pathel, str, suffixes,
1271 pathel_expanded = Fexpand_file_name(pathel, Qnil);
1273 locate_file_find_directory_hash_table(pathel_expanded);
1275 if (!NILP(hash_table)) {
1276 /* Loop over suffixes. */
1277 LIST_LOOP(tail, suffixtab)
1278 if (!NILP(Fgethash(XCAR(tail), hash_table, Qnil))) {
1285 /* This is a likely candidate. Look by hand in this directory
1286 so we don't get thrown off if someone byte-compiles a file. */
1288 locate_file_in_directory(pathel, str, suffixes,
1295 /* Hmm ... the file isn't actually there. (Or possibly it's
1296 a directory ...) So refresh our hashing. */
1297 locate_file_refresh_hashing(pathel_expanded);
1301 /* File is probably not there, but check the hard way just in case. */
1302 val = locate_file_without_hash(path, str, suffixes, storeptr, mode);
1304 /* Sneaky user added a file without telling us. */
1305 Flocate_file_clear_hashing(path);
1314 /* Merge the list we've accumulated of globals from the current input source
1315 into the load_history variable. The details depend on whether
1316 the source has an associated file name or not. */
1318 static void build_load_history(int loading, Lisp_Object source)
1320 REGISTER Lisp_Object tail, prev, newelt;
1321 REGISTER Lisp_Object tem, tem2;
1324 #if !defined(LOADHIST_DUMPED)
1325 /* Don't bother recording anything for preloaded files. */
1330 tail = Vload_history;
1333 while (!NILP(tail)) {
1336 /* Find the feature's previous assoc list... */
1337 if (internal_equal(source, Fcar(tem), 0)) {
1340 /* If we're loading, remove it. */
1343 Vload_history = Fcdr(tail);
1345 Fsetcdr(prev, Fcdr(tail));
1348 /* Otherwise, cons on new symbols that are not already members. */
1350 tem2 = Vcurrent_load_list;
1352 while (CONSP(tem2)) {
1353 newelt = XCAR(tem2);
1355 if (NILP(Fmemq(newelt, tem)))
1356 Fsetcar(tail, Fcons(Fcar(tem),
1372 /* If we're loading, cons the new assoc onto the front of load-history,
1373 the most-recently-loaded position. Also do this if we didn't find
1374 an existing member for the current source. */
1375 if (loading || !foundit)
1376 Vload_history = Fcons(Fnreverse(Vcurrent_load_list),
1380 #else /* !LOADHIST */
1381 #define build_load_history(x,y)
1382 #endif /* !LOADHIST */
1384 #if 0 /* FSFmacs defun hack */
1385 Lisp_Object unreadpure(void)
1386 { /* Used as unwind-protect function in readevalloop */
1393 readevalloop(Lisp_Object readcharfun,
1394 Lisp_Object sourcename,
1395 Lisp_Object(*evalfun) (Lisp_Object), int printflag)
1397 /* This function can GC */
1399 REGISTER Lisp_Object val = Qnil;
1400 int speccount = specpdl_depth();
1401 struct gcpro gcpro1, gcpro2;
1402 struct buffer *b = 0;
1404 if (BUFFERP(readcharfun))
1405 b = XBUFFER(readcharfun);
1406 else if (MARKERP(readcharfun))
1407 b = XMARKER(readcharfun)->buffer;
1409 /* Don't do this. It is not necessary, and it needlessly exposes
1410 READCHARFUN (which can be a stream) to Lisp. --hniksic */
1411 /*specbind (Qstandard_input, readcharfun); */
1413 specbind(Qcurrent_load_list, Qnil);
1415 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1416 Vcurrent_compiled_function_annotation = Qnil;
1418 GCPRO2(val, sourcename);
1420 LOADHIST_ATTACH(sourcename);
1425 if (b != 0 && !BUFFER_LIVE_P(b))
1426 error("Reading from killed buffer");
1428 c = readchar(readcharfun);
1431 while ((c = readchar(readcharfun)) != '\n' && c != -1)
1438 /* Ignore whitespace here, so we can detect eof. */
1439 if (c == ' ' || c == '\t' || c == '\n' || c == '\f'
1443 #if 0 /* FSFmacs defun hack */
1444 if (purify_flag && c == '(') {
1445 int count1 = specpdl_depth();
1446 record_unwind_protect(unreadpure, Qnil);
1447 val = read_list(readcharfun, ')', -1, 1);
1448 unbind_to(count1, Qnil);
1450 #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
1452 unreadchar(readcharfun, c);
1453 Vread_objects = Qnil;
1454 if (NILP(Vload_read_function))
1455 val = read0(readcharfun);
1457 val = call1(Vload_read_function, readcharfun);
1460 val = (*evalfun) (val);
1462 Vvalues = Fcons(val, Vvalues);
1463 if (EQ(Vstandard_output, Qt))
1470 build_load_history(LSTREAMP(readcharfun) ||
1471 /* This looks weird, but it's what's in FSFmacs */
1472 (b ? BUF_NARROWED(b) : BUF_NARROWED(current_buffer)),
1476 unbind_to(speccount, Qnil);
1479 DEFUN("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /*
1480 Execute BUFFER as Lisp code.
1481 Programs can pass two arguments, BUFFER and PRINTFLAG.
1482 BUFFER is the buffer to evaluate (nil means use current buffer).
1483 PRINTFLAG controls printing of output:
1484 nil means discard it; anything else is a stream for printing.
1486 If there is no error, point does not move. If there is an error,
1487 point remains at the end of the last character read from the buffer.
1489 (buffer, printflag))
1491 /* This function can GC */
1492 int speccount = specpdl_depth();
1493 Lisp_Object tem, buf;
1496 buf = Fcurrent_buffer();
1498 buf = Fget_buffer(buffer);
1500 error("No such buffer.");
1502 if (NILP(printflag))
1503 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1506 specbind(Qstandard_output, tem);
1507 record_unwind_protect(save_excursion_restore, save_excursion_save());
1508 BUF_SET_PT(XBUFFER(buf), BUF_BEGV(XBUFFER(buf)));
1509 readevalloop(buf, XBUFFER(buf)->filename, Feval, !NILP(printflag));
1511 return unbind_to(speccount, Qnil);
1515 xxDEFUN("eval-current-buffer", Feval_current_buffer, 0, 1, "", /*
1516 Execute the current buffer as Lisp code.
1517 Programs can pass argument PRINTFLAG which controls printing of output:
1518 nil means discard it; anything else is stream for print.
1520 If there is no error, point does not move. If there is an error,
1521 point remains at the end of the last character read from the buffer.
1528 DEFUN("eval-region", Feval_region, 2, 3, "r", /*
1529 Execute the region as Lisp code.
1530 When called from programs, expects two arguments START and END
1531 giving starting and ending indices in the current buffer
1532 of the text to be executed.
1533 Programs can pass third optional argument STREAM which controls output:
1534 nil means discard it; anything else is stream for printing it.
1536 If there is no error, point does not move. If there is an error,
1537 point remains at the end of the last character read from the buffer.
1539 Note: Before evaling the region, this function narrows the buffer to it.
1540 If the code being eval'd should happen to trigger a redisplay you may
1541 see some text temporarily disappear because of this.
1543 (start, end, stream))
1545 /* This function can GC */
1546 int speccount = specpdl_depth();
1548 Lisp_Object cbuf = Fcurrent_buffer();
1551 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1554 specbind(Qstandard_output, tem);
1557 record_unwind_protect(save_excursion_restore,
1558 save_excursion_save());
1559 record_unwind_protect(save_restriction_restore,
1560 save_restriction_save());
1562 /* This both uses start and checks its type. */
1563 Fgoto_char(start, cbuf);
1564 Fnarrow_to_region(make_int(BUF_BEGV(current_buffer)), end, cbuf);
1565 readevalloop(cbuf, XBUFFER(cbuf)->filename, Feval, !NILP(stream));
1567 return unbind_to(speccount, Qnil);
1570 DEFUN("read", Fread, 0, 1, 0, /*
1571 Read one Lisp expression as text from STREAM, return as Lisp object.
1572 If STREAM is nil, use the value of `standard-input' (which see).
1573 STREAM or the value of `standard-input' may be:
1574 a buffer (read from point and advance it)
1575 a marker (read from where it points and advance it)
1576 a function (call it with no arguments for each character,
1577 call it with a char as argument to push a char back)
1578 a string (takes text from string, starting at the beginning)
1579 t (read text line using minibuffer and use it).
1584 stream = Vstandard_input;
1586 stream = Qread_char;
1588 Vread_objects = Qnil;
1590 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1591 Vcurrent_compiled_function_annotation = Qnil;
1593 if (EQ(stream, Qread_char)) {
1594 Lisp_Object val = call1(Qread_from_minibuffer,
1595 build_translated_string
1596 ("Lisp expression: "));
1597 return Fcar(Fread_from_string(val, Qnil, Qnil));
1600 if (STRINGP(stream))
1601 return Fcar(Fread_from_string(stream, Qnil, Qnil));
1603 return read0(stream);
1606 DEFUN("read-from-string", Fread_from_string, 1, 3, 0, /*
1607 Read one Lisp expression which is represented as text by STRING.
1608 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1609 START and END optionally delimit a substring of STRING from which to read;
1610 they default to 0 and (length STRING) respectively.
1612 (string, start, end))
1614 Bytecount startval, endval;
1616 Lisp_Object lispstream = Qnil;
1617 struct gcpro gcpro1;
1619 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1620 Vcurrent_compiled_function_annotation = Qnil;
1623 CHECK_STRING(string);
1624 get_string_range_byte(string, start, end, &startval, &endval,
1625 GB_HISTORICAL_STRING_BEHAVIOR);
1626 lispstream = make_lisp_string_input_stream(string, startval,
1629 Vread_objects = Qnil;
1631 tem = read0(lispstream);
1632 /* Yeah, it's ugly. Gonna make something of it?
1633 At least our reader is reentrant ... */
1635 (Fcons(tem, make_int
1636 (bytecount_to_charcount
1637 (XSTRING_DATA(string),
1638 startval + Lstream_byte_count(XLSTREAM(lispstream))))));
1639 Lstream_delete(XLSTREAM(lispstream));
1645 ureader_find(Lisp_Object name)
1647 return Fcdr(Fassoc(name, Vureaders));
1652 * ureader_read() assumes that input starts with < character and
1653 * should finish on matching > character.
1656 ureader_read(Lisp_Object ureader_fun, Lisp_Object readcharfun)
1659 unsigned int oparens = 0;
1660 struct gcpro gcpro1;
1663 Lstream_rewind(XLSTREAM(Vread_buffer_stream));
1664 while ((c = readchar(readcharfun)) >= 0) {
1667 else if (c == '>') {
1669 /* We got final closing paren */
1674 Lstream_put_emchar(XLSTREAM (Vread_buffer_stream), c);
1678 return Fsignal(Qend_of_file,
1679 list1(READCHARFUN_MAYBE(readcharfun)));
1681 Lstream_flush(XLSTREAM(Vread_buffer_stream));
1683 instr = make_string(resizing_buffer_stream_ptr
1684 (XLSTREAM(Vread_buffer_stream)),
1685 Lstream_byte_count(XLSTREAM(Vread_buffer_stream)));
1687 RETURN_UNGCPRO(call1(ureader_fun, instr));
1691 #ifdef LISP_BACKQUOTES
1693 static Lisp_Object backquote_unwind(Lisp_Object ptr)
1694 { /* used as unwind-protect function in read0() */
1695 int *counter = (int *)get_opaque_ptr(ptr);
1698 free_opaque_ptr(ptr);
1704 /* Use this for recursive reads, in contexts where internal tokens
1705 are not allowed. See also read1(). */
1706 static Lisp_Object read0(Lisp_Object readcharfun)
1708 Lisp_Object val = read1(readcharfun);
1710 if (CONSP(val) && UNBOUNDP(XCAR(val))) {
1711 Emchar c = XCHAR(XCDR(val));
1712 free_cons(XCONS(val));
1713 return Fsignal(Qinvalid_read_syntax,
1714 list1(Fchar_to_string(make_char(c))));
1720 static Emchar read_escape(Lisp_Object readcharfun)
1722 /* This function can GC */
1723 Emchar c = readchar(readcharfun);
1726 signal_error(Qend_of_file,
1727 list1(READCHARFUN_MAYBE(readcharfun)));
1752 c = readchar(readcharfun);
1754 signal_error(Qend_of_file,
1755 list1(READCHARFUN_MAYBE(readcharfun)));
1757 error("Invalid escape character syntax");
1758 c = readchar(readcharfun);
1760 signal_error(Qend_of_file,
1761 list1(READCHARFUN_MAYBE(readcharfun)));
1763 c = read_escape(readcharfun);
1766 /* Originally, FSF_KEYS provided a degree of FSF Emacs
1767 compatibility by defining character "modifiers" alt, super,
1768 hyper and shift to infest the characters (i.e. integers).
1770 However, this doesn't cut it for XEmacs 20, which
1771 distinguishes characters from integers. Without Mule, ?\H-a
1772 simply returns ?a because every character is clipped into
1773 0-255. Under Mule it is much worse -- ?\H-a with FSF_KEYS
1774 produces an illegal character, and moves us to crash-land.
1776 For these reasons, FSF_KEYS hack is useless and without hope
1777 of ever working under XEmacs 20. */
1781 #define alt_modifier (0x040000)
1782 #define super_modifier (0x080000)
1783 #define hyper_modifier (0x100000)
1784 #define shift_modifier (0x200000)
1785 /* fsf uses a different modifiers for meta and control. Possibly
1786 byte_compiled code will still work fsfmacs, though... --Stig
1788 #define ctl_modifier (0x400000)
1789 #define meta_modifier (0x800000)
1791 #define FSF_LOSSAGE(mask) \
1792 if (fail_on_bucky_bit_character_escapes || \
1793 ((c = readchar (readcharfun)) != '-')) \
1794 error ("Invalid escape character syntax"); \
1795 c = readchar (readcharfun); \
1797 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun))); \
1799 c = read_escape (readcharfun); \
1803 FSF_LOSSAGE(shift_modifier);
1805 FSF_LOSSAGE(hyper_modifier);
1807 FSF_LOSSAGE(alt_modifier);
1809 FSF_LOSSAGE(super_modifier);
1811 #undef super_modifier
1812 #undef hyper_modifier
1813 #undef shift_modifier
1816 #endif /* FSF_KEYS */
1819 c = readchar(readcharfun);
1821 signal_error(Qend_of_file,
1822 list1(READCHARFUN_MAYBE(readcharfun)));
1824 error("Invalid escape character syntax");
1826 c = readchar(readcharfun);
1828 signal_error(Qend_of_file,
1829 list1(READCHARFUN_MAYBE(readcharfun)));
1831 c = read_escape(readcharfun);
1832 /* FSFmacs junk for non-ASCII controls.
1837 return c & (0200 | 037);
1847 /* An octal escape, as in ANSI C. */
1849 REGISTER Emchar i = c - '0';
1850 REGISTER int count = 0;
1851 while (++count < 3) {
1852 if ((c = readchar(readcharfun)) >= '0'
1854 i = (i << 3) + (c - '0');
1856 unreadchar(readcharfun, c);
1864 /* A hex escape, as in ANSI C, except that we only allow latin-1
1865 characters to be read this way. What is "\x4e03" supposed to
1866 mean, anyways, if the internal representation is hidden?
1867 This is also consistent with the treatment of octal escapes. */
1869 REGISTER Emchar i = 0;
1870 REGISTER int count = 0;
1871 while (++count <= 2) {
1872 c = readchar(readcharfun);
1873 /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
1874 if (c >= '0' && c <= '9')
1875 i = (i << 4) + (c - '0');
1876 else if (c >= 'a' && c <= 'f')
1877 i = (i << 4) + (c - 'a') + 10;
1878 else if (c >= 'A' && c <= 'F')
1879 i = (i << 4) + (c - 'A') + 10;
1881 unreadchar(readcharfun, c);
1889 /* #### need some way of reading an extended character with
1890 an escape sequence. */
1898 /* read symbol-constituent stuff into `Vread_buffer_stream'. */
1900 read_atom_0(Lisp_Object readcharfun, Emchar firstchar, int *saw_a_backslash)
1902 /* This function can GC */
1903 Emchar c = ((firstchar) >= 0 ? firstchar : readchar(readcharfun));
1904 Lstream_rewind(XLSTREAM(Vread_buffer_stream));
1906 *saw_a_backslash = 0;
1908 while (c > 040 /* #### - comma should be here as should backquote */
1909 && !(c == '\"' || c == '\'' || c == ';' || c == '(' || c == ')'
1910 #ifndef HAVE_FPFLOAT
1911 /* If we have floating-point support, then we need
1912 to allow <digits><dot><digits>. */
1914 #endif /* not HAVE_FPFLOAT */
1915 || c == '[' || c == ']' || c == '#')) {
1917 c = readchar(readcharfun);
1919 signal_error(Qend_of_file,
1920 list1(READCHARFUN_MAYBE
1922 *saw_a_backslash = 1;
1924 Lstream_put_emchar(XLSTREAM(Vread_buffer_stream), c);
1926 c = readchar(readcharfun);
1930 unreadchar(readcharfun, c);
1931 /* blasted terminating 0 */
1932 Lstream_put_emchar(XLSTREAM(Vread_buffer_stream), 0);
1933 Lstream_flush(XLSTREAM(Vread_buffer_stream));
1935 return Lstream_byte_count(XLSTREAM(Vread_buffer_stream)) - 1;
1938 static Lisp_Object parse_integer(const Bufbyte * buf, Bytecount len, int base);
1941 read_atom(Lisp_Object readcharfun, Emchar firstchar, int uninterned_symbol)
1943 /* This function can GC */
1944 int saw_a_backslash;
1945 Bytecount len = read_atom_0(readcharfun, firstchar, &saw_a_backslash);
1946 char *read_ptr = (char *)
1947 resizing_buffer_stream_ptr(XLSTREAM(Vread_buffer_stream));
1949 /* Is it an integer? */
1950 if (!(saw_a_backslash || uninterned_symbol)) {
1951 /* If a token had any backslashes in it, it is disqualified from
1952 being an integer or a float. This means that 123\456 is a
1953 symbol, as is \123 (which is the way (intern "123") prints).
1954 Also, if token was preceded by #:, it's always a symbol.
1956 char *p = read_ptr + len;
1957 char *p1 = read_ptr;
1959 if (*p1 == '+' || *p1 == '-')
1964 while (p1 != p && (c = *p1) >= '0' && c <= '9')
1967 /* Integers can have trailing decimal points. */
1968 if (p1 > read_ptr && p1 < p && *p1 == '.')
1972 /* It is an integer. */
1977 return parse_integer((Bufbyte*)read_ptr, len,
1981 #if defined HAVE_MPQ && defined WITH_GMP
1982 if (isbigq_string(read_ptr))
1983 return read_bigq_string(read_ptr);
1985 #if defined HAVE_MPFR && defined WITH_MPFR
1986 if (isfloat_string(read_ptr) && (Vread_real_as == Qbigfr))
1987 return read_bigfr_string(read_ptr);
1988 #endif /* HAVE_MPFR */
1989 #if defined HAVE_MPF && defined WITH_GMP
1990 if (isfloat_string(read_ptr) && (Vread_real_as == Qbigf))
1991 return read_bigf_string(read_ptr);
1993 #endif /* HAVE_MPF */
1995 if (isfloat_string(read_ptr)) {
1996 return make_float(str_to_fpfloat(read_ptr));
1999 #if defined HAVE_PSEUG && defined WITH_PSEUG
2000 if (isgaussian_string(read_ptr))
2001 return read_bigg_string(read_ptr);
2003 #if defined HAVE_MPC && defined WITH_MPC || \
2004 defined HAVE_PSEUC && defined WITH_PSEUC
2005 if (isbigc_string(read_ptr))
2006 return read_bigc_string(read_ptr);
2007 #endif /* HAVE_MPC */
2008 #if defined HAVE_QUATERN && defined WITH_QUATERN
2009 if (isquatern_string(read_ptr))
2010 return read_quatern_string(read_ptr);
2014 /* check for resclass syntax */
2015 if (ase_resc_rng_pred_f && ase_resc_rng_f &&
2016 ase_resc_rng_pred_f(read_ptr))
2017 return ase_resc_rng_f(read_ptr);
2018 if (ase_resc_elm_pred_f && ase_resc_elm_f &&
2019 ase_resc_elm_pred_f(read_ptr))
2020 return ase_resc_elm_f(read_ptr);
2024 if (uninterned_symbol)
2026 Fmake_symbol(make_string
2027 ((Bufbyte *) read_ptr, len));
2030 make_string((Bufbyte *) read_ptr, len);
2031 sym = Fintern(name, Qnil);
2038 parse_integer(const Bufbyte * buf, Bytecount len, int base)
2040 const Bufbyte *lim = buf + len;
2041 const Bufbyte *p = buf;
2043 int negativland = 0;
2048 } else if (*p == '+') {
2055 for (; (p < lim) && (*p != '\0'); p++) {
2061 else if (isupper(c))
2063 else if (islower(c))
2068 if (c < 0 || c >= base)
2072 num = num * base + c;
2078 EMACS_INT int_result =
2079 negativland ? -(EMACS_INT) num : (EMACS_INT) num;
2080 Lisp_Object result = make_int(int_result);
2081 if (num && ((XINT(result) < 0) != negativland))
2083 if (XINT(result) != int_result)
2088 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_BSDMP)
2089 return read_bigz_string((const char*)buf, base);
2091 /* This is going to kill us!
2092 * Big integers cannot be used anywhere if the reader rewards
2093 * their occurence that harshly
2095 return Fsignal(Qinvalid_read_syntax,
2096 list3(build_translated_string
2097 ("Integer constant overflow in reader"),
2098 make_string(buf, len), make_int(base)));
2100 warn_when_safe(Qinvalid_read_syntax, Qwarning,
2101 "Integer constant overflow in reader: %s,"
2102 " proceeding nervously with 0.",
2105 #endif /* HAVE_MPZ && WITH_GMP||WITH_BSDMP */
2107 return Fsignal(Qinvalid_read_syntax,
2108 list3(build_translated_string
2109 ("Invalid integer constant in reader"),
2110 make_string(buf, len), make_int(base)));
2114 read_integer(Lisp_Object readcharfun, int base)
2116 /* This function can GC */
2117 int saw_a_backslash;
2118 Bytecount len = read_atom_0(readcharfun, -1, &saw_a_backslash);
2119 return (parse_integer
2120 (resizing_buffer_stream_ptr(XLSTREAM(Vread_buffer_stream)),
2122 ? 0 /* make parse_integer signal error */
2127 read_bit_vector(Lisp_Object readcharfun)
2129 unsigned_char_dynarr *dyn = Dynarr_new(unsigned_char);
2134 Emchar c = readchar(readcharfun);
2141 unreadchar(readcharfun, c);
2144 Dynarr_add(dyn, bit);
2147 val = make_bit_vector_from_byte_vector(Dynarr_atp(dyn, 0),
2148 Dynarr_length(dyn));
2156 struct structure_type*
2157 define_structure_type(Lisp_Object type,
2158 int(*validate)(Lisp_Object data, Error_behavior errb),
2159 Lisp_Object(*instantiate)(Lisp_Object data))
2161 struct structure_type st;
2164 st.keywords = Dynarr_new(structure_keyword_entry);
2165 st.validate = validate;
2166 st.instantiate = instantiate;
2167 Dynarr_add(the_structure_type_dynarr, st);
2169 return Dynarr_atp(the_structure_type_dynarr,
2170 Dynarr_length(the_structure_type_dynarr) - 1);
2174 define_structure_type_keyword(struct structure_type *st, Lisp_Object keyword,
2175 int (*validate) (Lisp_Object keyword,
2177 Error_behavior errb))
2179 struct structure_keyword_entry en;
2181 en.keyword = keyword;
2182 en.validate = validate;
2183 Dynarr_add(st->keywords, en);
2186 static struct structure_type*
2187 recognized_structure_type(Lisp_Object type)
2191 for (i = 0; i < Dynarr_length(the_structure_type_dynarr); i++) {
2192 struct structure_type *st =
2193 Dynarr_atp(the_structure_type_dynarr, i);
2194 if (EQ(st->type, type))
2202 read_structure(Lisp_Object readcharfun)
2204 Emchar c = readchar(readcharfun);
2205 Lisp_Object list = Qnil;
2206 Lisp_Object orig_list = Qnil;
2207 Lisp_Object already_seen = Qnil;
2209 struct structure_type *st;
2210 struct gcpro gcpro1, gcpro2;
2212 GCPRO2(orig_list, already_seen);
2214 RETURN_UNGCPRO(continuable_read_syntax_error
2215 ("#s not followed by paren"));
2216 list = read_list(readcharfun, ')', 0, 0);
2219 int len = XINT(Flength(list));
2221 RETURN_UNGCPRO(continuable_read_syntax_error
2222 ("structure type not specified"));
2225 (continuable_read_syntax_error
2226 ("structures must have alternating keyword/value pairs"));
2229 st = recognized_structure_type(XCAR(list));
2231 RETURN_UNGCPRO(Fsignal(Qinvalid_read_syntax,
2232 list2(build_translated_string
2233 ("unrecognized structure type"),
2237 keyword_count = Dynarr_length(st->keywords);
2238 while (!NILP(list)) {
2239 Lisp_Object keyword, value;
2241 struct structure_keyword_entry *en = NULL;
2243 keyword = Fcar(list);
2248 if (!NILP(memq_no_quit(keyword, already_seen)))
2249 RETURN_UNGCPRO(Fsignal(Qinvalid_read_syntax,
2250 list2(build_translated_string
2251 ("structure keyword already seen"),
2254 for (i = 0; i < keyword_count; i++) {
2255 en = Dynarr_atp(st->keywords, i);
2256 if (EQ(keyword, en->keyword))
2260 if (i == keyword_count)
2261 RETURN_UNGCPRO(Fsignal(Qinvalid_read_syntax,
2262 list2(build_translated_string
2263 ("unrecognized structure keyword"),
2266 if (en->validate && !(en->validate) (keyword, value, ERROR_ME))
2268 (Fsignal(Qinvalid_read_syntax,
2269 list3(build_translated_string
2270 ("invalid value for structure keyword"),
2273 already_seen = Fcons(keyword, already_seen);
2276 if (st->validate && !(st->validate) (orig_list, ERROR_ME))
2277 RETURN_UNGCPRO(Fsignal(Qinvalid_read_syntax,
2278 list2(build_translated_string
2279 ("invalid structure initializer"),
2282 RETURN_UNGCPRO((st->instantiate) (XCDR(orig_list)));
2285 static Lisp_Object read_compiled_function(Lisp_Object readcharfun, int);
2286 static Lisp_Object read_vector(Lisp_Object readcharfun, int terminator);
2288 /* Get the next character; filter out whitespace and comments */
2291 reader_nextchar(Lisp_Object readcharfun)
2293 /* This function can GC */
2298 c = readchar(readcharfun);
2300 signal_error(Qend_of_file,
2301 list1(READCHARFUN_MAYBE(readcharfun)));
2306 /* Ignore whitespace and control characters */
2315 while ((c = readchar(readcharfun)) >= 0 && c != '\n')
2323 static Lisp_Object list2_pure(int pure, Lisp_Object a, Lisp_Object b)
2325 return pure ? pure_cons(a, pure_cons(b, Qnil)) : list2(a, b);
2329 /* Read the next Lisp object from the stream READCHARFUN and return it.
2330 If the return value is a cons whose car is Qunbound, then read1()
2331 encountered a misplaced token (e.g. a right bracket, right paren,
2332 or dot followed by a non-number). To filter this stuff out,
2336 read_string(Lisp_Object readcharfun, Emchar delim, int raw)
2339 /* #### If the input stream is translating, then the string
2340 should be marked as translatable by setting its
2341 `string-translatable' property to t. .el and .elc files
2342 normally are translating input streams. See Fgettext()
2343 and print_internal(). */
2348 Lstream_rewind(XLSTREAM(Vread_buffer_stream));
2349 while ((c = readchar(readcharfun)) >= 0 && c != delim) {
2352 /* For raw strings, insert the
2353 backslash and the next char, */
2355 XLSTREAM(Vread_buffer_stream), c);
2356 c = readchar(readcharfun);
2358 /* otherwise, backslash escapes the next char */
2359 c = read_escape(readcharfun);
2362 /* c is -1 if \ newline has just been seen */
2364 if (!Lstream_byte_count(XLSTREAM(Vread_buffer_stream))) {
2368 Lstream_put_emchar(XLSTREAM
2369 (Vread_buffer_stream),
2375 return Fsignal(Qend_of_file,
2376 list1(READCHARFUN_MAYBE(readcharfun)));
2379 /* If purifying, and string starts with \ newline,
2380 return zero instead. This is for doc strings
2381 that we are really going to find in lib-src/DOC.nn.nn */
2382 if (purify_flag && NILP(Vinternal_doc_file_name) && cancel) {
2386 Lstream_flush(XLSTREAM(Vread_buffer_stream));
2387 return make_string(resizing_buffer_stream_ptr
2388 (XLSTREAM(Vread_buffer_stream)),
2389 Lstream_byte_count(XLSTREAM(Vread_buffer_stream)));
2393 read_raw_string(Lisp_Object readcharfun)
2396 c = reader_nextchar(readcharfun);
2398 /* #r:engine"my sexy raw string" -- raw string w/ flags*/
2400 /* #r"my raw string" -- raw string */
2402 return read_string(readcharfun, '\"', 1);
2403 /* invalid syntax */
2405 unreadchar(readcharfun, c);
2406 return Fsignal(Qinvalid_read_syntax,
2408 ("unrecognized raw string syntax")));
2414 read1(Lisp_Object readcharfun)
2419 c = reader_nextchar(readcharfun);
2423 #ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
2424 /* if this is disabled, then other code in eval.c must be
2426 Emchar ch = reader_nextchar(readcharfun);
2430 int speccount = specpdl_depth();
2431 ++old_backquote_flag;
2432 record_unwind_protect(backquote_unwind,
2434 (&old_backquote_flag));
2435 tem = read0(readcharfun);
2436 unbind_to(speccount, Qnil);
2437 ch = reader_nextchar(readcharfun);
2439 unreadchar(readcharfun, ch);
2442 (Qinvalid_read_syntax,
2444 ("Weird old-backquote syntax")));
2446 return list2(Qbacktick, tem);
2449 if (old_backquote_flag) {
2450 Lisp_Object tem, comma_type;
2451 ch = readchar(readcharfun);
2453 comma_type = Qcomma_at;
2459 comma_type = Qcomma;
2461 tem = read0(readcharfun);
2462 ch = reader_nextchar
2465 unreadchar(readcharfun,
2468 Qinvalid_read_syntax,
2470 ("Weird old-backquote "
2473 return list2(comma_type, tem);
2475 unreadchar(readcharfun, ch);
2479 (Qinvalid_read_syntax,
2481 ("Comma outside of backquote")));
2483 /* #### - yuck....but this is reverse
2485 /* mostly this is required by edebug, which does
2486 its own annotated reading. We need to have
2487 an annotated_read function that records (with
2488 markers) the buffer positions of the elements
2489 that make up lists, then that can be used in
2490 edebug and bytecomp and the check above can
2491 go back in. --Stig */
2497 unreadchar(readcharfun, ch);
2499 #endif /* old backquote crap... */
2500 return read_list(readcharfun, ')', 1, 1);
2503 return read_vector(readcharfun, ']');
2507 /* #### - huh? these don't do what they seem... */
2508 return noseeum_cons(Qunbound, make_char(c));
2511 /* If a period is followed by a number, then we should read it
2512 as a floating point number. Otherwise, it denotes a dotted
2515 c = readchar(readcharfun);
2516 unreadchar(readcharfun, c);
2518 /* Can't use isdigit on Emchars */
2519 if (c < '0' || c > '9')
2520 return noseeum_cons(Qunbound, make_char('.'));
2522 /* Note that read_atom will loop
2523 at least once, assuring that we will not try to UNREAD
2524 two characters in a row.
2525 (I think this doesn't matter anymore because there should
2526 be no more danger in unreading multiple characters) */
2527 return read_atom(readcharfun, '.', 0);
2529 #else /* ! HAVE_FPFLOAT */
2530 return noseeum_cons(Qunbound, make_char('.'));
2531 #endif /* ! HAVE_FPFLOAT */
2535 c = readchar(readcharfun);
2537 #if 0 /* FSFmacs silly char-table syntax */
2540 #if 0 /* FSFmacs silly bool-vector syntax */
2543 /* "#["-- byte-code constant syntax */
2544 /* purecons #[...] syntax */
2546 return read_compiled_function(readcharfun, ']'
2549 /* "#:"-- gensym syntax */
2551 return read_atom(readcharfun, -1, 1);
2552 /* #'x => (function x) */
2554 return list2(Qfunction, read0(readcharfun));
2556 /* RMS uses this syntax for fat-strings.
2557 If we use it for vectors, then obscure bugs happen.
2559 /* "#(" -- Scheme/CL vector syntax */
2561 return read_vector(readcharfun, ')');
2564 /* When are we going to drop this crap??? -hroptatyr */
2567 struct gcpro gcpro1;
2569 /* Read the string itself. */
2570 tmp = read1(readcharfun);
2571 if (!STRINGP(tmp)) {
2573 && UNBOUNDP(XCAR(tmp)))
2574 free_cons(XCONS(tmp));
2577 (Qinvalid_read_syntax,
2578 list1(build_string("#")));
2581 /* Read the intervals and their properties. */
2583 Lisp_Object beg, end, plist;
2587 beg = read1(readcharfun);
2588 if (CONSP(beg) && UNBOUNDP(XCAR(beg))) {
2589 ch = XCHAR(XCDR(beg));
2590 free_cons(XCONS(beg));
2601 UNBOUNDP(XCAR(end)))
2623 (Qinvalid_read_syntax,
2629 Fset_text_properties(beg, end, plist, tmp);
2636 /* #@NUMBER is used to skip NUMBER following characters.
2637 That's used in .elc files to skip over doc strings
2638 and function definitions. */
2641 /* Read a decimal integer. */
2642 while ((c = readchar(readcharfun)) >= 0
2643 && c >= '0' && c <= '9')
2645 (10 * nskip) + (c - '0');
2647 unreadchar(readcharfun, c);
2649 /* FSF has code here that maybe caches the skipped
2650 string. See above for why this is totally
2651 losing. We handle this differently. */
2653 /* Skip that many characters. */
2654 for (i = 0; i < nskip && c >= 0; i++)
2655 c = readchar(readcharfun);
2660 return Vload_file_name_internal;
2663 return read_bit_vector(readcharfun);
2664 /* #o10 => 8 -- octal constant syntax */
2666 return read_integer(readcharfun, 8);
2667 /* #xdead => 57005 -- hex constant syntax */
2669 return read_integer(readcharfun, 16);
2670 /* #b010 => 2 -- binary constant syntax */
2672 return read_integer(readcharfun, 2);
2675 Emchar _c_ = reader_nextchar(readcharfun);
2676 /* check for permutation syntax */
2679 read_vector(readcharfun, ']');
2680 if (ase_permutation_f) {
2681 return ase_permutation_f(perm);
2686 unreadchar(readcharfun, _c_);
2688 "unrecognised permutation syntax");
2690 Qinvalid_read_syntax, list1(err));
2695 /* #r"raw\stringt" -- raw string syntax */
2696 return read_raw_string(readcharfun);
2699 /* #s(foobar key1 val1 key2 val2) --
2700 * structure syntax */
2701 return read_structure(readcharfun);
2703 /* Check user readers */
2704 Lisp_Object uoname = read_string(readcharfun, ' ', 0);
2705 Lisp_Object ureader = ureader_find(uoname);
2707 return ureader_read(ureader, readcharfun);
2709 unreadchar(readcharfun, c);
2710 return Fsignal(Qinvalid_read_syntax,
2712 ("No ureader for"), uoname));
2714 #ifdef FEATUREP_SYNTAX
2717 Lisp_Object feature_exp, obj, tem;
2718 struct gcpro gcpro1, gcpro2;
2720 feature_exp = read0(readcharfun);
2721 obj = read0(readcharfun);
2723 /* the call to `featurep' may GC. */
2724 GCPRO2(feature_exp, obj);
2725 tem = call1(Qfeaturep, feature_exp);
2728 if (c == '+' && NILP(tem))
2730 if (c == '-' && !NILP(tem))
2745 /* Reader forms that can reuse previously read
2750 /* Using read_integer() here is impossible, because it
2751 chokes on `='. Using parse_integer() is too hard.
2752 So we simply read it in, and ignore overflows, which
2754 while (c >= '0' && c <= '9') {
2757 c = readchar(readcharfun);
2759 found = assq_no_quit(make_int(n), Vread_objects);
2761 /* #n=object returns object, but associates it
2768 (Qinvalid_read_syntax,
2770 (build_translated_string
2771 ("Multiply defined symbol label"),
2773 obj = read0(readcharfun);
2779 } else if (c == '#') {
2780 /* #n# returns a previously read object. */
2786 (Qinvalid_read_syntax,
2788 (build_translated_string
2789 ("Undefined symbol label"),
2792 return Fsignal(Qinvalid_read_syntax,
2797 unreadchar(readcharfun, c);
2798 return Fsignal(Qinvalid_read_syntax,
2807 return list2(Qquote, read0(readcharfun));
2809 #ifdef LISP_BACKQUOTES
2812 int speccount = specpdl_depth();
2813 ++new_backquote_flag;
2814 record_unwind_protect(backquote_unwind,
2816 (&new_backquote_flag));
2817 tem = read0(readcharfun);
2818 unbind_to(speccount, Qnil);
2819 return list2(Qbackquote, tem);
2823 if (new_backquote_flag) {
2824 Lisp_Object comma_type = Qnil;
2825 int ch = readchar(readcharfun);
2828 comma_type = Qcomma_at;
2830 comma_type = Qcomma_dot;
2833 unreadchar(readcharfun, ch);
2834 comma_type = Qcomma;
2836 return list2(comma_type, read0(readcharfun));
2838 /* YUCK. 99.999% backwards compatibility. The Right
2839 Thing(tm) is to signal an error here, because it's
2840 really invalid read syntax. Instead, this permits
2841 commas to begin symbols (unless they're inside
2842 backquotes). If an error is signalled here in the
2843 future, then commas should be invalid read syntax
2844 outside of backquotes anywhere they're found (i.e.
2845 they must be quoted in symbols) -- Stig */
2846 return read_atom(readcharfun, c, 0);
2852 /* Evil GNU Emacs "character" (ie integer) syntax */
2853 c = readchar(readcharfun);
2855 return Fsignal(Qend_of_file,
2856 list1(READCHARFUN_MAYBE
2860 c = read_escape(readcharfun);
2861 return make_char(c);
2866 return read_string(readcharfun, '\"', 0);
2869 /* Ignore whitespace and control characters */
2872 return read_atom(readcharfun, c, 0);
2884 /* for complex numbers */
2885 #define INTERMEDIATE_UNARY_SYMBOL 32
2886 #define LEAD_INT2 64
2887 #define DOT_CHAR2 128
2888 #define TRAIL_INT2 256
2890 #define EXP_INT2 1024
2896 isfloat_string(const char *cp)
2899 const Bufbyte *ucp = (const Bufbyte *)cp;
2901 if (*ucp == '+' || *ucp == '-')
2904 if (*ucp >= '0' && *ucp <= '9') {
2906 while (*ucp >= '0' && *ucp <= '9')
2913 if (*ucp >= '0' && *ucp <= '9') {
2915 while (*ucp >= '0' && *ucp <= '9')
2918 if (*ucp == 'e' || *ucp == 'E') {
2921 if ((*ucp == '+') || (*ucp == '-'))
2925 if (*ucp >= '0' && *ucp <= '9') {
2927 while (*ucp >= '0' && *ucp <= '9')
2930 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t')
2932 || (*ucp == '\r') || (*ucp == '\f'))
2933 && (state == (LEAD_INT | DOT_CHAR | TRAIL_INT)
2934 || state == (DOT_CHAR | TRAIL_INT)
2935 || state == (LEAD_INT | E_CHAR | EXP_INT)
2937 (LEAD_INT | DOT_CHAR | TRAIL_INT | E_CHAR | EXP_INT)
2938 || state == (DOT_CHAR | TRAIL_INT | E_CHAR | EXP_INT)));
2940 #endif /* HAVE_FPFLOAT */
2941 #if defined HAVE_MPC && defined WITH_MPC || \
2942 defined HAVE_PSEUC && defined WITH_PSEUC
2944 isbigc_string (const char *cp)
2947 const Bufbyte *ucp = (const Bufbyte *)cp;
2950 /* parse the real part */
2952 if (*ucp == '+' || *ucp == '-')
2955 if (*ucp >= '0' && *ucp <= '9') {
2957 while (*ucp >= '0' && *ucp <= '9')
2964 if (*ucp >= '0' && *ucp <= '9') {
2966 while (*ucp >= '0' && *ucp <= '9')
2969 if (*ucp == 'e' || *ucp == 'E') {
2972 if ((*ucp == '+') || (*ucp == '-'))
2976 if (*ucp >= '0' && *ucp <= '9') {
2978 while (*ucp >= '0' && *ucp <= '9')
2982 /* check if we had a real number until here */
2983 if (!(state == (LEAD_INT | DOT_CHAR | TRAIL_INT) ||
2984 state == (DOT_CHAR | TRAIL_INT) ||
2985 state == (LEAD_INT | E_CHAR | EXP_INT) ||
2986 state == (LEAD_INT | DOT_CHAR | TRAIL_INT | E_CHAR | EXP_INT) ||
2987 state == (DOT_CHAR | TRAIL_INT | E_CHAR | EXP_INT)))
2990 /* now parse imaginary part */
2992 if (*ucp == '+' || *ucp == '-') {
2993 state |= INTERMEDIATE_UNARY_SYMBOL;
2997 if (*ucp >= '0' && *ucp <= '9') {
2999 while (*ucp >= '0' && *ucp <= '9')
3006 if (*ucp >= '0' && *ucp <= '9') {
3007 state |= TRAIL_INT2;
3008 while (*ucp >= '0' && *ucp <= '9')
3011 if (*ucp == 'e' || *ucp == 'E') {
3014 if ((*ucp == '+') || (*ucp == '-'))
3018 if (*ucp >= '0' && *ucp <= '9') {
3020 while (*ucp >= '0' && *ucp <= '9')
3023 if (*ucp == 'i' || *ucp == 'I') {
3027 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') ||
3028 (*ucp == '\n') || (*ucp == '\r') || (*ucp == '\f')) &&
3029 (state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 | DOT_CHAR2 |
3030 TRAIL_INT2 | I_CHAR) ||
3031 state == (INTERMEDIATE_UNARY_SYMBOL | DOT_CHAR2 |
3032 TRAIL_INT2 | I_CHAR) ||
3033 state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 |
3034 E_CHAR2 | EXP_INT2 | I_CHAR) ||
3035 state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 | DOT_CHAR2 |
3036 TRAIL_INT2 | E_CHAR2 | EXP_INT2 | I_CHAR) ||
3037 state == (INTERMEDIATE_UNARY_SYMBOL | DOT_CHAR2 | TRAIL_INT2 |
3038 E_CHAR2 | EXP_INT2 | I_CHAR) ||
3039 state == (INTERMEDIATE_UNARY_SYMBOL | I_CHAR)));
3041 #endif /* HAVE_MPC */
3042 #if defined WITH_PSEUG && defined HAVE_PSEUG
3044 isgaussian_string (const char *cp)
3047 const Bufbyte *ucp = (const Bufbyte *)cp;
3050 /* parse the real part */
3052 if (*ucp == '+' || *ucp == '-')
3055 if (*ucp >= '0' && *ucp <= '9') {
3057 while (*ucp >= '0' && *ucp <= '9')
3061 /* check if we had a int number until here */
3062 if (!(state == (LEAD_INT)))
3065 /* now parse imaginary part */
3067 if (*ucp == '+' || *ucp == '-') {
3068 state |= INTERMEDIATE_UNARY_SYMBOL;
3072 if (*ucp >= '0' && *ucp <= '9') {
3074 while (*ucp >= '0' && *ucp <= '9')
3077 if (*ucp == 'i' || *ucp == 'I') {
3081 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') ||
3082 (*ucp == '\n') || (*ucp == '\r') || (*ucp == '\f')) &&
3083 (state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 | I_CHAR) ||
3084 state == (INTERMEDIATE_UNARY_SYMBOL | I_CHAR)));
3086 #endif /* HAVE_PSEUG */
3087 #if defined HAVE_MPQ && defined WITH_GMP
3089 isbigq_string (const char *cp)
3091 /* Possible minus/plus sign */
3092 if (*cp == '-' || *cp == '+')
3096 if (*cp < '0' || *cp > '9')
3101 } while (*cp >= '0' && *cp <= '9');
3108 if (*cp < '0' || *cp > '9')
3113 } while (*cp >= '0' && *cp <= '9');
3115 return *cp == '\0' || *cp == ' ' || *cp =='\t' || *cp == '\n' ||
3116 *cp == '\r' || *cp == '\f';
3118 #endif /* HAVE_MPQ */
3122 sequence_reader(Lisp_Object readcharfun,
3125 void*(*conser)(Lisp_Object, void*, Charcount))
3129 for (len = 0;; len++) {
3133 ch = reader_nextchar(readcharfun);
3135 if (ch == terminator)
3138 unreadchar(readcharfun, ch);
3139 #ifdef FEATUREP_SYNTAX
3141 read_syntax_error("\"]\" in a list");
3143 read_syntax_error("\")\" in a vector");
3145 state = ((conser) (readcharfun, state, len));
3149 struct read_list_state {
3153 int allow_dotted_lists;
3158 read_list_conser(Lisp_Object readcharfun, void *state, Charcount len)
3160 struct read_list_state *s = (struct read_list_state *)state;
3163 elt = read1(readcharfun);
3165 if (CONSP(elt) && UNBOUNDP(XCAR(elt))) {
3166 Lisp_Object tem = elt;
3170 free_cons(XCONS(tem));
3173 #ifdef FEATUREP_SYNTAX
3174 if (ch == s->terminator) {
3175 /* deal with #+, #- reader macros */
3176 unreadchar(readcharfun, s->terminator);
3178 } else if (ch == ']')
3179 read_syntax_error("']' in a list");
3181 read_syntax_error("')' in a vector");
3185 signal_simple_error("BUG! Internal reader error", elt);
3186 else if (!s->allow_dotted_lists)
3187 read_syntax_error("\".\" in a vector");
3190 XCDR(s->tail) = read0(readcharfun);
3192 s->head = read0(readcharfun);
3193 elt = read1(readcharfun);
3194 if (CONSP(elt) && UNBOUNDP(XCAR(elt))) {
3195 ch = XCHAR(XCDR(elt));
3196 free_cons(XCONS(elt));
3197 if (ch == s->terminator) {
3198 unreadchar(readcharfun, s->terminator);
3202 read_syntax_error(". in wrong context");
3205 #if 0 /* FSFmacs defun hack, or something ... */
3206 if (NILP(tail) && defun_hack && EQ(elt, Qdefun) && !read_pure) {
3207 record_unwind_protect(unreadpure, Qzero);
3212 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3213 if (s->length == 1 && s->allow_dotted_lists && EQ(XCAR(s->head), Qfset)) {
3214 if (CONSP(elt) && EQ(XCAR(elt), Qquote) && CONSP(XCDR(elt)))
3215 Vcurrent_compiled_function_annotation = XCAR(XCDR(elt));
3217 Vcurrent_compiled_function_annotation = elt;
3221 elt = Fcons(elt, Qnil);
3223 XCDR(s->tail) = elt;
3232 #if 0 /* FSFmacs defun hack */
3233 /* -1 for allow_dotted_lists means allow_dotted_lists and check
3234 for starting with defun and make structure pure. */
3238 read_list(Lisp_Object readcharfun,
3240 int allow_dotted_lists, int check_for_doc_references)
3242 struct read_list_state s;
3243 struct gcpro gcpro1, gcpro2;
3244 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3245 Lisp_Object old_compiled_function_annotation =
3246 Vcurrent_compiled_function_annotation;
3252 s.allow_dotted_lists = allow_dotted_lists;
3253 s.terminator = terminator;
3254 GCPRO2(s.head, s.tail);
3256 sequence_reader(readcharfun, terminator, &s, read_list_conser);
3257 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3258 Vcurrent_compiled_function_annotation =
3259 old_compiled_function_annotation;
3262 if ((purify_flag || load_force_doc_strings) && check_for_doc_references) {
3263 /* check now for any doc string references and record them
3267 /* We might be dealing with an imperfect list so don't
3269 for (tail = s.head; CONSP(tail); tail = XCDR(tail)) {
3270 Lisp_Object holding_cons = Qnil;
3273 Lisp_Object elem = XCAR(tail);
3274 /* elem might be (#$ . INT) ... */
3276 && EQ(XCAR(elem), Vload_file_name_internal))
3277 holding_cons = tail;
3278 /* or it might be (quote (#$ . INT)) i.e.
3279 (quote . ((#$ . INT) . nil)) in the case of
3280 `autoload' (autoload evaluates its arguments, while
3281 `defvar', `defun', etc. don't). */
3282 if (CONSP(elem) && EQ(XCAR(elem), Qquote)
3283 && CONSP(XCDR(elem))) {
3284 elem = XCAR(XCDR(elem));
3287 Vload_file_name_internal))
3288 holding_cons = XCDR(XCAR(tail));
3292 if (CONSP(holding_cons)) {
3294 if (NILP(Vinternal_doc_file_name))
3295 /* We have not yet called
3296 Snarf-documentation, so
3297 assume this file is described
3299 Snarf-documentation will fill
3300 in the right value later.
3301 For now, replace the whole
3303 XCAR(holding_cons) = Qzero;
3305 /* We have already called
3306 Snarf-documentation, so make
3307 a relative file name for this
3308 file, so it can be found
3309 properly in the installed
3310 Lisp directory. We don't use
3311 Fexpand_file_name because
3312 that would make the directory
3314 XCAR(XCAR(holding_cons)) =
3315 concat2(build_string
3317 Ffile_name_nondirectory
3318 (Vload_file_name_internal));
3320 /* Not pure. Just add to
3321 Vload_force_doc_string_list, and the
3322 string will be filled in properly in
3323 load_force_doc_string_unwind(). */
3324 Vload_force_doc_string_list =
3325 /* We pass the cons that holds the
3326 (#$ . INT) so we can modify it
3329 Vload_force_doc_string_list);
3339 read_vector(Lisp_Object readcharfun, Emchar terminator)
3345 struct read_list_state s;
3346 struct gcpro gcpro1, gcpro2;
3351 s.allow_dotted_lists = 0;
3352 GCPRO2(s.head, s.tail);
3354 sequence_reader(readcharfun, terminator, &s, read_list_conser);
3358 len = XINT(Flength(tem));
3360 #if 0 /* FSFmacs defun hack */
3362 s.head = make_pure_vector(len, Qnil);
3365 s.head = make_vector(len, Qnil);
3367 for (i = 0, p = &(XVECTOR_DATA(s.head)[0]); i < len; i++, p++) {
3368 Lisp_Cons *otem = XCONS(tem);
3378 read_compiled_function(Lisp_Object readcharfun, Emchar terminator)
3380 /* Accept compiled functions at read-time so that we don't
3381 have to build them at load-time. */
3383 Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
3384 struct gcpro gcpro1;
3387 int saw_a_doc_ref = 0;
3389 /* Note: we tell read_list not to search for doc references
3390 because we need to handle the "doc reference" for the
3391 instructions and constants differently. */
3392 stuff = read_list(readcharfun, terminator, 0, 0);
3393 len = XINT(Flength(stuff));
3394 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
3396 continuable_read_syntax_error
3397 ("#[...] used with wrong number of elements");
3399 for (iii = 0; CONSP(stuff); iii++) {
3400 Lisp_Cons *victim = XCONS(stuff);
3401 make_byte_code_args[iii] = Fcar(stuff);
3402 if ((purify_flag || load_force_doc_strings)
3403 && CONSP(make_byte_code_args[iii])
3404 && EQ(XCAR(make_byte_code_args[iii]),
3405 Vload_file_name_internal)) {
3406 if (purify_flag && iii == COMPILED_DOC_STRING) {
3407 /* same as in read_list(). */
3408 if (NILP(Vinternal_doc_file_name))
3409 make_byte_code_args[iii] = Qzero;
3411 XCAR(make_byte_code_args[iii]) =
3412 concat2(build_string("../lisp/"),
3413 Ffile_name_nondirectory
3414 (Vload_file_name_internal));
3418 stuff = Fcdr(stuff);
3421 GCPROn(make_byte_code_args, len);
3423 /* v18 or v19 bytecode file. Need to Ebolify. */
3424 if (load_byte_code_version < 20 && VECTORP(make_byte_code_args[2]))
3425 ebolify_bytecode_constants(make_byte_code_args[2]);
3427 /* make-byte-code looks at purify_flag, which should have the same
3428 * value as our "read-pure" argument */
3429 stuff = Fmake_byte_code(len, make_byte_code_args);
3430 XCOMPILED_FUNCTION(stuff)->flags.ebolified =
3431 (load_byte_code_version < 20);
3433 Vload_force_doc_string_list =
3434 Fcons(stuff, Vload_force_doc_string_list);
3439 void init_lread(void)
3441 char *stroot = NULL, *btroot = NULL;
3444 load_in_progress = 0;
3446 Vload_descriptor_list = Qnil;
3448 /* kludge: locate-file does not work for a null load-path, even if
3449 the file name is absolute. */
3451 Vload_path = Fcons(build_string(""), Qnil);
3452 /* The following is intended for the build chain only */
3453 if ((stroot = getenv("SOURCE_TREE_ROOT")) && strlen(stroot)) {
3454 Lisp_Object lispsubdir = build_string("lisp");
3455 Lisp_Object strootdir = build_string(stroot);
3456 Lisp_Object stlispdir =
3457 Fexpand_file_name(lispsubdir, strootdir);
3458 Vload_path = Fcons(stlispdir, Vload_path);
3460 if ((btroot = getenv("BUILD_TREE_ROOT")) && strlen(btroot)) {
3461 Lisp_Object lispsubdir = build_string("lisp");
3462 Lisp_Object btrootdir = build_string(btroot);
3463 Lisp_Object btlispdir =
3464 Fexpand_file_name(lispsubdir, btrootdir);
3465 Vload_path = Fcons(btlispdir, Vload_path);
3468 /* This used to get initialized in init_lread because all streams
3469 got closed when dumping occurs. This is no longer true --
3470 Vread_buffer_stream is a resizing output stream, and there is no
3471 reason to close it at dump-time.
3473 Vread_buffer_stream is set to Qnil in vars_of_lread, and this
3474 will initialize it only once, at dump-time. */
3475 if (NILP(Vread_buffer_stream))
3476 Vread_buffer_stream = make_resizing_buffer_output_stream();
3478 Vload_force_doc_string_list = Qnil;
3481 void syms_of_lread(void)
3484 DEFSUBR(Fread_from_string);
3485 DEFSUBR(Fload_internal);
3486 DEFSUBR(Flocate_file);
3487 DEFSUBR(Flocate_file_clear_hashing);
3488 DEFSUBR(Feval_buffer);
3489 DEFSUBR(Feval_region);
3491 defsymbol(&Qstandard_input, "standard-input");
3492 defsymbol(&Qread_char, "read-char");
3493 defsymbol(&Qcurrent_load_list, "current-load-list");
3494 defsymbol(&Qload, "load");
3495 defsymbol(&Qload_file_name, "load-file-name");
3496 defsymbol(&Qfset, "fset");
3498 #ifdef LISP_BACKQUOTES
3499 defsymbol(&Qbackquote, "backquote");
3500 defsymbol(&Qbacktick, "`");
3501 defsymbol(&Qcomma, ",");
3502 defsymbol(&Qcomma_at, ",@");
3503 defsymbol(&Qcomma_dot, ",.");
3506 defsymbol(&Qexists, "exists");
3507 defsymbol(&Qreadable, "readable");
3508 defsymbol(&Qwritable, "writable");
3509 defsymbol(&Qexecutable, "executable");
3512 void structure_type_create(void)
3514 the_structure_type_dynarr = Dynarr_new(structure_type);
3517 void reinit_vars_of_lread(void)
3519 Vread_buffer_stream = Qnil;
3520 staticpro_nodump(&Vread_buffer_stream);
3523 void vars_of_lread(void)
3525 reinit_vars_of_lread();
3527 DEFVAR_LISP("values", &Vvalues /*
3528 List of values of all expressions which were read, evaluated and printed.
3529 Order is reverse chronological.
3532 DEFVAR_LISP("standard-input", &Vstandard_input /*
3533 Stream for read to get input from.
3534 See documentation of `read' for possible values.
3536 Vstandard_input = Qt;
3538 DEFVAR_LISP("load-path", &Vload_path /*
3539 *List of directories to search for files to load.
3540 Each element is a string (directory name) or nil (try default directory).
3542 Note that the elements of this list *may not* begin with "~", so you must
3543 call `expand-file-name' on them before adding them to this list.
3545 Initialized based on EMACSLOADPATH environment variable, if any,
3546 otherwise to default specified in by file `paths.h' when SXEmacs was built.
3547 If there were no paths specified in `paths.h', then SXEmacs chooses a default
3548 value for this variable by looking around in the file-system near the
3549 directory in which the SXEmacs executable resides.
3553 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
3554 "*Location of lisp files to be used when dumping ONLY."); */
3556 DEFVAR_BOOL("load-in-progress", &load_in_progress /*
3557 Non-nil iff inside of `load'.
3559 DEFVAR_LISP ("load-suppress-alist", &Vload_suppress_alist /*
3560 An alist of expressions controlling whether particular files can be loaded.
3561 Each element looks like (FILENAME EXPR).
3562 FILENAME should be a full pathname, but without the .el suffix.
3563 When `load' is run and is about to load the specified file, it evaluates
3564 the form to determine if the file can be loaded.
3565 This variable is normally initialized automatically.
3567 Vload_suppress_alist = Qnil;
3569 DEFVAR_LISP("after-load-alist", &Vafter_load_alist /*
3570 An alist of expressions to be evalled when particular files are loaded.
3571 Each element looks like (FILENAME FORMS...).
3572 When `load' is run and the file-name argument is FILENAME,
3573 the FORMS in the corresponding element are executed at the end of loading.
3575 FILENAME must match exactly! Normally FILENAME is the name of a library,
3576 with no directory specified, since that is how `load' is normally called.
3577 An error in FORMS does not undo the load,
3578 but does prevent execution of the rest of the FORMS.
3580 Vafter_load_alist = Qnil;
3582 DEFVAR_BOOL("load-warn-when-source-newer", &load_warn_when_source_newer /*
3583 *Whether `load' should check whether the source is newer than the binary.
3584 If this variable is true, then when a `.elc' file is being loaded and the
3585 corresponding `.el' is newer, a warning message will be printed.
3587 load_warn_when_source_newer = 0;
3589 DEFVAR_BOOL("load-warn-when-source-only", &load_warn_when_source_only /*
3590 *Whether `load' should warn when loading a `.el' file instead of an `.elc'.
3591 If this variable is true, then when `load' is called with a filename without
3592 an extension, and the `.elc' version doesn't exist but the `.el' version does,
3593 then a message will be printed. If an explicit extension is passed to `load',
3594 no warning will be printed.
3596 load_warn_when_source_only = 0;
3598 DEFVAR_BOOL("load-ignore-elc-files", &load_ignore_elc_files /*
3599 *Whether `load' should ignore `.elc' files when a suffix is not given.
3600 This is normally used only to bootstrap the `.elc' files when building SXEmacs.
3602 load_ignore_elc_files = 0;
3605 DEFVAR_LISP("load-history", &Vload_history /*
3606 Alist mapping source file names to symbols and features.
3607 Each alist element is a list that starts with a file name,
3608 except for one element (optional) that starts with nil and describes
3609 definitions evaluated from buffers not visiting files.
3610 The remaining elements of each list are symbols defined as functions
3611 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
3613 Vload_history = Qnil;
3615 DEFVAR_LISP("current-load-list", &Vcurrent_load_list /*
3616 Used for internal purposes by `load'.
3618 Vcurrent_load_list = Qnil;
3621 DEFVAR_LISP("load-file-name", &Vload_file_name /*
3622 Full name of file being loaded by `load'.
3624 Vload_file_name = Qnil;
3626 DEFVAR_LISP("load-read-function", &Vload_read_function /*
3627 Function used by `load' and `eval-region' for reading expressions.
3628 The default is nil, which means use the function `read'.
3630 Vload_read_function = Qnil;
3632 DEFVAR_BOOL("load-force-doc-strings", &load_force_doc_strings /*
3633 Non-nil means `load' should force-load all dynamic doc strings.
3634 This is useful when the file being loaded is a temporary copy.
3636 load_force_doc_strings = 0;
3638 /* See read_escape(). */
3640 /* Used to be named `puke-on-fsf-keys' */
3641 DEFVAR_BOOL("fail-on-bucky-bit-character-escapes", &fail_on_bucky_bit_character_escapes /*
3642 Whether `read' should signal an error when it encounters unsupported
3643 character escape syntaxes or just read them incorrectly.
3645 fail_on_bucky_bit_character_escapes = 0;
3648 /* This must be initialized in init_lread otherwise it may start out
3649 with values saved when the image is dumped. */
3650 staticpro(&Vload_descriptor_list);
3652 /* Initialized in init_lread. */
3653 staticpro(&Vload_force_doc_string_list);
3655 Vload_file_name_internal = Qnil;
3656 staticpro(&Vload_file_name_internal);
3658 Vload_file_name_internal_the_purecopy = Qnil;
3659 staticpro(&Vload_file_name_internal_the_purecopy);
3661 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3662 Vcurrent_compiled_function_annotation = Qnil;
3663 staticpro(&Vcurrent_compiled_function_annotation);
3666 /* So that early-early stuff will work */
3667 Ffset(Qload, intern("load-internal"));
3669 #ifdef FEATUREP_SYNTAX
3670 defsymbol(&Qfeaturep, "featurep");
3671 Fprovide(intern("xemacs"));
3672 Fprovide(intern("sxemacs"));
3673 Fprovide(intern("raw-strings"));
3675 Fprovide(intern("infodock"));
3676 #endif /* INFODOCK */
3677 #endif /* FEATUREP_SYNTAX */
3679 #ifdef LISP_BACKQUOTES
3680 old_backquote_flag = new_backquote_flag = 0;
3684 Vfile_domain = Qnil;
3687 Vread_objects = Qnil;
3688 staticpro(&Vread_objects);
3690 Vlocate_file_hash_table = make_lisp_hash_table(200,
3691 HASH_TABLE_NON_WEAK,
3693 staticpro(&Vlocate_file_hash_table);
3694 #ifdef DEBUG_SXEMACS
3696 Lisp_Object tmp = intern("Vlocate-file-hash-table");
3697 symbol_value(XSYMBOL(tmp)) = Vlocate_file_hash_table;
3701 /* User defined readers */
3702 DEFVAR_LISP("ureaders", &Vureaders /*
3703 Alist of user defined readers.
3704 Car is ureader NAME, represented by string to match against when reading
3706 Cdr is user function called with one arg - string.
3707 Function must return lisp object or signal error.
3712 /* lread.c ends here */