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 Lisp_Object absfile = Qnil;
588 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
590 int message_p = NILP(nomessage);
591 /*#ifdef DEBUG_SXEMACS*/
592 static Lisp_Object last_file_loaded;
595 GCPRO4(file, newer, found, absfile);
599 /*#ifdef DEBUG_SXEMACS*/
600 if (purify_flag && noninteractive) {
602 last_file_loaded = file;
604 /*#endif / * DEBUG_SXEMACS */
606 /* If file name is magic, call the handler. */
607 handler = Ffind_file_name_handler(file, Qload);
609 RETURN_UNGCPRO(call5(handler, Qload, file, noerror,
610 nomessage, nosuffix));
612 /* Do this after the handler to avoid
613 the need to gcpro noerror, nomessage and nosuffix.
614 (Below here, we care only whether they are nil or not.) */
615 file = Fsubstitute_in_file_name(file);
617 if (!NILP(used_codesys))
618 CHECK_SYMBOL(used_codesys);
621 /* Avoid weird lossage with null string as arg,
622 since it would try to load a directory as a Lisp file.
624 if (XSTRING_LENGTH(file) > 0) {
628 fd = locate_file(Vload_path, file,
631 : build_string(load_ignore_elc_files
633 : ".elc:.el:")), &found, -1);
637 signal_file_error("Cannot open load file",
645 foundlen = XSTRING_LENGTH(found);
646 foundstr = (char *)alloca( foundlen+ 1);
647 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(Ffile_truename(found,
654 } else if (load_warn_when_source_newer &&
655 !memcmp(".elc", foundstr + foundlen - 4, 4)) {
656 if (!fstat(fd, &s1)) { /* can't fail, right? */
658 /* temporarily hack the 'c' off the end of the
660 foundstr[foundlen - 1] = '\0';
661 result = sxemacs_stat(foundstr, &s2);
663 (unsigned)s1.st_mtime <
664 (unsigned)s2.st_mtime) {
665 Lisp_Object newer_name =
666 make_string((Bufbyte*)foundstr,
668 struct gcpro nngcpro1;
669 NNGCPRO1(newer_name);
670 newer = Ffile_name_nondirectory(
674 /* put the 'c' back on (kludge-o-rama) */
675 foundstr[foundlen - 1] = 'c';
677 } else if (load_warn_when_source_only &&
678 /* `found' ends in ".el" */
679 !memcmp(".el", foundstr + foundlen - 3, 3) &&
680 /* `file' does not end in ".el" */
682 XSTRING_DATA(file) + XSTRING_LENGTH(file) - 3,
687 if (!memcmp(".elc", foundstr + foundlen - 4, 4))
690 #define PRINT_LOADING_MESSAGE(done) \
692 if (load_ignore_elc_files) { \
694 message("Loading %s ..." done, \
695 XSTRING_DATA(newer)); \
697 } else if (!NILP(newer)) { \
698 message("Loading %s ..." done " (file %s is newer)", \
699 XSTRING_DATA(absfile), \
700 XSTRING_DATA(newer)); \
701 } else if (source_only) { \
702 Lisp_Object tmp = Ffile_name_nondirectory(file); \
703 message("Loading %s ..." done \
704 " (file %s.elc does not exist)", \
705 XSTRING_DATA(absfile), \
706 XSTRING_DATA(tmp)); \
707 } else if (message_p) { \
708 message("Loading %s ..." done, \
709 XSTRING_DATA(absfile)); \
713 absfile = Ffile_truename(found, Qnil);
715 PRINT_LOADING_MESSAGE("");
718 /* Lisp_Object's must be malloc'ed, not stack-allocated */
719 Lisp_Object lstrm = Qnil;
720 const int block_size = 8192;
721 struct gcpro ngcpro1;
725 signal_file_error("Cannot open load file", absfile);
727 lstrm = make_filedesc_input_stream(fd, 0, -1, LSTR_CLOSING);
728 /* 64K is used for normal files; 8K should be OK here because
729 * Lisp files aren't really all that big. */
730 Lstream_set_buffering(XLSTREAM(lstrm),
731 LSTREAM_BLOCKN_BUFFERED, block_size);
733 lstrm = make_decoding_input_stream(
734 XLSTREAM(lstrm), Fget_coding_system(codesys));
735 Lstream_set_buffering(XLSTREAM(lstrm),
736 LSTREAM_BLOCKN_BUFFERED, block_size);
738 /* NOTE: Order of these is very important.
739 * Don't rearrange them. */
740 record_unwind_protect(load_unwind, lstrm);
741 record_unwind_protect(load_descriptor_unwind,
742 Vload_descriptor_list);
743 record_unwind_protect(load_file_name_internal_unwind,
744 Vload_file_name_internal);
745 record_unwind_protect(
746 load_file_name_internal_the_purecopy_unwind,
747 Vload_file_name_internal_the_purecopy);
748 record_unwind_protect(load_force_doc_string_unwind,
749 Vload_force_doc_string_list);
750 Vload_file_name_internal = found;
751 Vload_file_name_internal_the_purecopy = Qnil;
752 specbind(Qload_file_name, found);
753 Vload_descriptor_list =
754 Fcons(make_int(fd), Vload_descriptor_list);
755 Vload_force_doc_string_list = Qnil;
757 record_unwind_protect(restore_file_domain, Vfile_domain);
758 /* set it to nil; a call to #'domain will set it. */
763 /* Now determine what sort of ELC file we're reading in. */
764 record_unwind_protect(load_byte_code_version_unwind,
765 make_int(load_byte_code_version));
770 num_read = Lstream_read(XLSTREAM(lstrm), elc_header, 8);
771 if (num_read < 8 || strncmp(elc_header, ";ELC", 4)) {
772 /* Huh? Probably not a valid ELC file. */
773 /* no Ebolification needed */
774 load_byte_code_version = 100;
775 Lstream_unread(XLSTREAM(lstrm), elc_header,
778 load_byte_code_version = elc_header[4];
781 /* no Ebolification needed */
782 load_byte_code_version = 100;
784 readevalloop(lstrm, absfile, Feval, 0);
786 if (!NILP(used_codesys)) {
788 decoding_stream_coding_system(XLSTREAM(lstrm));
789 Fset(used_codesys, XCODING_SYSTEM_NAME(tmp));
792 unbind_to(speccount, Qnil);
799 /* #### Disgusting kludge */
800 /* Run any load-hooks for this file. */
801 /* #### An even more disgusting kludge. There is horrible code */
802 /* that is relying on the fact that dumped lisp files are found */
803 /* via `load-path' search. */
804 Lisp_Object name = file;
806 if (!NILP(Ffile_name_absolute_p(file))) {
807 name = Ffile_name_nondirectory(file);
811 struct gcpro ngcpro1;
814 tem = Fassoc(name, Vafter_load_alist);
818 struct gcpro ngcpro1;
821 /* Use eval so that errors give a semi-meaningful
822 * backtrace. --Stig */
823 tem = Fcons(Qprogn, Fcdr(tem));
829 /*#ifdef DEBUG_SXEMACS*/
830 if (purify_flag && noninteractive) {
831 if (!EQ(last_file_loaded, file)) {
832 message("Loading %s ...done", XSTRING_DATA(file));
835 /*#endif / * DEBUG_SXEMACS */
837 if (!noninteractive) {
838 PRINT_LOADING_MESSAGE(" done");
844 /* ------------------------------- */
846 /* ------------------------------- */
848 static int decode_mode_1(Lisp_Object mode)
850 if (EQ(mode, Qexists))
852 else if (EQ(mode, Qexecutable))
854 else if (EQ(mode, Qwritable))
856 else if (EQ(mode, Qreadable))
858 else if (INTP(mode)) {
859 check_int_range(XINT(mode), 0, 7);
862 signal_simple_error("Invalid value", mode);
863 return 0; /* unreached */
866 static int decode_mode(Lisp_Object mode)
870 else if (CONSP(mode)) {
873 EXTERNAL_LIST_LOOP(tail, mode)
874 mask |= decode_mode_1(XCAR(tail));
877 return decode_mode_1(mode);
880 DEFUN("locate-file", Flocate_file, 2, 4, 0, /*
881 Search for FILENAME through PATH-LIST.
882 If SUFFIXES is non-nil, it should be a list of suffixes to append to
883 file name when searching.
885 If MODE is non-nil, it should be a symbol or a list of symbol representing
886 requirements. Allowed symbols are `exists', `executable', `writable', and
887 `readable'. If MODE is nil, it defaults to `readable'.
889 Filenames are checked against `load-suppress-alist' to determine if they
892 `locate-file' keeps hash tables of the directories it searches through,
893 in order to speed things up. It tries valiantly to not get confused in
894 the face of a changing and unpredictable environment, but can occasionally
895 get tripped up. In this case, you will have to call
896 `locate-file-clear-hashing' to get it back on track. See that function
899 (filename, path_list, suffixes, mode))
901 /* This function can GC */
904 CHECK_STRING(filename);
906 if (LISTP(suffixes)) {
908 EXTERNAL_LIST_LOOP(tail, suffixes)
909 CHECK_STRING(XCAR(tail));
911 CHECK_STRING(suffixes);
913 locate_file(path_list, filename, suffixes, &tp, decode_mode(mode));
917 /* Recalculate the hash table for the given string. DIRECTORY should
918 better have been through Fexpand_file_name() by now. */
920 static Lisp_Object locate_file_refresh_hashing(Lisp_Object directory)
923 make_directory_hash_table((char *)XSTRING_DATA(directory));
926 Fputhash(directory, hash, Vlocate_file_hash_table);
930 /* find the hash table for the given directory, recalculating if necessary */
932 static Lisp_Object locate_file_find_directory_hash_table(Lisp_Object directory)
934 Lisp_Object hash = Fgethash(directory, Vlocate_file_hash_table, Qnil);
936 return locate_file_refresh_hashing(directory);
941 /* The SUFFIXES argument in any of the locate_file* functions can be
942 nil, a list, or a string (for backward compatibility), with the
945 a) nil - no suffix, just search for file name intact
946 (semantically different from "empty suffix list", which
947 would be meaningless.)
948 b) list - list of suffixes to append to file name. Each of these
950 c) string - colon-separated suffixes to append to file name (backward
953 All of this got hairy, so I decided to use a mapper. Calling a
954 function for each suffix shouldn't slow things down, since
955 locate_file is rarely called with enough suffixes for funcalls to
956 make any difference. */
958 /* Map FUN over SUFFIXES, as described above. FUN will be called with a
959 char * containing the current file name, and ARG. Mapping stops when
960 FUN returns non-zero. */
962 locate_file_map_suffixes(Lisp_Object filename, Lisp_Object suffixes,
963 int (*fun) (char *, void *), void *arg)
965 /* This function can GC */
969 /* Calculate maximum size of any filename made from
970 this path element/specified file name and any possible suffix. */
971 if (CONSP(suffixes)) {
972 /* We must traverse the list, so why not do it right. */
975 LIST_LOOP(tail, suffixes) {
976 if (XSTRING_LENGTH(XCAR(tail)) > max)
977 max = XSTRING_LENGTH(XCAR(tail));
979 } else if (NILP(suffixes))
982 /* Just take the easy way out */
983 max = XSTRING_LENGTH(suffixes);
985 fn_len = XSTRING_LENGTH(filename);
986 fn = (char *)alloca(max + fn_len + 1);
987 memcpy(fn, (char *)XSTRING_DATA(filename), fn_len);
989 /* Loop over suffixes. */
990 if (!STRINGP(suffixes)) {
991 if (NILP(suffixes)) {
992 /* Case a) discussed in the comment above. */
994 if ((*fun) (fn, arg))
999 LIST_LOOP(tail, suffixes) {
1000 memcpy(fn + fn_len, XSTRING_DATA(XCAR(tail)),
1001 XSTRING_LENGTH(XCAR(tail)));
1002 fn[fn_len + XSTRING_LENGTH(XCAR(tail))] = 0;
1003 if ((*fun) (fn, arg))
1009 const char *nsuffix = (const char *)XSTRING_DATA(suffixes);
1012 char *esuffix = (char *)strchr(nsuffix, ':');
1014 esuffix ? esuffix - nsuffix : (int)strlen(nsuffix);
1016 /* Concatenate path element/specified name with the suffix. */
1017 strncpy(fn + fn_len, nsuffix, lsuffix);
1018 fn[fn_len + lsuffix] = '\0';
1020 if ((*fun) (fn, arg))
1023 /* Advance to next suffix. */
1026 nsuffix += lsuffix + 1;
1031 struct locate_file_in_directory_mapper_closure {
1033 Lisp_Object *storeptr;
1037 static int locate_file_in_directory_mapper(char *fn, void *arg)
1039 struct locate_file_in_directory_mapper_closure *closure =
1040 (struct locate_file_in_directory_mapper_closure *)arg;
1043 /* Ignore file if it's a directory. */
1044 if (sxemacs_stat(fn, &st) >= 0 && (st.st_mode & S_IFMT) != S_IFDIR) {
1045 /* Check that we can access or open it. */
1046 if (closure->mode >= 0)
1047 closure->fd = access(fn, closure->mode);
1049 closure->fd = open(fn, O_RDONLY | OPEN_BINARY, 0);
1051 if (closure->fd >= 0) {
1052 if (!suppressedp(fn, Qnil)) {
1053 /* We succeeded; return this descriptor and
1055 if (closure->storeptr)
1056 *closure->storeptr = build_string(fn);
1058 /* If we actually opened the file, set
1059 close-on-exec flag on the new descriptor so
1060 that subprocesses can't whack at it. */
1061 if (closure->mode < 0)
1062 (void)fcntl(closure->fd,
1063 F_SETFD, FD_CLOEXEC);
1067 /* Avoid closing stdin upon success of
1068 access, where closure->fd would be
1069 0 but the file is not open on that
1082 /* look for STR in PATH, optionally adding SUFFIXES. DIRECTORY need
1083 not have been expanded. */
1086 locate_file_in_directory(Lisp_Object directory, Lisp_Object str,
1087 Lisp_Object suffixes, Lisp_Object * storeptr, int mode)
1089 /* This function can GC */
1090 struct locate_file_in_directory_mapper_closure closure;
1091 Lisp_Object filename = Qnil;
1092 struct gcpro gcpro1, gcpro2, gcpro3;
1094 GCPRO3(directory, str, filename);
1096 filename = Fexpand_file_name(str, directory);
1097 if (NILP(filename) || NILP(Ffile_name_absolute_p(filename)))
1098 /* If there are non-absolute elts in PATH (eg ".") */
1099 /* Of course, this could conceivably lose if luser sets
1100 default-directory to be something non-absolute ... */
1103 /* NIL means current directory */
1104 filename = current_buffer->directory;
1106 filename = Fexpand_file_name(filename,
1107 current_buffer->directory);
1108 if (NILP(Ffile_name_absolute_p(filename))) {
1109 /* Give up on this directory! */
1116 closure.storeptr = storeptr;
1117 closure.mode = mode;
1119 locate_file_map_suffixes(filename, suffixes,
1120 locate_file_in_directory_mapper, &closure);
1126 /* do the same as locate_file() but don't use any hash tables. */
1129 locate_file_without_hash(Lisp_Object path, Lisp_Object str,
1130 Lisp_Object suffixes, Lisp_Object * storeptr, int mode)
1132 /* This function can GC */
1133 int absolute = !NILP(Ffile_name_absolute_p(str));
1135 EXTERNAL_LIST_LOOP(path, path) {
1137 locate_file_in_directory(XCAR(path), str, suffixes,
1148 static int locate_file_construct_suffixed_files_mapper(char *fn, void *arg)
1150 Lisp_Object *tail = (Lisp_Object *) arg;
1151 *tail = Fcons(build_string(fn), *tail);
1155 /* Construct a list of all files to search for.
1156 It makes sense to have this despite locate_file_map_suffixes()
1157 because we need Lisp strings to access the hash-table, and it would
1158 be inefficient to create them on the fly, again and again for each
1159 path component. See locate_file(). */
1162 locate_file_construct_suffixed_files(Lisp_Object filename, Lisp_Object suffixes)
1164 Lisp_Object tail = Qnil;
1165 struct gcpro gcpro1;
1168 locate_file_map_suffixes(filename, suffixes,
1169 locate_file_construct_suffixed_files_mapper,
1173 return Fnreverse(tail);
1176 DEFUN("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
1177 Clear the hash records for the specified list of directories.
1178 `locate-file' uses a hashing scheme to speed lookup, and will correctly
1179 track the following environmental changes:
1181 -- changes of any sort to the list of directories to be searched.
1182 -- addition and deletion of non-shadowing files (see below) from the
1183 directories in the list.
1184 -- byte-compilation of a .el file into a .elc file.
1186 `locate-file' will primarily get confused if you add a file that shadows
1187 \(i.e. has the same name as) another file further down in the directory list.
1188 In this case, you must call `locate-file-clear-hashing'.
1190 If PATH is t, it means to fully clear all the accumulated hashes. This
1191 can be used if the internal tables grow too large, or when dumping.
1196 Fclrhash(Vlocate_file_hash_table);
1198 Lisp_Object pathtail;
1199 EXTERNAL_LIST_LOOP(pathtail, path) {
1200 Lisp_Object pathel =
1201 Fexpand_file_name(XCAR(pathtail), Qnil);
1202 Fremhash(pathel, Vlocate_file_hash_table);
1208 /* Search for a file whose name is STR, looking in directories
1209 in the Lisp list PATH, and trying suffixes from SUFFIXES.
1210 SUFFIXES is a list of possible suffixes, or (for backward
1211 compatibility) a string containing possible suffixes separated by
1213 On success, returns a file descriptor. On failure, returns -1.
1215 MODE nonnegative means don't open the files,
1216 just look for one for which access(file,MODE) succeeds. In this case,
1217 returns a nonnegative value on success. On failure, returns -1.
1219 If STOREPTR is nonzero, it points to a slot where the name of
1220 the file actually found should be stored as a Lisp string.
1221 Nil is stored there on failure.
1223 Called openp() in FSFmacs. */
1226 locate_file(Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
1227 Lisp_Object * storeptr, int mode)
1229 /* This function can GC */
1230 Lisp_Object suffixtab = Qnil;
1231 Lisp_Object pathtail, pathel_expanded;
1233 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
1238 /* Is it really necessary to gcpro path and str? It shouldn't be
1239 unless some caller has fucked up. There are known instances that
1240 call us with build_string("foo:bar") as SUFFIXES, though. */
1241 GCPRO4(path, str, suffixes, suffixtab);
1243 /* if this filename has directory components, it's too complicated
1244 to try and use the hash tables. */
1245 if (!NILP(Ffile_name_directory(str))) {
1247 locate_file_without_hash(path, str, suffixes, storeptr,
1253 suffixtab = locate_file_construct_suffixed_files(str, suffixes);
1255 EXTERNAL_LIST_LOOP(pathtail, path) {
1256 Lisp_Object pathel = XCAR(pathtail);
1257 Lisp_Object hash_table;
1261 /* If this path element is relative, we have to look by hand. */
1262 if (NILP(pathel) || NILP(Ffile_name_absolute_p(pathel))) {
1264 locate_file_in_directory(pathel, str, suffixes,
1273 pathel_expanded = Fexpand_file_name(pathel, Qnil);
1275 locate_file_find_directory_hash_table(pathel_expanded);
1277 if (!NILP(hash_table)) {
1278 /* Loop over suffixes. */
1279 LIST_LOOP(tail, suffixtab)
1280 if (!NILP(Fgethash(XCAR(tail), hash_table, Qnil))) {
1287 /* This is a likely candidate. Look by hand in this directory
1288 so we don't get thrown off if someone byte-compiles a file. */
1290 locate_file_in_directory(pathel, str, suffixes,
1297 /* Hmm ... the file isn't actually there. (Or possibly it's
1298 a directory ...) So refresh our hashing. */
1299 locate_file_refresh_hashing(pathel_expanded);
1303 /* File is probably not there, but check the hard way just in case. */
1304 val = locate_file_without_hash(path, str, suffixes, storeptr, mode);
1306 /* Sneaky user added a file without telling us. */
1307 Flocate_file_clear_hashing(path);
1316 /* Merge the list we've accumulated of globals from the current input source
1317 into the load_history variable. The details depend on whether
1318 the source has an associated file name or not. */
1320 static void build_load_history(int loading, Lisp_Object source)
1322 REGISTER Lisp_Object tail, prev, newelt;
1323 REGISTER Lisp_Object tem, tem2;
1326 #if !defined(LOADHIST_DUMPED)
1327 /* Don't bother recording anything for preloaded files. */
1332 tail = Vload_history;
1335 while (!NILP(tail)) {
1338 /* Find the feature's previous assoc list... */
1339 if (internal_equal(source, Fcar(tem), 0)) {
1342 /* If we're loading, remove it. */
1345 Vload_history = Fcdr(tail);
1347 Fsetcdr(prev, Fcdr(tail));
1350 /* Otherwise, cons on new symbols that are not already members. */
1352 tem2 = Vcurrent_load_list;
1354 while (CONSP(tem2)) {
1355 newelt = XCAR(tem2);
1357 if (NILP(Fmemq(newelt, tem)))
1358 Fsetcar(tail, Fcons(Fcar(tem),
1374 /* If we're loading, cons the new assoc onto the front of load-history,
1375 the most-recently-loaded position. Also do this if we didn't find
1376 an existing member for the current source. */
1377 if (loading || !foundit)
1378 Vload_history = Fcons(Fnreverse(Vcurrent_load_list),
1382 #else /* !LOADHIST */
1383 #define build_load_history(x,y)
1384 #endif /* !LOADHIST */
1386 #if 0 /* FSFmacs defun hack */
1387 Lisp_Object unreadpure(void)
1388 { /* Used as unwind-protect function in readevalloop */
1395 readevalloop(Lisp_Object readcharfun,
1396 Lisp_Object sourcename,
1397 Lisp_Object(*evalfun) (Lisp_Object), int printflag)
1399 /* This function can GC */
1401 REGISTER Lisp_Object val = Qnil;
1402 int speccount = specpdl_depth();
1403 struct gcpro gcpro1, gcpro2;
1404 struct buffer *b = 0;
1406 if (BUFFERP(readcharfun))
1407 b = XBUFFER(readcharfun);
1408 else if (MARKERP(readcharfun))
1409 b = XMARKER(readcharfun)->buffer;
1411 /* Don't do this. It is not necessary, and it needlessly exposes
1412 READCHARFUN (which can be a stream) to Lisp. --hniksic */
1413 /*specbind (Qstandard_input, readcharfun); */
1415 specbind(Qcurrent_load_list, Qnil);
1417 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1418 Vcurrent_compiled_function_annotation = Qnil;
1420 GCPRO2(val, sourcename);
1422 LOADHIST_ATTACH(sourcename);
1427 if (b != 0 && !BUFFER_LIVE_P(b))
1428 error("Reading from killed buffer");
1430 c = readchar(readcharfun);
1433 while ((c = readchar(readcharfun)) != '\n' && c != -1)
1440 /* Ignore whitespace here, so we can detect eof. */
1441 if (c == ' ' || c == '\t' || c == '\n' || c == '\f'
1445 #if 0 /* FSFmacs defun hack */
1446 if (purify_flag && c == '(') {
1447 int count1 = specpdl_depth();
1448 record_unwind_protect(unreadpure, Qnil);
1449 val = read_list(readcharfun, ')', -1, 1);
1450 unbind_to(count1, Qnil);
1452 #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
1454 unreadchar(readcharfun, c);
1455 Vread_objects = Qnil;
1456 if (NILP(Vload_read_function))
1457 val = read0(readcharfun);
1459 val = call1(Vload_read_function, readcharfun);
1462 val = (*evalfun) (val);
1464 Vvalues = Fcons(val, Vvalues);
1465 if (EQ(Vstandard_output, Qt))
1472 build_load_history(LSTREAMP(readcharfun) ||
1473 /* This looks weird, but it's what's in FSFmacs */
1474 (b ? BUF_NARROWED(b) : BUF_NARROWED(current_buffer)),
1478 unbind_to(speccount, Qnil);
1481 DEFUN("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /*
1482 Execute BUFFER as Lisp code.
1483 Programs can pass two arguments, BUFFER and PRINTFLAG.
1484 BUFFER is the buffer to evaluate (nil means use current buffer).
1485 PRINTFLAG controls printing of output:
1486 nil means discard it; anything else is a stream for printing.
1488 If there is no error, point does not move. If there is an error,
1489 point remains at the end of the last character read from the buffer.
1491 (buffer, printflag))
1493 /* This function can GC */
1494 int speccount = specpdl_depth();
1495 Lisp_Object tem, buf;
1498 buf = Fcurrent_buffer();
1500 buf = Fget_buffer(buffer);
1502 error("No such buffer.");
1504 if (NILP(printflag))
1505 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1508 specbind(Qstandard_output, tem);
1509 record_unwind_protect(save_excursion_restore, save_excursion_save());
1510 BUF_SET_PT(XBUFFER(buf), BUF_BEGV(XBUFFER(buf)));
1511 readevalloop(buf, XBUFFER(buf)->filename, Feval, !NILP(printflag));
1513 return unbind_to(speccount, Qnil);
1517 xxDEFUN("eval-current-buffer", Feval_current_buffer, 0, 1, "", /*
1518 Execute the current buffer as Lisp code.
1519 Programs can pass argument PRINTFLAG which controls printing of output:
1520 nil means discard it; anything else is stream for print.
1522 If there is no error, point does not move. If there is an error,
1523 point remains at the end of the last character read from the buffer.
1530 DEFUN("eval-region", Feval_region, 2, 3, "r", /*
1531 Execute the region as Lisp code.
1532 When called from programs, expects two arguments START and END
1533 giving starting and ending indices in the current buffer
1534 of the text to be executed.
1535 Programs can pass third optional argument STREAM which controls output:
1536 nil means discard it; anything else is stream for printing it.
1538 If there is no error, point does not move. If there is an error,
1539 point remains at the end of the last character read from the buffer.
1541 Note: Before evaling the region, this function narrows the buffer to it.
1542 If the code being eval'd should happen to trigger a redisplay you may
1543 see some text temporarily disappear because of this.
1545 (start, end, stream))
1547 /* This function can GC */
1548 int speccount = specpdl_depth();
1550 Lisp_Object cbuf = Fcurrent_buffer();
1553 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1556 specbind(Qstandard_output, tem);
1559 record_unwind_protect(save_excursion_restore,
1560 save_excursion_save());
1561 record_unwind_protect(save_restriction_restore,
1562 save_restriction_save());
1564 /* This both uses start and checks its type. */
1565 Fgoto_char(start, cbuf);
1566 Fnarrow_to_region(make_int(BUF_BEGV(current_buffer)), end, cbuf);
1567 readevalloop(cbuf, XBUFFER(cbuf)->filename, Feval, !NILP(stream));
1569 return unbind_to(speccount, Qnil);
1572 DEFUN("read", Fread, 0, 1, 0, /*
1573 Read one Lisp expression as text from STREAM, return as Lisp object.
1574 If STREAM is nil, use the value of `standard-input' (which see).
1575 STREAM or the value of `standard-input' may be:
1576 a buffer (read from point and advance it)
1577 a marker (read from where it points and advance it)
1578 a function (call it with no arguments for each character,
1579 call it with a char as argument to push a char back)
1580 a string (takes text from string, starting at the beginning)
1581 t (read text line using minibuffer and use it).
1586 stream = Vstandard_input;
1588 stream = Qread_char;
1590 Vread_objects = Qnil;
1592 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1593 Vcurrent_compiled_function_annotation = Qnil;
1595 if (EQ(stream, Qread_char)) {
1596 Lisp_Object val = call1(Qread_from_minibuffer,
1597 build_translated_string
1598 ("Lisp expression: "));
1599 return Fcar(Fread_from_string(val, Qnil, Qnil));
1602 if (STRINGP(stream))
1603 return Fcar(Fread_from_string(stream, Qnil, Qnil));
1605 return read0(stream);
1608 DEFUN("read-from-string", Fread_from_string, 1, 3, 0, /*
1609 Read one Lisp expression which is represented as text by STRING.
1610 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1611 START and END optionally delimit a substring of STRING from which to read;
1612 they default to 0 and (length STRING) respectively.
1614 (string, start, end))
1616 Bytecount startval, endval;
1618 Lisp_Object lispstream = Qnil;
1619 struct gcpro gcpro1;
1621 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1622 Vcurrent_compiled_function_annotation = Qnil;
1625 CHECK_STRING(string);
1626 get_string_range_byte(string, start, end, &startval, &endval,
1627 GB_HISTORICAL_STRING_BEHAVIOR);
1628 lispstream = make_lisp_string_input_stream(string, startval,
1631 Vread_objects = Qnil;
1633 tem = read0(lispstream);
1634 /* Yeah, it's ugly. Gonna make something of it?
1635 At least our reader is reentrant ... */
1637 (Fcons(tem, make_int
1638 (bytecount_to_charcount
1639 (XSTRING_DATA(string),
1640 startval + Lstream_byte_count(XLSTREAM(lispstream))))));
1641 Lstream_delete(XLSTREAM(lispstream));
1647 ureader_find(Lisp_Object name)
1649 return Fcdr(Fassoc(name, Vureaders));
1654 * ureader_read() assumes that input starts with < character and
1655 * should finish on matching > character.
1658 ureader_read(Lisp_Object ureader_fun, Lisp_Object readcharfun)
1661 unsigned int oparens = 0;
1662 struct gcpro gcpro1;
1665 Lstream_rewind(XLSTREAM(Vread_buffer_stream));
1666 while ((c = readchar(readcharfun)) >= 0) {
1669 else if (c == '>') {
1671 /* We got final closing paren */
1676 Lstream_put_emchar(XLSTREAM (Vread_buffer_stream), c);
1680 return Fsignal(Qend_of_file,
1681 list1(READCHARFUN_MAYBE(readcharfun)));
1683 Lstream_flush(XLSTREAM(Vread_buffer_stream));
1685 instr = make_string(resizing_buffer_stream_ptr
1686 (XLSTREAM(Vread_buffer_stream)),
1687 Lstream_byte_count(XLSTREAM(Vread_buffer_stream)));
1689 RETURN_UNGCPRO(call1(ureader_fun, instr));
1693 #ifdef LISP_BACKQUOTES
1695 static Lisp_Object backquote_unwind(Lisp_Object ptr)
1696 { /* used as unwind-protect function in read0() */
1697 int *counter = (int *)get_opaque_ptr(ptr);
1700 free_opaque_ptr(ptr);
1706 /* Use this for recursive reads, in contexts where internal tokens
1707 are not allowed. See also read1(). */
1708 static Lisp_Object read0(Lisp_Object readcharfun)
1710 Lisp_Object val = read1(readcharfun);
1712 if (CONSP(val) && UNBOUNDP(XCAR(val))) {
1713 Emchar c = XCHAR(XCDR(val));
1714 free_cons(XCONS(val));
1715 return Fsignal(Qinvalid_read_syntax,
1716 list1(Fchar_to_string(make_char(c))));
1722 static Emchar read_escape(Lisp_Object readcharfun)
1724 /* This function can GC */
1725 Emchar c = readchar(readcharfun);
1728 signal_error(Qend_of_file,
1729 list1(READCHARFUN_MAYBE(readcharfun)));
1754 c = readchar(readcharfun);
1756 signal_error(Qend_of_file,
1757 list1(READCHARFUN_MAYBE(readcharfun)));
1759 error("Invalid escape character syntax");
1760 c = readchar(readcharfun);
1762 signal_error(Qend_of_file,
1763 list1(READCHARFUN_MAYBE(readcharfun)));
1765 c = read_escape(readcharfun);
1768 /* Originally, FSF_KEYS provided a degree of FSF Emacs
1769 compatibility by defining character "modifiers" alt, super,
1770 hyper and shift to infest the characters (i.e. integers).
1772 However, this doesn't cut it for XEmacs 20, which
1773 distinguishes characters from integers. Without Mule, ?\H-a
1774 simply returns ?a because every character is clipped into
1775 0-255. Under Mule it is much worse -- ?\H-a with FSF_KEYS
1776 produces an illegal character, and moves us to crash-land.
1778 For these reasons, FSF_KEYS hack is useless and without hope
1779 of ever working under XEmacs 20. */
1783 #define alt_modifier (0x040000)
1784 #define super_modifier (0x080000)
1785 #define hyper_modifier (0x100000)
1786 #define shift_modifier (0x200000)
1787 /* fsf uses a different modifiers for meta and control. Possibly
1788 byte_compiled code will still work fsfmacs, though... --Stig
1790 #define ctl_modifier (0x400000)
1791 #define meta_modifier (0x800000)
1793 #define FSF_LOSSAGE(mask) \
1794 if (fail_on_bucky_bit_character_escapes || \
1795 ((c = readchar (readcharfun)) != '-')) \
1796 error ("Invalid escape character syntax"); \
1797 c = readchar (readcharfun); \
1799 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun))); \
1801 c = read_escape (readcharfun); \
1805 FSF_LOSSAGE(shift_modifier);
1807 FSF_LOSSAGE(hyper_modifier);
1809 FSF_LOSSAGE(alt_modifier);
1811 FSF_LOSSAGE(super_modifier);
1813 #undef super_modifier
1814 #undef hyper_modifier
1815 #undef shift_modifier
1818 #endif /* FSF_KEYS */
1821 c = readchar(readcharfun);
1823 signal_error(Qend_of_file,
1824 list1(READCHARFUN_MAYBE(readcharfun)));
1826 error("Invalid escape character syntax");
1828 c = readchar(readcharfun);
1830 signal_error(Qend_of_file,
1831 list1(READCHARFUN_MAYBE(readcharfun)));
1833 c = read_escape(readcharfun);
1834 /* FSFmacs junk for non-ASCII controls.
1839 return c & (0200 | 037);
1849 /* An octal escape, as in ANSI C. */
1851 REGISTER Emchar i = c - '0';
1852 REGISTER int count = 0;
1853 while (++count < 3) {
1854 if ((c = readchar(readcharfun)) >= '0'
1856 i = (i << 3) + (c - '0');
1858 unreadchar(readcharfun, c);
1866 /* A hex escape, as in ANSI C, except that we only allow latin-1
1867 characters to be read this way. What is "\x4e03" supposed to
1868 mean, anyways, if the internal representation is hidden?
1869 This is also consistent with the treatment of octal escapes. */
1871 REGISTER Emchar i = 0;
1872 REGISTER int count = 0;
1873 while (++count <= 2) {
1874 c = readchar(readcharfun);
1875 /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
1876 if (c >= '0' && c <= '9')
1877 i = (i << 4) + (c - '0');
1878 else if (c >= 'a' && c <= 'f')
1879 i = (i << 4) + (c - 'a') + 10;
1880 else if (c >= 'A' && c <= 'F')
1881 i = (i << 4) + (c - 'A') + 10;
1883 unreadchar(readcharfun, c);
1891 /* #### need some way of reading an extended character with
1892 an escape sequence. */
1900 /* read symbol-constituent stuff into `Vread_buffer_stream'. */
1902 read_atom_0(Lisp_Object readcharfun, Emchar firstchar, int *saw_a_backslash)
1904 /* This function can GC */
1905 Emchar c = ((firstchar) >= 0 ? firstchar : readchar(readcharfun));
1906 Lstream_rewind(XLSTREAM(Vread_buffer_stream));
1908 *saw_a_backslash = 0;
1910 while (c > 040 /* #### - comma should be here as should backquote */
1911 && !(c == '\"' || c == '\'' || c == ';' || c == '(' || c == ')'
1912 #ifndef HAVE_FPFLOAT
1913 /* If we have floating-point support, then we need
1914 to allow <digits><dot><digits>. */
1916 #endif /* not HAVE_FPFLOAT */
1917 || c == '[' || c == ']' || c == '#')) {
1919 c = readchar(readcharfun);
1921 signal_error(Qend_of_file,
1922 list1(READCHARFUN_MAYBE
1924 *saw_a_backslash = 1;
1926 Lstream_put_emchar(XLSTREAM(Vread_buffer_stream), c);
1928 c = readchar(readcharfun);
1932 unreadchar(readcharfun, c);
1933 /* blasted terminating 0 */
1934 Lstream_put_emchar(XLSTREAM(Vread_buffer_stream), 0);
1935 Lstream_flush(XLSTREAM(Vread_buffer_stream));
1937 return Lstream_byte_count(XLSTREAM(Vread_buffer_stream)) - 1;
1940 static Lisp_Object parse_integer(const Bufbyte * buf, Bytecount len, int base);
1943 read_atom(Lisp_Object readcharfun, Emchar firstchar, int uninterned_symbol)
1945 /* This function can GC */
1946 int saw_a_backslash;
1947 Bytecount len = read_atom_0(readcharfun, firstchar, &saw_a_backslash);
1948 char *read_ptr = (char *)
1949 resizing_buffer_stream_ptr(XLSTREAM(Vread_buffer_stream));
1951 /* Is it an integer? */
1952 if (!(saw_a_backslash || uninterned_symbol)) {
1953 /* If a token had any backslashes in it, it is disqualified from
1954 being an integer or a float. This means that 123\456 is a
1955 symbol, as is \123 (which is the way (intern "123") prints).
1956 Also, if token was preceded by #:, it's always a symbol.
1958 char *p = read_ptr + len;
1959 char *p1 = read_ptr;
1961 if (*p1 == '+' || *p1 == '-')
1966 while (p1 != p && (c = *p1) >= '0' && c <= '9')
1969 /* Integers can have trailing decimal points. */
1970 if (p1 > read_ptr && p1 < p && *p1 == '.')
1974 /* It is an integer. */
1979 return parse_integer((Bufbyte*)read_ptr, len,
1983 #if defined HAVE_MPQ && defined WITH_GMP
1984 if (isbigq_string(read_ptr))
1985 return read_bigq_string(read_ptr);
1987 #if defined HAVE_MPFR && defined WITH_MPFR
1988 if (isfloat_string(read_ptr) && (Vread_real_as == Qbigfr))
1989 return read_bigfr_string(read_ptr);
1990 #endif /* HAVE_MPFR */
1991 #if defined HAVE_MPF && defined WITH_GMP
1992 if (isfloat_string(read_ptr) && (Vread_real_as == Qbigf))
1993 return read_bigf_string(read_ptr);
1995 #endif /* HAVE_MPF */
1997 if (isfloat_string(read_ptr)) {
1998 return make_float(str_to_fpfloat(read_ptr));
2001 #if defined HAVE_PSEUG && defined WITH_PSEUG
2002 if (isgaussian_string(read_ptr))
2003 return read_bigg_string(read_ptr);
2005 #if defined HAVE_MPC && defined WITH_MPC || \
2006 defined HAVE_PSEUC && defined WITH_PSEUC
2007 if (isbigc_string(read_ptr))
2008 return read_bigc_string(read_ptr);
2009 #endif /* HAVE_MPC */
2010 #if defined HAVE_QUATERN && defined WITH_QUATERN
2011 if (isquatern_string(read_ptr))
2012 return read_quatern_string(read_ptr);
2016 /* check for resclass syntax */
2017 if (ase_resc_rng_pred_f && ase_resc_rng_f &&
2018 ase_resc_rng_pred_f(read_ptr))
2019 return ase_resc_rng_f(read_ptr);
2020 if (ase_resc_elm_pred_f && ase_resc_elm_f &&
2021 ase_resc_elm_pred_f(read_ptr))
2022 return ase_resc_elm_f(read_ptr);
2026 if (uninterned_symbol)
2028 Fmake_symbol(make_string
2029 ((Bufbyte *) read_ptr, len));
2032 make_string((Bufbyte *) read_ptr, len);
2033 sym = Fintern(name, Qnil);
2040 parse_integer(const Bufbyte * buf, Bytecount len, int base)
2042 const Bufbyte *lim = buf + len;
2043 const Bufbyte *p = buf;
2045 int negativland = 0;
2050 } else if (*p == '+') {
2057 for (; (p < lim) && (*p != '\0'); p++) {
2063 else if (isupper(c))
2065 else if (islower(c))
2070 if (c < 0 || c >= base)
2074 num = num * base + c;
2080 EMACS_INT int_result =
2081 negativland ? -(EMACS_INT) num : (EMACS_INT) num;
2082 Lisp_Object result = make_int(int_result);
2083 if (num && ((XINT(result) < 0) != negativland))
2085 if (XINT(result) != int_result)
2090 #if defined HAVE_MPZ && (defined WITH_GMP || defined WITH_BSDMP)
2091 return read_bigz_string((const char*)buf, base);
2093 /* This is going to kill us!
2094 * Big integers cannot be used anywhere if the reader rewards
2095 * their occurence that harshly
2097 return Fsignal(Qinvalid_read_syntax,
2098 list3(build_translated_string
2099 ("Integer constant overflow in reader"),
2100 make_string(buf, len), make_int(base)));
2102 warn_when_safe(Qinvalid_read_syntax, Qwarning,
2103 "Integer constant overflow in reader: %s,"
2104 " proceeding nervously with 0.",
2107 #endif /* HAVE_MPZ && WITH_GMP||WITH_BSDMP */
2109 return Fsignal(Qinvalid_read_syntax,
2110 list3(build_translated_string
2111 ("Invalid integer constant in reader"),
2112 make_string(buf, len), make_int(base)));
2116 read_integer(Lisp_Object readcharfun, int base)
2118 /* This function can GC */
2119 int saw_a_backslash;
2120 Bytecount len = read_atom_0(readcharfun, -1, &saw_a_backslash);
2121 return (parse_integer
2122 (resizing_buffer_stream_ptr(XLSTREAM(Vread_buffer_stream)),
2124 ? 0 /* make parse_integer signal error */
2129 read_bit_vector(Lisp_Object readcharfun)
2131 unsigned_char_dynarr *dyn = Dynarr_new(unsigned_char);
2136 Emchar c = readchar(readcharfun);
2143 unreadchar(readcharfun, c);
2146 Dynarr_add(dyn, bit);
2149 val = make_bit_vector_from_byte_vector(Dynarr_atp(dyn, 0),
2150 Dynarr_length(dyn));
2158 struct structure_type*
2159 define_structure_type(Lisp_Object type,
2160 int(*validate)(Lisp_Object data, Error_behavior errb),
2161 Lisp_Object(*instantiate)(Lisp_Object data))
2163 struct structure_type st;
2166 st.keywords = Dynarr_new(structure_keyword_entry);
2167 st.validate = validate;
2168 st.instantiate = instantiate;
2169 Dynarr_add(the_structure_type_dynarr, st);
2171 return Dynarr_atp(the_structure_type_dynarr,
2172 Dynarr_length(the_structure_type_dynarr) - 1);
2176 define_structure_type_keyword(struct structure_type *st, Lisp_Object keyword,
2177 int (*validate) (Lisp_Object keyword,
2179 Error_behavior errb))
2181 struct structure_keyword_entry en;
2183 en.keyword = keyword;
2184 en.validate = validate;
2185 Dynarr_add(st->keywords, en);
2188 static struct structure_type*
2189 recognized_structure_type(Lisp_Object type)
2193 for (i = 0; i < Dynarr_length(the_structure_type_dynarr); i++) {
2194 struct structure_type *st =
2195 Dynarr_atp(the_structure_type_dynarr, i);
2196 if (EQ(st->type, type))
2204 read_structure(Lisp_Object readcharfun)
2206 Emchar c = readchar(readcharfun);
2207 Lisp_Object list = Qnil;
2208 Lisp_Object orig_list = Qnil;
2209 Lisp_Object already_seen = Qnil;
2211 struct structure_type *st;
2212 struct gcpro gcpro1, gcpro2;
2214 GCPRO2(orig_list, already_seen);
2216 RETURN_UNGCPRO(continuable_read_syntax_error
2217 ("#s not followed by paren"));
2218 list = read_list(readcharfun, ')', 0, 0);
2221 int len = XINT(Flength(list));
2223 RETURN_UNGCPRO(continuable_read_syntax_error
2224 ("structure type not specified"));
2227 (continuable_read_syntax_error
2228 ("structures must have alternating keyword/value pairs"));
2231 st = recognized_structure_type(XCAR(list));
2233 RETURN_UNGCPRO(Fsignal(Qinvalid_read_syntax,
2234 list2(build_translated_string
2235 ("unrecognized structure type"),
2239 keyword_count = Dynarr_length(st->keywords);
2240 while (!NILP(list)) {
2241 Lisp_Object keyword, value;
2243 struct structure_keyword_entry *en = NULL;
2245 keyword = Fcar(list);
2250 if (!NILP(memq_no_quit(keyword, already_seen)))
2251 RETURN_UNGCPRO(Fsignal(Qinvalid_read_syntax,
2252 list2(build_translated_string
2253 ("structure keyword already seen"),
2256 for (i = 0; i < keyword_count; i++) {
2257 en = Dynarr_atp(st->keywords, i);
2258 if (EQ(keyword, en->keyword))
2262 if (i == keyword_count)
2263 RETURN_UNGCPRO(Fsignal(Qinvalid_read_syntax,
2264 list2(build_translated_string
2265 ("unrecognized structure keyword"),
2268 if (en->validate && !(en->validate) (keyword, value, ERROR_ME))
2270 (Fsignal(Qinvalid_read_syntax,
2271 list3(build_translated_string
2272 ("invalid value for structure keyword"),
2275 already_seen = Fcons(keyword, already_seen);
2278 if (st->validate && !(st->validate) (orig_list, ERROR_ME))
2279 RETURN_UNGCPRO(Fsignal(Qinvalid_read_syntax,
2280 list2(build_translated_string
2281 ("invalid structure initializer"),
2284 RETURN_UNGCPRO((st->instantiate) (XCDR(orig_list)));
2287 static Lisp_Object read_compiled_function(Lisp_Object readcharfun, int);
2288 static Lisp_Object read_vector(Lisp_Object readcharfun, int terminator);
2290 /* Get the next character; filter out whitespace and comments */
2293 reader_nextchar(Lisp_Object readcharfun)
2295 /* This function can GC */
2300 c = readchar(readcharfun);
2302 signal_error(Qend_of_file,
2303 list1(READCHARFUN_MAYBE(readcharfun)));
2308 /* Ignore whitespace and control characters */
2317 while ((c = readchar(readcharfun)) >= 0 && c != '\n')
2325 static Lisp_Object list2_pure(int pure, Lisp_Object a, Lisp_Object b)
2327 return pure ? pure_cons(a, pure_cons(b, Qnil)) : list2(a, b);
2331 /* Read the next Lisp object from the stream READCHARFUN and return it.
2332 If the return value is a cons whose car is Qunbound, then read1()
2333 encountered a misplaced token (e.g. a right bracket, right paren,
2334 or dot followed by a non-number). To filter this stuff out,
2338 read_string(Lisp_Object readcharfun, Emchar delim, int raw)
2341 /* #### If the input stream is translating, then the string
2342 should be marked as translatable by setting its
2343 `string-translatable' property to t. .el and .elc files
2344 normally are translating input streams. See Fgettext()
2345 and print_internal(). */
2350 Lstream_rewind(XLSTREAM(Vread_buffer_stream));
2351 while ((c = readchar(readcharfun)) >= 0 && c != delim) {
2354 /* For raw strings, insert the
2355 backslash and the next char, */
2357 XLSTREAM(Vread_buffer_stream), c);
2358 c = readchar(readcharfun);
2360 /* otherwise, backslash escapes the next char */
2361 c = read_escape(readcharfun);
2364 /* c is -1 if \ newline has just been seen */
2366 if (!Lstream_byte_count(XLSTREAM(Vread_buffer_stream))) {
2370 Lstream_put_emchar(XLSTREAM
2371 (Vread_buffer_stream),
2377 return Fsignal(Qend_of_file,
2378 list1(READCHARFUN_MAYBE(readcharfun)));
2381 /* If purifying, and string starts with \ newline,
2382 return zero instead. This is for doc strings
2383 that we are really going to find in lib-src/DOC.nn.nn */
2384 if (purify_flag && NILP(Vinternal_doc_file_name) && cancel) {
2388 Lstream_flush(XLSTREAM(Vread_buffer_stream));
2389 return make_string(resizing_buffer_stream_ptr
2390 (XLSTREAM(Vread_buffer_stream)),
2391 Lstream_byte_count(XLSTREAM(Vread_buffer_stream)));
2395 read_raw_string(Lisp_Object readcharfun)
2398 c = reader_nextchar(readcharfun);
2400 /* #r:engine"my sexy raw string" -- raw string w/ flags*/
2402 /* #r"my raw string" -- raw string */
2404 return read_string(readcharfun, '\"', 1);
2405 /* invalid syntax */
2407 unreadchar(readcharfun, c);
2408 return Fsignal(Qinvalid_read_syntax,
2410 ("unrecognized raw string syntax")));
2416 read1(Lisp_Object readcharfun)
2421 c = reader_nextchar(readcharfun);
2425 #ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
2426 /* if this is disabled, then other code in eval.c must be
2428 Emchar ch = reader_nextchar(readcharfun);
2432 int speccount = specpdl_depth();
2433 ++old_backquote_flag;
2434 record_unwind_protect(backquote_unwind,
2436 (&old_backquote_flag));
2437 tem = read0(readcharfun);
2438 unbind_to(speccount, Qnil);
2439 ch = reader_nextchar(readcharfun);
2441 unreadchar(readcharfun, ch);
2444 (Qinvalid_read_syntax,
2446 ("Weird old-backquote syntax")));
2448 return list2(Qbacktick, tem);
2451 if (old_backquote_flag) {
2452 Lisp_Object tem, comma_type;
2453 ch = readchar(readcharfun);
2455 comma_type = Qcomma_at;
2461 comma_type = Qcomma;
2463 tem = read0(readcharfun);
2464 ch = reader_nextchar
2467 unreadchar(readcharfun,
2470 Qinvalid_read_syntax,
2472 ("Weird old-backquote "
2475 return list2(comma_type, tem);
2477 unreadchar(readcharfun, ch);
2481 (Qinvalid_read_syntax,
2483 ("Comma outside of backquote")));
2485 /* #### - yuck....but this is reverse
2487 /* mostly this is required by edebug, which does
2488 its own annotated reading. We need to have
2489 an annotated_read function that records (with
2490 markers) the buffer positions of the elements
2491 that make up lists, then that can be used in
2492 edebug and bytecomp and the check above can
2493 go back in. --Stig */
2499 unreadchar(readcharfun, ch);
2501 #endif /* old backquote crap... */
2502 return read_list(readcharfun, ')', 1, 1);
2505 return read_vector(readcharfun, ']');
2509 /* #### - huh? these don't do what they seem... */
2510 return noseeum_cons(Qunbound, make_char(c));
2513 /* If a period is followed by a number, then we should read it
2514 as a floating point number. Otherwise, it denotes a dotted
2517 c = readchar(readcharfun);
2518 unreadchar(readcharfun, c);
2520 /* Can't use isdigit on Emchars */
2521 if (c < '0' || c > '9')
2522 return noseeum_cons(Qunbound, make_char('.'));
2524 /* Note that read_atom will loop
2525 at least once, assuring that we will not try to UNREAD
2526 two characters in a row.
2527 (I think this doesn't matter anymore because there should
2528 be no more danger in unreading multiple characters) */
2529 return read_atom(readcharfun, '.', 0);
2531 #else /* ! HAVE_FPFLOAT */
2532 return noseeum_cons(Qunbound, make_char('.'));
2533 #endif /* ! HAVE_FPFLOAT */
2537 c = readchar(readcharfun);
2539 #if 0 /* FSFmacs silly char-table syntax */
2542 #if 0 /* FSFmacs silly bool-vector syntax */
2545 /* "#["-- byte-code constant syntax */
2546 /* purecons #[...] syntax */
2548 return read_compiled_function(readcharfun, ']'
2551 /* "#:"-- gensym syntax */
2553 return read_atom(readcharfun, -1, 1);
2554 /* #'x => (function x) */
2556 return list2(Qfunction, read0(readcharfun));
2558 /* RMS uses this syntax for fat-strings.
2559 If we use it for vectors, then obscure bugs happen.
2561 /* "#(" -- Scheme/CL vector syntax */
2563 return read_vector(readcharfun, ')');
2566 /* When are we going to drop this crap??? -hroptatyr */
2569 struct gcpro gcpro1;
2571 /* Read the string itself. */
2572 tmp = read1(readcharfun);
2573 if (!STRINGP(tmp)) {
2575 && UNBOUNDP(XCAR(tmp)))
2576 free_cons(XCONS(tmp));
2579 (Qinvalid_read_syntax,
2580 list1(build_string("#")));
2583 /* Read the intervals and their properties. */
2585 Lisp_Object beg, end, plist;
2589 beg = read1(readcharfun);
2590 if (CONSP(beg) && UNBOUNDP(XCAR(beg))) {
2591 ch = XCHAR(XCDR(beg));
2592 free_cons(XCONS(beg));
2603 UNBOUNDP(XCAR(end)))
2625 (Qinvalid_read_syntax,
2631 Fset_text_properties(beg, end, plist, tmp);
2638 /* #@NUMBER is used to skip NUMBER following characters.
2639 That's used in .elc files to skip over doc strings
2640 and function definitions. */
2643 /* Read a decimal integer. */
2644 while ((c = readchar(readcharfun)) >= 0
2645 && c >= '0' && c <= '9')
2647 (10 * nskip) + (c - '0');
2649 unreadchar(readcharfun, c);
2651 /* FSF has code here that maybe caches the skipped
2652 string. See above for why this is totally
2653 losing. We handle this differently. */
2655 /* Skip that many characters. */
2656 for (i = 0; i < nskip && c >= 0; i++)
2657 c = readchar(readcharfun);
2662 return Vload_file_name_internal;
2665 return read_bit_vector(readcharfun);
2666 /* #o10 => 8 -- octal constant syntax */
2668 return read_integer(readcharfun, 8);
2669 /* #xdead => 57005 -- hex constant syntax */
2671 return read_integer(readcharfun, 16);
2672 /* #b010 => 2 -- binary constant syntax */
2674 return read_integer(readcharfun, 2);
2677 Emchar _c_ = reader_nextchar(readcharfun);
2678 /* check for permutation syntax */
2681 read_vector(readcharfun, ']');
2682 if (ase_permutation_f) {
2683 return ase_permutation_f(perm);
2688 unreadchar(readcharfun, _c_);
2690 "unrecognised permutation syntax");
2692 Qinvalid_read_syntax, list1(err));
2697 /* #r"raw\stringt" -- raw string syntax */
2698 return read_raw_string(readcharfun);
2701 /* #s(foobar key1 val1 key2 val2) --
2702 * structure syntax */
2703 return read_structure(readcharfun);
2705 /* Check user readers */
2706 Lisp_Object uoname = read_string(readcharfun, ' ', 0);
2707 Lisp_Object ureader = ureader_find(uoname);
2709 return ureader_read(ureader, readcharfun);
2711 unreadchar(readcharfun, c);
2712 return Fsignal(Qinvalid_read_syntax,
2714 ("No ureader for"), uoname));
2716 #ifdef FEATUREP_SYNTAX
2719 Lisp_Object feature_exp, obj, tem;
2720 struct gcpro gcpro1, gcpro2;
2722 feature_exp = read0(readcharfun);
2723 obj = read0(readcharfun);
2725 /* the call to `featurep' may GC. */
2726 GCPRO2(feature_exp, obj);
2727 tem = call1(Qfeaturep, feature_exp);
2730 if (c == '+' && NILP(tem))
2732 if (c == '-' && !NILP(tem))
2747 /* Reader forms that can reuse previously read
2752 /* Using read_integer() here is impossible, because it
2753 chokes on `='. Using parse_integer() is too hard.
2754 So we simply read it in, and ignore overflows, which
2756 while (c >= '0' && c <= '9') {
2759 c = readchar(readcharfun);
2761 found = assq_no_quit(make_int(n), Vread_objects);
2763 /* #n=object returns object, but associates it
2770 (Qinvalid_read_syntax,
2772 (build_translated_string
2773 ("Multiply defined symbol label"),
2775 obj = read0(readcharfun);
2781 } else if (c == '#') {
2782 /* #n# returns a previously read object. */
2788 (Qinvalid_read_syntax,
2790 (build_translated_string
2791 ("Undefined symbol label"),
2794 return Fsignal(Qinvalid_read_syntax,
2799 unreadchar(readcharfun, c);
2800 return Fsignal(Qinvalid_read_syntax,
2809 return list2(Qquote, read0(readcharfun));
2811 #ifdef LISP_BACKQUOTES
2814 int speccount = specpdl_depth();
2815 ++new_backquote_flag;
2816 record_unwind_protect(backquote_unwind,
2818 (&new_backquote_flag));
2819 tem = read0(readcharfun);
2820 unbind_to(speccount, Qnil);
2821 return list2(Qbackquote, tem);
2825 if (new_backquote_flag) {
2826 Lisp_Object comma_type = Qnil;
2827 int ch = readchar(readcharfun);
2830 comma_type = Qcomma_at;
2832 comma_type = Qcomma_dot;
2835 unreadchar(readcharfun, ch);
2836 comma_type = Qcomma;
2838 return list2(comma_type, read0(readcharfun));
2840 /* YUCK. 99.999% backwards compatibility. The Right
2841 Thing(tm) is to signal an error here, because it's
2842 really invalid read syntax. Instead, this permits
2843 commas to begin symbols (unless they're inside
2844 backquotes). If an error is signalled here in the
2845 future, then commas should be invalid read syntax
2846 outside of backquotes anywhere they're found (i.e.
2847 they must be quoted in symbols) -- Stig */
2848 return read_atom(readcharfun, c, 0);
2854 /* Evil GNU Emacs "character" (ie integer) syntax */
2855 c = readchar(readcharfun);
2857 return Fsignal(Qend_of_file,
2858 list1(READCHARFUN_MAYBE
2862 c = read_escape(readcharfun);
2863 return make_char(c);
2868 return read_string(readcharfun, '\"', 0);
2871 /* Ignore whitespace and control characters */
2874 return read_atom(readcharfun, c, 0);
2886 /* for complex numbers */
2887 #define INTERMEDIATE_UNARY_SYMBOL 32
2888 #define LEAD_INT2 64
2889 #define DOT_CHAR2 128
2890 #define TRAIL_INT2 256
2892 #define EXP_INT2 1024
2898 isfloat_string(const char *cp)
2901 const Bufbyte *ucp = (const Bufbyte *)cp;
2903 if (*ucp == '+' || *ucp == '-')
2906 if (*ucp >= '0' && *ucp <= '9') {
2908 while (*ucp >= '0' && *ucp <= '9')
2915 if (*ucp >= '0' && *ucp <= '9') {
2917 while (*ucp >= '0' && *ucp <= '9')
2920 if (*ucp == 'e' || *ucp == 'E') {
2923 if ((*ucp == '+') || (*ucp == '-'))
2927 if (*ucp >= '0' && *ucp <= '9') {
2929 while (*ucp >= '0' && *ucp <= '9')
2932 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t')
2934 || (*ucp == '\r') || (*ucp == '\f'))
2935 && (state == (LEAD_INT | DOT_CHAR | TRAIL_INT)
2936 || state == (DOT_CHAR | TRAIL_INT)
2937 || state == (LEAD_INT | E_CHAR | EXP_INT)
2939 (LEAD_INT | DOT_CHAR | TRAIL_INT | E_CHAR | EXP_INT)
2940 || state == (DOT_CHAR | TRAIL_INT | E_CHAR | EXP_INT)));
2942 #endif /* HAVE_FPFLOAT */
2943 #if defined HAVE_MPC && defined WITH_MPC || \
2944 defined HAVE_PSEUC && defined WITH_PSEUC
2946 isbigc_string (const char *cp)
2949 const Bufbyte *ucp = (const Bufbyte *)cp;
2952 /* parse the real part */
2954 if (*ucp == '+' || *ucp == '-')
2957 if (*ucp >= '0' && *ucp <= '9') {
2959 while (*ucp >= '0' && *ucp <= '9')
2966 if (*ucp >= '0' && *ucp <= '9') {
2968 while (*ucp >= '0' && *ucp <= '9')
2971 if (*ucp == 'e' || *ucp == 'E') {
2974 if ((*ucp == '+') || (*ucp == '-'))
2978 if (*ucp >= '0' && *ucp <= '9') {
2980 while (*ucp >= '0' && *ucp <= '9')
2984 /* check if we had a real number until here */
2985 if (!(state == (LEAD_INT | DOT_CHAR | TRAIL_INT) ||
2986 state == (DOT_CHAR | TRAIL_INT) ||
2987 state == (LEAD_INT | E_CHAR | EXP_INT) ||
2988 state == (LEAD_INT | DOT_CHAR | TRAIL_INT | E_CHAR | EXP_INT) ||
2989 state == (DOT_CHAR | TRAIL_INT | E_CHAR | EXP_INT)))
2992 /* now parse imaginary part */
2994 if (*ucp == '+' || *ucp == '-') {
2995 state |= INTERMEDIATE_UNARY_SYMBOL;
2999 if (*ucp >= '0' && *ucp <= '9') {
3001 while (*ucp >= '0' && *ucp <= '9')
3008 if (*ucp >= '0' && *ucp <= '9') {
3009 state |= TRAIL_INT2;
3010 while (*ucp >= '0' && *ucp <= '9')
3013 if (*ucp == 'e' || *ucp == 'E') {
3016 if ((*ucp == '+') || (*ucp == '-'))
3020 if (*ucp >= '0' && *ucp <= '9') {
3022 while (*ucp >= '0' && *ucp <= '9')
3025 if (*ucp == 'i' || *ucp == 'I') {
3029 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') ||
3030 (*ucp == '\n') || (*ucp == '\r') || (*ucp == '\f')) &&
3031 (state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 | DOT_CHAR2 |
3032 TRAIL_INT2 | I_CHAR) ||
3033 state == (INTERMEDIATE_UNARY_SYMBOL | DOT_CHAR2 |
3034 TRAIL_INT2 | I_CHAR) ||
3035 state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 |
3036 E_CHAR2 | EXP_INT2 | I_CHAR) ||
3037 state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 | DOT_CHAR2 |
3038 TRAIL_INT2 | E_CHAR2 | EXP_INT2 | I_CHAR) ||
3039 state == (INTERMEDIATE_UNARY_SYMBOL | DOT_CHAR2 | TRAIL_INT2 |
3040 E_CHAR2 | EXP_INT2 | I_CHAR) ||
3041 state == (INTERMEDIATE_UNARY_SYMBOL | I_CHAR)));
3043 #endif /* HAVE_MPC */
3044 #if defined WITH_PSEUG && defined HAVE_PSEUG
3046 isgaussian_string (const char *cp)
3049 const Bufbyte *ucp = (const Bufbyte *)cp;
3052 /* parse the real part */
3054 if (*ucp == '+' || *ucp == '-')
3057 if (*ucp >= '0' && *ucp <= '9') {
3059 while (*ucp >= '0' && *ucp <= '9')
3063 /* check if we had a int number until here */
3064 if (!(state == (LEAD_INT)))
3067 /* now parse imaginary part */
3069 if (*ucp == '+' || *ucp == '-') {
3070 state |= INTERMEDIATE_UNARY_SYMBOL;
3074 if (*ucp >= '0' && *ucp <= '9') {
3076 while (*ucp >= '0' && *ucp <= '9')
3079 if (*ucp == 'i' || *ucp == 'I') {
3083 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') ||
3084 (*ucp == '\n') || (*ucp == '\r') || (*ucp == '\f')) &&
3085 (state == (INTERMEDIATE_UNARY_SYMBOL | LEAD_INT2 | I_CHAR) ||
3086 state == (INTERMEDIATE_UNARY_SYMBOL | I_CHAR)));
3088 #endif /* HAVE_PSEUG */
3089 #if defined HAVE_MPQ && defined WITH_GMP
3091 isbigq_string (const char *cp)
3093 /* Possible minus/plus sign */
3094 if (*cp == '-' || *cp == '+')
3098 if (*cp < '0' || *cp > '9')
3103 } while (*cp >= '0' && *cp <= '9');
3110 if (*cp < '0' || *cp > '9')
3115 } while (*cp >= '0' && *cp <= '9');
3117 return *cp == '\0' || *cp == ' ' || *cp =='\t' || *cp == '\n' ||
3118 *cp == '\r' || *cp == '\f';
3120 #endif /* HAVE_MPQ */
3124 sequence_reader(Lisp_Object readcharfun,
3127 void*(*conser)(Lisp_Object, void*, Charcount))
3131 for (len = 0;; len++) {
3135 ch = reader_nextchar(readcharfun);
3137 if (ch == terminator)
3140 unreadchar(readcharfun, ch);
3141 #ifdef FEATUREP_SYNTAX
3143 read_syntax_error("\"]\" in a list");
3145 read_syntax_error("\")\" in a vector");
3147 state = ((conser) (readcharfun, state, len));
3151 struct read_list_state {
3155 int allow_dotted_lists;
3160 read_list_conser(Lisp_Object readcharfun, void *state, Charcount len)
3162 struct read_list_state *s = (struct read_list_state *)state;
3165 elt = read1(readcharfun);
3167 if (CONSP(elt) && UNBOUNDP(XCAR(elt))) {
3168 Lisp_Object tem = elt;
3172 free_cons(XCONS(tem));
3175 #ifdef FEATUREP_SYNTAX
3176 if (ch == s->terminator) {
3177 /* deal with #+, #- reader macros */
3178 unreadchar(readcharfun, s->terminator);
3180 } else if (ch == ']')
3181 read_syntax_error("']' in a list");
3183 read_syntax_error("')' in a vector");
3187 signal_simple_error("BUG! Internal reader error", elt);
3188 else if (!s->allow_dotted_lists)
3189 read_syntax_error("\".\" in a vector");
3192 XCDR(s->tail) = read0(readcharfun);
3194 s->head = read0(readcharfun);
3195 elt = read1(readcharfun);
3196 if (CONSP(elt) && UNBOUNDP(XCAR(elt))) {
3197 ch = XCHAR(XCDR(elt));
3198 free_cons(XCONS(elt));
3199 if (ch == s->terminator) {
3200 unreadchar(readcharfun, s->terminator);
3204 read_syntax_error(". in wrong context");
3207 #if 0 /* FSFmacs defun hack, or something ... */
3208 if (NILP(tail) && defun_hack && EQ(elt, Qdefun) && !read_pure) {
3209 record_unwind_protect(unreadpure, Qzero);
3214 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3215 if (s->length == 1 && s->allow_dotted_lists && EQ(XCAR(s->head), Qfset)) {
3216 if (CONSP(elt) && EQ(XCAR(elt), Qquote) && CONSP(XCDR(elt)))
3217 Vcurrent_compiled_function_annotation = XCAR(XCDR(elt));
3219 Vcurrent_compiled_function_annotation = elt;
3223 elt = Fcons(elt, Qnil);
3225 XCDR(s->tail) = elt;
3234 #if 0 /* FSFmacs defun hack */
3235 /* -1 for allow_dotted_lists means allow_dotted_lists and check
3236 for starting with defun and make structure pure. */
3240 read_list(Lisp_Object readcharfun,
3242 int allow_dotted_lists, int check_for_doc_references)
3244 struct read_list_state s;
3245 struct gcpro gcpro1, gcpro2;
3246 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3247 Lisp_Object old_compiled_function_annotation =
3248 Vcurrent_compiled_function_annotation;
3254 s.allow_dotted_lists = allow_dotted_lists;
3255 s.terminator = terminator;
3256 GCPRO2(s.head, s.tail);
3258 sequence_reader(readcharfun, terminator, &s, read_list_conser);
3259 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3260 Vcurrent_compiled_function_annotation =
3261 old_compiled_function_annotation;
3264 if ((purify_flag || load_force_doc_strings) && check_for_doc_references) {
3265 /* check now for any doc string references and record them
3269 /* We might be dealing with an imperfect list so don't
3271 for (tail = s.head; CONSP(tail); tail = XCDR(tail)) {
3272 Lisp_Object holding_cons = Qnil;
3275 Lisp_Object elem = XCAR(tail);
3276 /* elem might be (#$ . INT) ... */
3278 && EQ(XCAR(elem), Vload_file_name_internal))
3279 holding_cons = tail;
3280 /* or it might be (quote (#$ . INT)) i.e.
3281 (quote . ((#$ . INT) . nil)) in the case of
3282 `autoload' (autoload evaluates its arguments, while
3283 `defvar', `defun', etc. don't). */
3284 if (CONSP(elem) && EQ(XCAR(elem), Qquote)
3285 && CONSP(XCDR(elem))) {
3286 elem = XCAR(XCDR(elem));
3289 Vload_file_name_internal))
3290 holding_cons = XCDR(XCAR(tail));
3294 if (CONSP(holding_cons)) {
3296 if (NILP(Vinternal_doc_file_name))
3297 /* We have not yet called
3298 Snarf-documentation, so
3299 assume this file is described
3301 Snarf-documentation will fill
3302 in the right value later.
3303 For now, replace the whole
3305 XCAR(holding_cons) = Qzero;
3307 /* We have already called
3308 Snarf-documentation, so make
3309 a relative file name for this
3310 file, so it can be found
3311 properly in the installed
3312 Lisp directory. We don't use
3313 Fexpand_file_name because
3314 that would make the directory
3316 XCAR(XCAR(holding_cons)) =
3317 concat2(build_string
3319 Ffile_name_nondirectory
3320 (Vload_file_name_internal));
3322 /* Not pure. Just add to
3323 Vload_force_doc_string_list, and the
3324 string will be filled in properly in
3325 load_force_doc_string_unwind(). */
3326 Vload_force_doc_string_list =
3327 /* We pass the cons that holds the
3328 (#$ . INT) so we can modify it
3331 Vload_force_doc_string_list);
3341 read_vector(Lisp_Object readcharfun, Emchar terminator)
3347 struct read_list_state s;
3348 struct gcpro gcpro1, gcpro2;
3353 s.allow_dotted_lists = 0;
3354 GCPRO2(s.head, s.tail);
3356 sequence_reader(readcharfun, terminator, &s, read_list_conser);
3360 len = XINT(Flength(tem));
3362 #if 0 /* FSFmacs defun hack */
3364 s.head = make_pure_vector(len, Qnil);
3367 s.head = make_vector(len, Qnil);
3369 for (i = 0, p = &(XVECTOR_DATA(s.head)[0]); i < len; i++, p++) {
3370 Lisp_Cons *otem = XCONS(tem);
3380 read_compiled_function(Lisp_Object readcharfun, Emchar terminator)
3382 /* Accept compiled functions at read-time so that we don't
3383 have to build them at load-time. */
3385 Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
3386 struct gcpro gcpro1;
3389 int saw_a_doc_ref = 0;
3391 /* Note: we tell read_list not to search for doc references
3392 because we need to handle the "doc reference" for the
3393 instructions and constants differently. */
3394 stuff = read_list(readcharfun, terminator, 0, 0);
3395 len = XINT(Flength(stuff));
3396 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
3398 continuable_read_syntax_error
3399 ("#[...] used with wrong number of elements");
3401 for (iii = 0; CONSP(stuff); iii++) {
3402 Lisp_Cons *victim = XCONS(stuff);
3403 make_byte_code_args[iii] = Fcar(stuff);
3404 if ((purify_flag || load_force_doc_strings)
3405 && CONSP(make_byte_code_args[iii])
3406 && EQ(XCAR(make_byte_code_args[iii]),
3407 Vload_file_name_internal)) {
3408 if (purify_flag && iii == COMPILED_DOC_STRING) {
3409 /* same as in read_list(). */
3410 if (NILP(Vinternal_doc_file_name))
3411 make_byte_code_args[iii] = Qzero;
3413 XCAR(make_byte_code_args[iii]) =
3414 concat2(build_string("../lisp/"),
3415 Ffile_name_nondirectory
3416 (Vload_file_name_internal));
3420 stuff = Fcdr(stuff);
3423 GCPROn(make_byte_code_args, len);
3425 /* v18 or v19 bytecode file. Need to Ebolify. */
3426 if (load_byte_code_version < 20 && VECTORP(make_byte_code_args[2]))
3427 ebolify_bytecode_constants(make_byte_code_args[2]);
3429 /* make-byte-code looks at purify_flag, which should have the same
3430 * value as our "read-pure" argument */
3431 stuff = Fmake_byte_code(len, make_byte_code_args);
3432 XCOMPILED_FUNCTION(stuff)->flags.ebolified =
3433 (load_byte_code_version < 20);
3435 Vload_force_doc_string_list =
3436 Fcons(stuff, Vload_force_doc_string_list);
3441 void init_lread(void)
3443 char *stroot = NULL, *btroot = NULL;
3446 load_in_progress = 0;
3448 Vload_descriptor_list = Qnil;
3450 /* kludge: locate-file does not work for a null load-path, even if
3451 the file name is absolute. */
3453 Vload_path = Fcons(build_string(""), Qnil);
3454 /* The following is intended for the build chain only */
3455 if ((stroot = getenv("SOURCE_TREE_ROOT")) && strlen(stroot)) {
3456 Lisp_Object lispsubdir = build_string("lisp");
3457 Lisp_Object strootdir = build_string(stroot);
3458 Lisp_Object stlispdir =
3459 Fexpand_file_name(lispsubdir, strootdir);
3460 Vload_path = Fcons(stlispdir, Vload_path);
3462 if ((btroot = getenv("BUILD_TREE_ROOT")) && strlen(btroot)) {
3463 Lisp_Object lispsubdir = build_string("lisp");
3464 Lisp_Object btrootdir = build_string(btroot);
3465 Lisp_Object btlispdir =
3466 Fexpand_file_name(lispsubdir, btrootdir);
3467 Vload_path = Fcons(btlispdir, Vload_path);
3470 /* This used to get initialized in init_lread because all streams
3471 got closed when dumping occurs. This is no longer true --
3472 Vread_buffer_stream is a resizing output stream, and there is no
3473 reason to close it at dump-time.
3475 Vread_buffer_stream is set to Qnil in vars_of_lread, and this
3476 will initialize it only once, at dump-time. */
3477 if (NILP(Vread_buffer_stream))
3478 Vread_buffer_stream = make_resizing_buffer_output_stream();
3480 Vload_force_doc_string_list = Qnil;
3483 void syms_of_lread(void)
3486 DEFSUBR(Fread_from_string);
3487 DEFSUBR(Fload_internal);
3488 DEFSUBR(Flocate_file);
3489 DEFSUBR(Flocate_file_clear_hashing);
3490 DEFSUBR(Feval_buffer);
3491 DEFSUBR(Feval_region);
3493 defsymbol(&Qstandard_input, "standard-input");
3494 defsymbol(&Qread_char, "read-char");
3495 defsymbol(&Qcurrent_load_list, "current-load-list");
3496 defsymbol(&Qload, "load");
3497 defsymbol(&Qload_file_name, "load-file-name");
3498 defsymbol(&Qfset, "fset");
3500 #ifdef LISP_BACKQUOTES
3501 defsymbol(&Qbackquote, "backquote");
3502 defsymbol(&Qbacktick, "`");
3503 defsymbol(&Qcomma, ",");
3504 defsymbol(&Qcomma_at, ",@");
3505 defsymbol(&Qcomma_dot, ",.");
3508 defsymbol(&Qexists, "exists");
3509 defsymbol(&Qreadable, "readable");
3510 defsymbol(&Qwritable, "writable");
3511 defsymbol(&Qexecutable, "executable");
3514 void structure_type_create(void)
3516 the_structure_type_dynarr = Dynarr_new(structure_type);
3519 void reinit_vars_of_lread(void)
3521 Vread_buffer_stream = Qnil;
3522 staticpro_nodump(&Vread_buffer_stream);
3525 void vars_of_lread(void)
3527 reinit_vars_of_lread();
3529 DEFVAR_LISP("values", &Vvalues /*
3530 List of values of all expressions which were read, evaluated and printed.
3531 Order is reverse chronological.
3534 DEFVAR_LISP("standard-input", &Vstandard_input /*
3535 Stream for read to get input from.
3536 See documentation of `read' for possible values.
3538 Vstandard_input = Qt;
3540 DEFVAR_LISP("load-path", &Vload_path /*
3541 *List of directories to search for files to load.
3542 Each element is a string (directory name) or nil (try default directory).
3544 Note that the elements of this list *may not* begin with "~", so you must
3545 call `expand-file-name' on them before adding them to this list.
3547 Initialized based on EMACSLOADPATH environment variable, if any,
3548 otherwise to default specified in by file `paths.h' when SXEmacs was built.
3549 If there were no paths specified in `paths.h', then SXEmacs chooses a default
3550 value for this variable by looking around in the file-system near the
3551 directory in which the SXEmacs executable resides.
3555 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
3556 "*Location of lisp files to be used when dumping ONLY."); */
3558 DEFVAR_BOOL("load-in-progress", &load_in_progress /*
3559 Non-nil iff inside of `load'.
3561 DEFVAR_LISP ("load-suppress-alist", &Vload_suppress_alist /*
3562 An alist of expressions controlling whether particular files can be loaded.
3563 Each element looks like (FILENAME EXPR).
3564 FILENAME should be a full pathname, but without the .el suffix.
3565 When `load' is run and is about to load the specified file, it evaluates
3566 the form to determine if the file can be loaded.
3567 This variable is normally initialized automatically.
3569 Vload_suppress_alist = Qnil;
3571 DEFVAR_LISP("after-load-alist", &Vafter_load_alist /*
3572 An alist of expressions to be evalled when particular files are loaded.
3573 Each element looks like (FILENAME FORMS...).
3574 When `load' is run and the file-name argument is FILENAME,
3575 the FORMS in the corresponding element are executed at the end of loading.
3577 FILENAME must match exactly! Normally FILENAME is the name of a library,
3578 with no directory specified, since that is how `load' is normally called.
3579 An error in FORMS does not undo the load,
3580 but does prevent execution of the rest of the FORMS.
3582 Vafter_load_alist = Qnil;
3584 DEFVAR_BOOL("load-warn-when-source-newer", &load_warn_when_source_newer /*
3585 *Whether `load' should check whether the source is newer than the binary.
3586 If this variable is true, then when a `.elc' file is being loaded and the
3587 corresponding `.el' is newer, a warning message will be printed.
3589 load_warn_when_source_newer = 0;
3591 DEFVAR_BOOL("load-warn-when-source-only", &load_warn_when_source_only /*
3592 *Whether `load' should warn when loading a `.el' file instead of an `.elc'.
3593 If this variable is true, then when `load' is called with a filename without
3594 an extension, and the `.elc' version doesn't exist but the `.el' version does,
3595 then a message will be printed. If an explicit extension is passed to `load',
3596 no warning will be printed.
3598 load_warn_when_source_only = 0;
3600 DEFVAR_BOOL("load-ignore-elc-files", &load_ignore_elc_files /*
3601 *Whether `load' should ignore `.elc' files when a suffix is not given.
3602 This is normally used only to bootstrap the `.elc' files when building SXEmacs.
3604 load_ignore_elc_files = 0;
3607 DEFVAR_LISP("load-history", &Vload_history /*
3608 Alist mapping source file names to symbols and features.
3609 Each alist element is a list that starts with a file name,
3610 except for one element (optional) that starts with nil and describes
3611 definitions evaluated from buffers not visiting files.
3612 The remaining elements of each list are symbols defined as functions
3613 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
3615 Vload_history = Qnil;
3617 DEFVAR_LISP("current-load-list", &Vcurrent_load_list /*
3618 Used for internal purposes by `load'.
3620 Vcurrent_load_list = Qnil;
3623 DEFVAR_LISP("load-file-name", &Vload_file_name /*
3624 Full name of file being loaded by `load'.
3626 Vload_file_name = Qnil;
3628 DEFVAR_LISP("load-read-function", &Vload_read_function /*
3629 Function used by `load' and `eval-region' for reading expressions.
3630 The default is nil, which means use the function `read'.
3632 Vload_read_function = Qnil;
3634 DEFVAR_BOOL("load-force-doc-strings", &load_force_doc_strings /*
3635 Non-nil means `load' should force-load all dynamic doc strings.
3636 This is useful when the file being loaded is a temporary copy.
3638 load_force_doc_strings = 0;
3640 /* See read_escape(). */
3642 /* Used to be named `puke-on-fsf-keys' */
3643 DEFVAR_BOOL("fail-on-bucky-bit-character-escapes", &fail_on_bucky_bit_character_escapes /*
3644 Whether `read' should signal an error when it encounters unsupported
3645 character escape syntaxes or just read them incorrectly.
3647 fail_on_bucky_bit_character_escapes = 0;
3650 /* This must be initialized in init_lread otherwise it may start out
3651 with values saved when the image is dumped. */
3652 staticpro(&Vload_descriptor_list);
3654 /* Initialized in init_lread. */
3655 staticpro(&Vload_force_doc_string_list);
3657 Vload_file_name_internal = Qnil;
3658 staticpro(&Vload_file_name_internal);
3660 Vload_file_name_internal_the_purecopy = Qnil;
3661 staticpro(&Vload_file_name_internal_the_purecopy);
3663 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3664 Vcurrent_compiled_function_annotation = Qnil;
3665 staticpro(&Vcurrent_compiled_function_annotation);
3668 /* So that early-early stuff will work */
3669 Ffset(Qload, intern("load-internal"));
3671 #ifdef FEATUREP_SYNTAX
3672 defsymbol(&Qfeaturep, "featurep");
3673 Fprovide(intern("xemacs"));
3674 Fprovide(intern("sxemacs"));
3675 Fprovide(intern("raw-strings"));
3677 Fprovide(intern("infodock"));
3678 #endif /* INFODOCK */
3679 #endif /* FEATUREP_SYNTAX */
3681 #ifdef LISP_BACKQUOTES
3682 old_backquote_flag = new_backquote_flag = 0;
3686 Vfile_domain = Qnil;
3689 Vread_objects = Qnil;
3690 staticpro(&Vread_objects);
3692 Vlocate_file_hash_table = make_lisp_hash_table(200,
3693 HASH_TABLE_NON_WEAK,
3695 staticpro(&Vlocate_file_hash_table);
3696 #ifdef DEBUG_SXEMACS
3698 Lisp_Object tmp = intern("Vlocate-file-hash-table");
3699 symbol_value(XSYMBOL(tmp)) = Vlocate_file_hash_table;
3703 /* User defined readers */
3704 DEFVAR_LISP("ureaders", &Vureaders /*
3705 Alist of user defined readers.
3706 Car is ureader NAME, represented by string to match against when reading
3708 Cdr is user function called with one arg - string.
3709 Function must return lisp object or signal error.
3714 /* lread.c ends here */