1 /* Lisp parsing and input streams.
2 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc.
3 Copyright (C) 1995 Tinker Systems.
4 Copyright (C) 1996 Ben Wing.
6 This file is part of XEmacs.
8 XEmacs is free software; you can redistribute it and/or modify it
9 under the terms of the GNU General Public License as published by the
10 Free Software Foundation; either version 2, or (at your option) any
13 XEmacs is distributed in the hope that it will be useful, but WITHOUT
14 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
15 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
18 You should have received a copy of the GNU General Public License
19 along with XEmacs; see the file COPYING. If not, write to
20 the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
21 Boston, MA 02111-1307, USA. */
23 /* Synched up with: Mule 2.0, FSF 19.30. */
25 /* This file has been Mule-ized. */
36 #include "file-coding.h"
41 #ifdef LISP_FLOAT_TYPE
42 #define THIS_FILENAME lread
44 #endif /* LISP_FLOAT_TYPE */
46 Lisp_Object Qread_char, Qstandard_input;
47 Lisp_Object Qvariable_documentation;
48 #define LISP_BACKQUOTES
49 #ifdef LISP_BACKQUOTES
51 Nonzero means inside a new-style backquote
52 with no surrounding parentheses.
53 Fread initializes this to zero, so we need not specbind it
54 or worry about what happens to it when there is an error.
57 Nested backquotes are perfectly legal and fail utterly with
59 static int new_backquote_flag, old_backquote_flag;
60 Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot;
62 Lisp_Object Qvariable_domain; /* I18N3 */
63 Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
64 Lisp_Object Qcurrent_load_list;
65 Lisp_Object Qload, Qload_file_name;
66 Lisp_Object Qlocate_file_hash_table;
69 /* See read_escape() for an explanation of this. */
71 int fail_on_bucky_bit_character_escapes;
74 /* This symbol is also used in fns.c */
75 #define FEATUREP_SYNTAX
77 #ifdef FEATUREP_SYNTAX
78 Lisp_Object Qfeaturep;
81 /* non-zero if inside `load' */
84 /* Whether Fload_internal() should check whether the .el is newer
86 int load_warn_when_source_newer;
87 /* Whether Fload_internal() should check whether the .elc doesn't exist */
88 int load_warn_when_source_only;
89 /* Whether Fload_internal() should ignore .elc files when no suffix is given */
90 int load_ignore_elc_files;
92 /* Search path for files to be loaded. */
93 Lisp_Object Vload_path;
95 /* Search path for files when dumping. */
96 /* Lisp_Object Vdump_load_path; */
98 /* This is the user-visible association list that maps features to
99 lists of defs in their load files. */
100 Lisp_Object Vload_history;
102 /* This is used to build the load history. */
103 Lisp_Object Vcurrent_load_list;
105 /* Name of file actually being read by `load'. */
106 Lisp_Object Vload_file_name;
108 /* Same as Vload_file_name but not Lisp-accessible. This ensures that
109 our #$ checks are reliable. */
110 Lisp_Object Vload_file_name_internal;
112 Lisp_Object Vload_file_name_internal_the_purecopy;
114 /* Function to use for reading, in `load' and friends. */
115 Lisp_Object Vload_read_function;
117 /* The association list of objects read with the #n=object form.
118 Each member of the list has the form (n . object), and is used to
119 look up the object for the corresponding #n# construct.
120 It must be set to nil before all top-level calls to read0. */
121 Lisp_Object read_objects;
123 /* Nonzero means load should forcibly load all dynamic doc strings. */
124 /* Note that this always happens (with some special behavior) when
125 purify_flag is set. */
126 static int load_force_doc_strings;
128 /* List of descriptors now open for Fload_internal. */
129 static Lisp_Object Vload_descriptor_list;
131 /* In order to implement "load_force_doc_strings", we keep
132 a list of all the compiled-function objects and such
133 that we have created in the process of loading this file.
136 We specbind this just like Vload_file_name, so there's no
137 problems with recursive loading. */
138 static Lisp_Object Vload_force_doc_string_list;
140 /* A resizing-buffer stream used to temporarily hold data while reading */
141 static Lisp_Object Vread_buffer_stream;
143 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
144 Lisp_Object Vcurrent_compiled_function_annotation;
147 static int load_byte_code_version;
149 /* An array describing all known built-in structure types */
150 static structure_type_dynarr *the_structure_type_dynarr;
152 #if 0 /* FSF defun hack */
153 /* When nonzero, read conses in pure space */
154 static int read_pure;
157 #if 0 /* FSF stuff */
158 /* For use within read-from-string (this reader is non-reentrant!!) */
159 static int read_from_string_index;
160 static int read_from_string_limit;
163 #if 0 /* More FSF implementation kludges. */
164 /* In order to implement load-force-doc-string, FSF saves the
165 #@-quoted string when it's seen, and goes back and retrieves
168 This approach is not only kludgy, but it in general won't work
169 correctly because there's no stack of remembered #@-quoted-strings
170 and those strings don't generally appear in the file in the same
171 order as their #$ references. (Yes, that is amazingly stupid too.
173 It would be trivially easy to always encode the #@ string
174 [which is a comment, anyway] in the middle of the (#$ . INT) cons
175 reference. That way, it would be really easy to implement
176 load-force-doc-string in a non-kludgy way by just retrieving the
177 string immediately, because it's delivered on a silver platter.)
179 And finally, this stupid approach doesn't work under Mule, or
180 under MS-DOS or Windows NT, or under VMS, or any other place
181 where you either can't do an ftell() or don't get back a byte
184 Oh, and one more lossage in this approach: If you attempt to
185 dump any ELC files that were compiled with `byte-compile-dynamic'
186 (as opposed to just `byte-compile-dynamic-docstring'), you
187 get hosed. FMH! (as the illustrious JWZ was prone to utter)
189 The approach we use is clean, solves all of these problems, and is
190 probably easier to implement anyway. We just save a list of all
191 the containing objects that have (#$ . INT) conses in them (this
192 will only be compiled-function objects and lists), and when the
193 file is finished loading, we go through and fill in all the
194 doc strings at once. */
196 /* This contains the last string skipped with #@. */
197 static char *saved_doc_string;
198 /* Length of buffer allocated in saved_doc_string. */
199 static int saved_doc_string_size;
200 /* Length of actual data in saved_doc_string. */
201 static int saved_doc_string_length;
202 /* This is the file position that string came from. */
203 static int saved_doc_string_position;
206 EXFUN (Fread_from_string, 3);
208 /* When errors are signaled, the actual readcharfun should not be used
209 as an argument if it is an lstream, so that lstreams don't escape
210 to the Lisp level. */
211 #define READCHARFUN_MAYBE(x) (LSTREAMP (x) \
212 ? (build_string ("internal input stream")) \
217 syntax_error (CONST char *string)
219 signal_error (Qinvalid_read_syntax,
220 list1 (build_translated_string (string)));
224 continuable_syntax_error (CONST char *string)
226 return Fsignal (Qinvalid_read_syntax,
227 list1 (build_translated_string (string)));
231 /* Handle unreading and rereading of characters. */
233 readchar (Lisp_Object readcharfun)
235 /* This function can GC */
237 if (BUFFERP (readcharfun))
240 struct buffer *b = XBUFFER (readcharfun);
242 if (!BUFFER_LIVE_P (b))
243 error ("Reading from killed buffer");
245 if (BUF_PT (b) >= BUF_ZV (b))
247 c = BUF_FETCH_CHAR (b, BUF_PT (b));
248 BUF_SET_PT (b, BUF_PT (b) + 1);
252 else if (LSTREAMP (readcharfun))
254 Emchar c = Lstream_get_emchar (XLSTREAM (readcharfun));
255 #ifdef DEBUG_XEMACS /* testing Mule */
256 static int testing_mule = 0; /* Change via debugger */
258 if (c >= 0x20 && c <= 0x7E) fprintf (stderr, "%c", c);
259 else if (c == '\n') fprintf (stderr, "\\n\n");
260 else fprintf (stderr, "\\%o ", c);
265 else if (MARKERP (readcharfun))
268 Bufpos mpos = marker_position (readcharfun);
269 struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
271 if (mpos >= BUF_ZV (inbuffer))
273 c = BUF_FETCH_CHAR (inbuffer, mpos);
274 set_marker_position (readcharfun, mpos + 1);
279 Lisp_Object tem = call0 (readcharfun);
281 if (!CHAR_OR_CHAR_INTP (tem))
283 return XCHAR_OR_CHAR_INT (tem);
287 /* Unread the character C in the way appropriate for the stream READCHARFUN.
288 If the stream is a user function, call it with the char as argument. */
291 unreadchar (Lisp_Object readcharfun, Emchar c)
294 /* Don't back up the pointer if we're unreading the end-of-input mark,
295 since readchar didn't advance it when we read it. */
297 else if (BUFFERP (readcharfun))
298 BUF_SET_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1);
299 else if (LSTREAMP (readcharfun))
301 Lstream_unget_emchar (XLSTREAM (readcharfun), c);
302 #ifdef DEBUG_XEMACS /* testing Mule */
304 static int testing_mule = 0; /* Set this using debugger */
307 (c >= 0x20 && c <= 0x7E) ? "UU%c" :
308 ((c == '\n') ? "UU\\n\n" : "UU\\%o"), c);
312 else if (MARKERP (readcharfun))
313 set_marker_position (readcharfun, marker_position (readcharfun) - 1);
315 call1 (readcharfun, make_char (c));
318 static Lisp_Object read0 (Lisp_Object readcharfun);
319 static Lisp_Object read1 (Lisp_Object readcharfun);
320 /* allow_dotted_lists means that something like (foo bar . baz)
321 is acceptable. If -1, means check for starting with defun
322 and make structure pure. (not implemented, probably for very
326 If check_for_doc_references, look for (#$ . INT) doc references
327 in the list and record if load_force_doc_strings is non-zero.
328 (Such doc references will be destroyed during the loadup phase
329 by replacing with Qzero, because Snarf-documentation will fill
332 WARNING: If you set this, you sure as hell better not call
333 free_list() on the returned list here. */
335 static Lisp_Object read_list (Lisp_Object readcharfun,
337 int allow_dotted_lists,
338 int check_for_doc_references);
340 static void readevalloop (Lisp_Object readcharfun,
341 Lisp_Object sourcefile,
342 Lisp_Object (*evalfun) (Lisp_Object),
346 load_unwind (Lisp_Object stream) /* used as unwind-protect function in load */
348 Lstream_close (XLSTREAM (stream));
349 if (--load_in_progress < 0)
350 load_in_progress = 0;
355 load_descriptor_unwind (Lisp_Object oldlist)
357 Vload_descriptor_list = oldlist;
362 load_file_name_internal_unwind (Lisp_Object oldval)
364 Vload_file_name_internal = oldval;
369 load_file_name_internal_the_purecopy_unwind (Lisp_Object oldval)
371 Vload_file_name_internal_the_purecopy = oldval;
376 load_byte_code_version_unwind (Lisp_Object oldval)
378 load_byte_code_version = XINT (oldval);
382 /* The plague is coming.
384 Ring around the rosy, pocket full of posy,
385 Ashes ashes, they all fall down.
388 ebolify_bytecode_constants (Lisp_Object vector)
390 int len = XVECTOR_LENGTH (vector);
393 for (i = 0; i < len; i++)
395 Lisp_Object el = XVECTOR_DATA (vector)[i];
397 /* We don't check for `eq', `equal', and the others that have
398 bytecode opcodes. This might lose if someone passes #'eq or
399 something to `funcall', but who would really do that? As
400 they say in law, we've made a "good-faith effort" to
401 unfuckify ourselves. And doing it this way avoids screwing
402 up args to `make-hash-table' and such. As it is, we have to
403 add an extra Ebola check in decode_weak_list_type(). --ben */
404 if (EQ (el, Qassoc)) el = Qold_assoc;
405 else if (EQ (el, Qdelq)) el = Qold_delq;
407 /* I think this is a bad idea because it will probably mess
409 else if (EQ (el, Qdelete)) el = Qold_delete;
411 else if (EQ (el, Qrassq)) el = Qold_rassq;
412 else if (EQ (el, Qrassoc)) el = Qold_rassoc;
414 XVECTOR_DATA (vector)[i] = el;
419 pas_de_lache_ici (int fd, Lisp_Object victim)
424 if (!INTP (XCDR (victim)))
425 signal_simple_error ("Bogus doc string reference", victim);
426 pos = XINT (XCDR (victim));
428 pos = -pos; /* kludge to mark a user variable */
429 tem = unparesseuxify_doc_string (fd, pos, 0, Vload_file_name_internal);
431 signal_error (Qerror, tem);
436 load_force_doc_string_unwind (Lisp_Object oldlist)
439 Lisp_Object list = Vload_force_doc_string_list;
441 int fd = XINT (XCAR (Vload_descriptor_list));
442 /* NOTE: If purify_flag is true, we're in-place modifying objects that
443 may be in purespace (and if not, they will be). Therefore, we have
444 to be VERY careful to make sure that all objects that we create
445 are purecopied -- objects in purespace are not marked for GC, and
446 if we leave any impure objects inside of pure ones, we're really
450 /* restore the old value first just in case an error occurs. */
451 Vload_force_doc_string_list = oldlist;
453 LIST_LOOP (tail, list)
455 Lisp_Object john = Fcar (tail);
458 assert (CONSP (XCAR (john)));
459 assert (!purify_flag); /* should have been handled in read_list() */
460 XCAR (john) = pas_de_lache_ici (fd, XCAR (john));
466 assert (COMPILED_FUNCTIONP (john));
467 if (CONSP (XCOMPILED_FUNCTION (john)->instructions))
469 struct gcpro ngcpro1;
470 Lisp_Object juan = (pas_de_lache_ici
471 (fd, XCOMPILED_FUNCTION (john)->instructions));
477 signal_simple_error ("invalid lazy-loaded byte code", ivan);
478 /* Remember to purecopy; see above. */
479 XCOMPILED_FUNCTION (john)->instructions = Fpurecopy (XCAR (ivan));
480 /* v18 or v19 bytecode file. Need to Ebolify. */
481 if (XCOMPILED_FUNCTION (john)->flags.ebolified
482 && VECTORP (XCDR (ivan)))
483 ebolify_bytecode_constants (XCDR (ivan));
484 XCOMPILED_FUNCTION (john)->constants = Fpurecopy (XCDR (ivan));
487 doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
490 assert (!purify_flag); /* should have been handled in
491 read_compiled_function() */
492 doc = pas_de_lache_ici (fd, doc);
493 set_compiled_function_documentation (XCOMPILED_FUNCTION (john),
506 /* Close all descriptors in use for Fload_internal.
507 This is used when starting a subprocess. */
510 close_load_descs (void)
513 LIST_LOOP (tail, Vload_descriptor_list)
514 close (XINT (XCAR (tail)));
518 Lisp_Object Vfile_domain;
521 restore_file_domain (Lisp_Object val)
528 DEFUN ("load-internal", Fload_internal, 1, 6, 0, /*
529 Execute a file of Lisp code named FILE; no coding-system frobbing.
530 This function is identical to `load' except for the handling of the
531 CODESYS and USED-CODESYS arguments under XEmacs/Mule. (When Mule
532 support is not present, both functions are identical and ignore the
533 CODESYS and USED-CODESYS arguments.)
535 If support for Mule exists in this Emacs, the file is decoded
536 according to CODESYS; if omitted, no conversion happens. If
537 USED-CODESYS is non-nil, it should be a symbol, and the actual coding
538 system that was used for the decoding is stored into it. It will in
539 general be different from CODESYS if CODESYS specifies automatic
540 encoding detection or end-of-line detection.
542 (file, no_error, nomessage, nosuffix, codesys, used_codesys))
544 /* This function can GC */
546 int speccount = specpdl_depth ();
548 Lisp_Object newer = Qnil;
549 Lisp_Object handler = Qnil;
550 Lisp_Object found = Qnil;
551 struct gcpro gcpro1, gcpro2, gcpro3;
553 int message_p = NILP (nomessage);
554 /*#ifdef DEBUG_XEMACS*/
555 static Lisp_Object last_file_loaded;
556 size_t pure_usage = 0;
559 GCPRO3 (file, newer, found);
563 /*#ifdef DEBUG_XEMACS*/
564 if (purify_flag && noninteractive)
567 last_file_loaded = file;
568 pure_usage = purespace_usage ();
570 /*#endif / * DEBUG_XEMACS */
572 /* If file name is magic, call the handler. */
573 handler = Ffind_file_name_handler (file, Qload);
575 RETURN_UNGCPRO (call5 (handler, Qload, file, no_error,
576 nomessage, nosuffix));
578 /* Do this after the handler to avoid
579 the need to gcpro noerror, nomessage and nosuffix.
580 (Below here, we care only whether they are nil or not.) */
581 file = Fsubstitute_in_file_name (file);
583 if (!NILP (used_codesys))
584 CHECK_SYMBOL (used_codesys);
587 /* Avoid weird lossage with null string as arg,
588 since it would try to load a directory as a Lisp file.
590 if (XSTRING_LENGTH (file) > 0)
595 fd = locate_file (Vload_path, file,
596 ((!NILP (nosuffix)) ? "" :
597 load_ignore_elc_files ? ".el:" :
605 signal_file_error ("Cannot open load file", file);
613 foundstr = (char *) alloca (XSTRING_LENGTH (found) + 1);
614 strcpy (foundstr, (char *) XSTRING_DATA (found));
615 foundlen = strlen (foundstr);
617 /* The omniscient JWZ thinks this is worthless, but I beg to
619 if (load_ignore_elc_files)
621 newer = Ffile_name_nondirectory (found);
623 else if (load_warn_when_source_newer &&
624 !memcmp (".elc", foundstr + foundlen - 4, 4))
626 if (! fstat (fd, &s1)) /* can't fail, right? */
629 /* temporarily hack the 'c' off the end of the filename */
630 foundstr[foundlen - 1] = '\0';
631 result = stat (foundstr, &s2);
633 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
635 Lisp_Object newer_name = make_string ((Bufbyte *) foundstr,
637 struct gcpro nngcpro1;
638 NNGCPRO1 (newer_name);
639 newer = Ffile_name_nondirectory (newer_name);
642 /* put the 'c' back on (kludge-o-rama) */
643 foundstr[foundlen - 1] = 'c';
646 else if (load_warn_when_source_only &&
647 /* `found' ends in ".el" */
648 !memcmp (".el", foundstr + foundlen - 3, 3) &&
649 /* `file' does not end in ".el" */
651 XSTRING_DATA (file) + XSTRING_LENGTH (file) - 3,
657 if (!memcmp (".elc", foundstr + foundlen - 4, 4))
661 #define PRINT_LOADING_MESSAGE(done) do { \
662 if (load_ignore_elc_files) \
665 message ("Loading %s..." done, XSTRING_DATA (newer)); \
667 else if (!NILP (newer)) \
668 message ("Loading %s..." done " (file %s is newer)", \
669 XSTRING_DATA (file), \
670 XSTRING_DATA (newer)); \
671 else if (source_only) \
672 message ("Loading %s..." done " (file %s.elc does not exist)", \
673 XSTRING_DATA (file), \
674 XSTRING_DATA (Ffile_name_nondirectory (file))); \
675 else if (message_p) \
676 message ("Loading %s..." done, XSTRING_DATA (file)); \
679 PRINT_LOADING_MESSAGE ("");
682 /* Lisp_Object's must be malloc'ed, not stack-allocated */
683 Lisp_Object lispstream = Qnil;
684 CONST int block_size = 8192;
685 struct gcpro ngcpro1;
687 NGCPRO1 (lispstream);
688 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
689 /* 64K is used for normal files; 8K should be OK here because Lisp
690 files aren't really all that big. */
691 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
694 lispstream = make_decoding_input_stream
695 (XLSTREAM (lispstream), Fget_coding_system (codesys));
696 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
699 /* NOTE: Order of these is very important. Don't rearrange them. */
700 record_unwind_protect (load_unwind, lispstream);
701 record_unwind_protect (load_descriptor_unwind, Vload_descriptor_list);
702 record_unwind_protect (load_file_name_internal_unwind,
703 Vload_file_name_internal);
704 record_unwind_protect (load_file_name_internal_the_purecopy_unwind,
705 Vload_file_name_internal_the_purecopy);
706 record_unwind_protect (load_force_doc_string_unwind,
707 Vload_force_doc_string_list);
708 Vload_file_name_internal = found;
709 Vload_file_name_internal_the_purecopy = Qnil;
710 specbind (Qload_file_name, found);
711 Vload_descriptor_list = Fcons (make_int (fd), Vload_descriptor_list);
712 Vload_force_doc_string_list = Qnil;
714 record_unwind_protect (restore_file_domain, Vfile_domain);
715 Vfile_domain = Qnil; /* set it to nil; a call to #'domain will set it. */
719 /* Now determine what sort of ELC file we're reading in. */
720 record_unwind_protect (load_byte_code_version_unwind,
721 make_int (load_byte_code_version));
727 num_read = Lstream_read (XLSTREAM (lispstream), elc_header, 8);
729 || strncmp (elc_header, ";ELC", 4))
731 /* Huh? Probably not a valid ELC file. */
732 load_byte_code_version = 100; /* no Ebolification needed */
733 Lstream_unread (XLSTREAM (lispstream), elc_header, num_read);
736 load_byte_code_version = elc_header[4];
739 load_byte_code_version = 100; /* no Ebolification needed */
741 readevalloop (lispstream, file, Feval, 0);
743 if (!NILP (used_codesys))
746 (decoding_stream_coding_system (XLSTREAM (lispstream))));
748 unbind_to (speccount, Qnil);
755 /* #### Disgusting kludge */
756 /* Run any load-hooks for this file. */
757 /* #### An even more disgusting kludge. There is horrible code */
758 /* that is relying on the fact that dumped lisp files are found */
759 /* via `load-path' search. */
760 Lisp_Object name = file;
762 if (!NILP(Ffile_name_absolute_p(file)))
764 name = Ffile_name_nondirectory(file);
768 struct gcpro ngcpro1;
771 tem = Fassoc (name, Vafter_load_alist);
776 struct gcpro ngcpro1;
779 /* Use eval so that errors give a semi-meaningful backtrace. --Stig */
780 tem = Fcons (Qprogn, Fcdr (tem));
786 /*#ifdef DEBUG_XEMACS*/
787 if (purify_flag && noninteractive)
789 if (EQ (last_file_loaded, file))
790 message_append (" (%ld)",
791 (unsigned long) (purespace_usage() - pure_usage));
793 message ("Loading %s ...done (%ld)", XSTRING_DATA (file),
794 (unsigned long) (purespace_usage() - pure_usage));
796 /*#endif / * DEBUG_XEMACS */
799 PRINT_LOADING_MESSAGE ("done");
809 complete_filename_p (Lisp_Object pathname)
811 REGISTER unsigned char *s = XSTRING_DATA (pathname);
812 return (IS_DIRECTORY_SEP (s[0])
813 || (XSTRING_LENGTH (pathname) > 2
814 && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))
822 DEFUN ("locate-file", Flocate_file, 2, 4, 0, /*
823 Search for FILENAME through PATH-LIST, expanded by one of the optional
824 SUFFIXES (string of suffixes separated by ":"s), checking for access
825 MODE (0|1|2|4 = exists|executable|writeable|readable), default readable.
827 `locate-file' keeps hash tables of the directories it searches through,
828 in order to speed things up. It tries valiantly to not get confused in
829 the face of a changing and unpredictable environment, but can occasionally
830 get tripped up. In this case, you will have to call
831 `locate-file-clear-hashing' to get it back on track. See that function
834 (filename, path_list, suffixes, mode))
836 /* This function can GC */
839 CHECK_STRING (filename);
840 if (!NILP (suffixes))
841 CHECK_STRING (suffixes);
845 locate_file (path_list,
847 NILP (suffixes) ? "" : (char *) XSTRING_DATA (suffixes),
849 NILP (mode) ? R_OK : XINT (mode));
853 /* recalculate the hash table for the given string */
856 locate_file_refresh_hashing (Lisp_Object str)
858 Lisp_Object hash = make_directory_hash_table ((char *) XSTRING_DATA (str));
859 Fput (str, Qlocate_file_hash_table, hash);
863 /* find the hash table for the given string, recalculating if necessary */
866 locate_file_find_directory_hash_table (Lisp_Object str)
868 Lisp_Object hash = Fget (str, Qlocate_file_hash_table, Qnil);
869 if (! HASH_TABLEP (hash))
870 return locate_file_refresh_hashing (str);
874 /* look for STR in PATH, optionally adding suffixes in SUFFIX */
877 locate_file_in_directory (Lisp_Object path, Lisp_Object str,
878 CONST char *suffix, Lisp_Object *storeptr,
881 /* This function can GC */
888 Lisp_Object filename = Qnil;
889 struct gcpro gcpro1, gcpro2, gcpro3;
892 GCPRO3 (path, str, filename);
894 filename = Fexpand_file_name (str, path);
895 if (NILP (filename) || NILP (Ffile_name_absolute_p (filename)))
896 /* If there are non-absolute elts in PATH (eg ".") */
897 /* Of course, this could conceivably lose if luser sets
898 default-directory to be something non-absolute ... */
901 /* NIL means current directory */
902 filename = current_buffer->directory;
904 filename = Fexpand_file_name (filename,
905 current_buffer->directory);
906 if (NILP (Ffile_name_absolute_p (filename)))
908 /* Give up on this path element! */
913 /* Calculate maximum size of any filename made from
914 this path element/specified file name and any possible suffix. */
915 want_size = strlen (suffix) + XSTRING_LENGTH (filename) + 1;
916 if (fn_size < want_size)
917 fn = (char *) alloca (fn_size = 100 + want_size);
921 /* Loop over suffixes. */
924 char *esuffix = (char *) strchr (nsuffix, ':');
925 int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
927 /* Concatenate path element/specified name with the suffix. */
928 strncpy (fn, (char *) XSTRING_DATA (filename),
929 XSTRING_LENGTH (filename));
930 fn[XSTRING_LENGTH (filename)] = 0;
931 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
932 strncat (fn, nsuffix, lsuffix);
934 /* Ignore file if it's a directory. */
935 if (stat (fn, &st) >= 0
936 && (st.st_mode & S_IFMT) != S_IFDIR)
938 /* Check that we can access or open it. */
940 fd = access (fn, mode);
942 fd = open (fn, O_RDONLY | OPEN_BINARY, 0);
946 /* We succeeded; return this descriptor and filename. */
948 *storeptr = build_string (fn);
952 /* If we actually opened the file, set close-on-exec flag
953 on the new descriptor so that subprocesses can't whack
956 (void) fcntl (fd, F_SETFD, FD_CLOEXEC);
963 /* Advance to next suffix. */
966 nsuffix += lsuffix + 1;
973 /* do the same as locate_file() but don't use any hash tables. */
976 locate_file_without_hash (Lisp_Object path, Lisp_Object str,
977 CONST char *suffix, Lisp_Object *storeptr,
980 /* This function can GC */
984 /* is this necessary? */
987 absolute = !NILP (Ffile_name_absolute_p (str));
989 for (; !NILP (path); path = Fcdr (path))
991 int val = locate_file_in_directory (Fcar (path), str, suffix,
1006 /* Construct a list of all files to search for. */
1009 locate_file_construct_suffixed_files (Lisp_Object str, CONST char *suffix)
1015 CONST char *nsuffix;
1016 Lisp_Object suffixtab = Qnil;
1018 /* Calculate maximum size of any filename made from
1019 this path element/specified file name and any possible suffix. */
1020 want_size = strlen (suffix) + XSTRING_LENGTH (str) + 1;
1021 if (fn_size < want_size)
1022 fn = (char *) alloca (fn_size = 100 + want_size);
1028 char *esuffix = (char *) strchr (nsuffix, ':');
1029 int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
1031 /* Concatenate path element/specified name with the suffix. */
1032 strncpy (fn, (char *) XSTRING_DATA (str), XSTRING_LENGTH (str));
1033 fn[XSTRING_LENGTH (str)] = 0;
1034 if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
1035 strncat (fn, nsuffix, lsuffix);
1037 suffixtab = Fcons (build_string (fn), suffixtab);
1038 /* Advance to next suffix. */
1041 nsuffix += lsuffix + 1;
1043 return Fnreverse (suffixtab);
1046 DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
1047 Clear the hash records for the specified list of directories.
1048 `locate-file' uses a hashing scheme to speed lookup, and will correctly
1049 track the following environmental changes:
1051 -- changes of any sort to the list of directories to be searched.
1052 -- addition and deletion of non-shadowing files (see below) from the
1053 directories in the list.
1054 -- byte-compilation of a .el file into a .elc file.
1056 `locate-file' will primarily get confused if you add a file that shadows
1057 \(i.e. has the same name as) another file further down in the directory list.
1058 In this case, you must call `locate-file-clear-hashing'.
1062 Lisp_Object pathtail;
1064 for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
1066 Lisp_Object pathel = Fcar (pathtail);
1067 if (!purified (pathel))
1068 Fput (pathel, Qlocate_file_hash_table, Qnil);
1073 /* Search for a file whose name is STR, looking in directories
1074 in the Lisp list PATH, and trying suffixes from SUFFIX.
1075 SUFFIX is a string containing possible suffixes separated by colons.
1076 On success, returns a file descriptor. On failure, returns -1.
1078 MODE nonnegative means don't open the files,
1079 just look for one for which access(file,MODE) succeeds. In this case,
1080 returns 1 on success.
1082 If STOREPTR is nonzero, it points to a slot where the name of
1083 the file actually found should be stored as a Lisp string.
1084 Nil is stored there on failure.
1086 Called openp() in FSFmacs. */
1089 locate_file (Lisp_Object path, Lisp_Object str, CONST char *suffix,
1090 Lisp_Object *storeptr, int mode)
1092 /* This function can GC */
1093 Lisp_Object suffixtab = Qnil;
1094 Lisp_Object pathtail;
1096 struct gcpro gcpro1, gcpro2, gcpro3;
1101 /* if this filename has directory components, it's too complicated
1102 to try and use the hash tables. */
1103 if (!NILP (Ffile_name_directory (str)))
1104 return locate_file_without_hash (path, str, suffix, storeptr,
1107 /* Is it really necessary to gcpro path and str? It shouldn't be
1108 unless some caller has fucked up. */
1109 GCPRO3 (path, str, suffixtab);
1111 suffixtab = locate_file_construct_suffixed_files (str, suffix);
1113 for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
1115 Lisp_Object pathel = Fcar (pathtail);
1116 Lisp_Object hash_table;
1120 /* If this path element is relative, we have to look by hand.
1121 Can't set string property in a pure string. */
1122 if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)) ||
1125 val = locate_file_in_directory (pathel, str, suffix, storeptr,
1135 hash_table = locate_file_find_directory_hash_table (pathel);
1137 /* Loop over suffixes. */
1138 for (tail = suffixtab, found = 0; !found && CONSP (tail);
1141 if (!NILP (Fgethash (XCAR (tail), hash_table, Qnil)))
1147 /* This is a likely candidate. Look by hand in this directory
1148 so we don't get thrown off if someone byte-compiles a file. */
1149 val = locate_file_in_directory (pathel, str, suffix, storeptr,
1157 /* Hmm ... the file isn't actually there. (Or possibly it's
1158 a directory ...) So refresh our hashing. */
1159 locate_file_refresh_hashing (pathel);
1163 /* File is probably not there, but check the hard way just in case. */
1164 val = locate_file_without_hash (path, str, suffix, storeptr,
1168 /* Sneaky user added a file without telling us. */
1169 Flocate_file_clear_hashing (path);
1179 /* Merge the list we've accumulated of globals from the current input source
1180 into the load_history variable. The details depend on whether
1181 the source has an associated file name or not. */
1184 build_load_history (int loading, Lisp_Object source)
1186 REGISTER Lisp_Object tail, prev, newelt;
1187 REGISTER Lisp_Object tem, tem2;
1190 #if !defined(LOADHIST_DUMPED)
1191 /* Don't bother recording anything for preloaded files. */
1196 tail = Vload_history;
1199 while (!NILP (tail))
1203 /* Find the feature's previous assoc list... */
1204 if (internal_equal (source, Fcar (tem), 0))
1208 /* If we're loading, remove it. */
1212 Vload_history = Fcdr (tail);
1214 Fsetcdr (prev, Fcdr (tail));
1217 /* Otherwise, cons on new symbols that are not already members. */
1220 tem2 = Vcurrent_load_list;
1222 while (CONSP (tem2))
1224 newelt = XCAR (tem2);
1226 if (NILP (Fmemq (newelt, tem)))
1227 Fsetcar (tail, Fcons (Fcar (tem),
1228 Fcons (newelt, Fcdr (tem))));
1241 /* If we're loading, cons the new assoc onto the front of load-history,
1242 the most-recently-loaded position. Also do this if we didn't find
1243 an existing member for the current source. */
1244 if (loading || !foundit)
1245 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
1249 #else /* !LOADHIST */
1250 #define build_load_history(x,y)
1251 #endif /* !LOADHIST */
1254 #if 0 /* FSFmacs defun hack */
1256 unreadpure (void) /* Used as unwind-protect function in readevalloop */
1264 readevalloop (Lisp_Object readcharfun,
1265 Lisp_Object sourcename,
1266 Lisp_Object (*evalfun) (Lisp_Object),
1269 /* This function can GC */
1271 REGISTER Lisp_Object val = Qnil;
1272 int speccount = specpdl_depth ();
1273 struct gcpro gcpro1, gcpro2;
1274 struct buffer *b = 0;
1276 if (BUFFERP (readcharfun))
1277 b = XBUFFER (readcharfun);
1278 else if (MARKERP (readcharfun))
1279 b = XMARKER (readcharfun)->buffer;
1281 /* Don't do this. It is not necessary, and it needlessly exposes
1282 READCHARFUN (which can be a stream) to Lisp. --hniksic */
1283 /*specbind (Qstandard_input, readcharfun);*/
1285 specbind (Qcurrent_load_list, Qnil);
1287 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1288 Vcurrent_compiled_function_annotation = Qnil;
1290 GCPRO2 (val, sourcename);
1292 LOADHIST_ATTACH (sourcename);
1298 if (b != 0 && !BUFFER_LIVE_P (b))
1299 error ("Reading from killed buffer");
1301 c = readchar (readcharfun);
1305 while ((c = readchar (readcharfun)) != '\n' && c != -1)
1312 /* Ignore whitespace here, so we can detect eof. */
1313 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
1316 #if 0 /* FSFmacs defun hack */
1317 if (purify_flag && c == '(')
1319 int count1 = specpdl_depth ();
1320 record_unwind_protect (unreadpure, Qnil);
1321 val = read_list (readcharfun, ')', -1, 1);
1322 unbind_to (count1, Qnil);
1325 #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
1327 unreadchar (readcharfun, c);
1328 read_objects = Qnil;
1329 if (NILP (Vload_read_function))
1330 val = read0 (readcharfun);
1332 val = call1 (Vload_read_function, readcharfun);
1335 val = (*evalfun) (val);
1338 Vvalues = Fcons (val, Vvalues);
1339 if (EQ (Vstandard_output, Qt))
1346 build_load_history (LSTREAMP (readcharfun) ||
1347 /* This looks weird, but it's what's in FSFmacs */
1348 (b ? BUF_NARROWED (b) : BUF_NARROWED (current_buffer)),
1352 unbind_to (speccount, Qnil);
1355 DEFUN ("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /*
1356 Execute BUFFER as Lisp code.
1357 Programs can pass two arguments, BUFFER and PRINTFLAG.
1358 BUFFER is the buffer to evaluate (nil means use current buffer).
1359 PRINTFLAG controls printing of output:
1360 nil means discard it; anything else is stream for print.
1362 If there is no error, point does not move. If there is an error,
1363 point remains at the end of the last character read from the buffer.
1364 Execute BUFFER as Lisp code.
1366 (bufname, printflag))
1368 /* This function can GC */
1369 int speccount = specpdl_depth ();
1370 Lisp_Object tem, buf;
1373 buf = Fcurrent_buffer ();
1375 buf = Fget_buffer (bufname);
1377 error ("No such buffer.");
1379 if (NILP (printflag))
1380 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1383 specbind (Qstandard_output, tem);
1384 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1385 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
1386 readevalloop (buf, XBUFFER (buf)->filename, Feval,
1389 return unbind_to (speccount, Qnil);
1393 xxDEFUN ("eval-current-buffer", Feval_current_buffer, 0, 1, "", /*
1394 Execute the current buffer as Lisp code.
1395 Programs can pass argument PRINTFLAG which controls printing of output:
1396 nil means discard it; anything else is stream for print.
1398 If there is no error, point does not move. If there is an error,
1399 point remains at the end of the last character read from the buffer.
1407 DEFUN ("eval-region", Feval_region, 2, 3, "r", /*
1408 Execute the region as Lisp code.
1409 When called from programs, expects two arguments,
1410 giving starting and ending indices in the current buffer
1411 of the text to be executed.
1412 Programs can pass third argument PRINTFLAG which controls output:
1413 nil means discard it; anything else is stream for printing it.
1415 If there is no error, point does not move. If there is an error,
1416 point remains at the end of the last character read from the buffer.
1418 Note: Before evaling the region, this function narrows the buffer to it.
1419 If the code being eval'd should happen to trigger a redisplay you may
1420 see some text temporarily disappear because of this.
1424 /* This function can GC */
1425 int speccount = specpdl_depth ();
1427 Lisp_Object cbuf = Fcurrent_buffer ();
1429 if (NILP (printflag))
1430 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
1433 specbind (Qstandard_output, tem);
1435 if (NILP (printflag))
1436 record_unwind_protect (save_excursion_restore, save_excursion_save ());
1437 record_unwind_protect (save_restriction_restore, save_restriction_save ());
1439 /* This both uses b and checks its type. */
1440 Fgoto_char (b, cbuf);
1441 Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), e, cbuf);
1442 readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,
1445 return unbind_to (speccount, Qnil);
1448 DEFUN ("read", Fread, 0, 1, 0, /*
1449 Read one Lisp expression as text from STREAM, return as Lisp object.
1450 If STREAM is nil, use the value of `standard-input' (which see).
1451 STREAM or the value of `standard-input' may be:
1452 a buffer (read from point and advance it)
1453 a marker (read from where it points and advance it)
1454 a function (call it with no arguments for each character,
1455 call it with a char as argument to push a char back)
1456 a string (takes text from string, starting at the beginning)
1457 t (read text line using minibuffer and use it).
1462 stream = Vstandard_input;
1463 if (EQ (stream, Qt))
1464 stream = Qread_char;
1466 read_objects = Qnil;
1468 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1469 Vcurrent_compiled_function_annotation = Qnil;
1471 if (EQ (stream, Qread_char))
1473 Lisp_Object val = call1 (Qread_from_minibuffer,
1474 build_translated_string ("Lisp expression: "));
1475 return Fcar (Fread_from_string (val, Qnil, Qnil));
1478 if (STRINGP (stream))
1479 return Fcar (Fread_from_string (stream, Qnil, Qnil));
1481 return read0 (stream);
1484 DEFUN ("read-from-string", Fread_from_string, 1, 3, 0, /*
1485 Read one Lisp expression which is represented as text by STRING.
1486 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
1487 START and END optionally delimit a substring of STRING from which to read;
1488 they default to 0 and (length STRING) respectively.
1490 (string, start, end))
1492 Bytecount startval, endval;
1494 Lisp_Object lispstream = Qnil;
1495 struct gcpro gcpro1;
1497 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
1498 Vcurrent_compiled_function_annotation = Qnil;
1500 GCPRO1 (lispstream);
1501 CHECK_STRING (string);
1502 get_string_range_byte (string, start, end, &startval, &endval,
1503 GB_HISTORICAL_STRING_BEHAVIOR);
1504 lispstream = make_lisp_string_input_stream (string, startval,
1507 read_objects = Qnil;
1509 tem = read0 (lispstream);
1510 /* Yeah, it's ugly. Gonna make something of it?
1511 At least our reader is reentrant ... */
1513 (Fcons (tem, make_int
1514 (bytecount_to_charcount
1515 (XSTRING_DATA (string),
1516 startval + Lstream_byte_count (XLSTREAM (lispstream))))));
1517 Lstream_delete (XLSTREAM (lispstream));
1523 #ifdef LISP_BACKQUOTES
1526 backquote_unwind (Lisp_Object ptr)
1527 { /* used as unwind-protect function in read0() */
1528 int *counter = (int *) get_opaque_ptr (ptr);
1531 free_opaque_ptr (ptr);
1537 /* Use this for recursive reads, in contexts where internal tokens
1538 are not allowed. See also read1(). */
1540 read0 (Lisp_Object readcharfun)
1544 val = read1 (readcharfun);
1545 if (CONSP (val) && UNBOUNDP (XCAR (val)))
1547 Emchar c = XCHAR (XCDR (val));
1548 free_cons (XCONS (val));
1549 return Fsignal (Qinvalid_read_syntax,
1550 list1 (Fchar_to_string (make_char (c))));
1557 read_escape (Lisp_Object readcharfun)
1559 /* This function can GC */
1560 Emchar c = readchar (readcharfun);
1563 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1567 case 'a': return '\007';
1568 case 'b': return '\b';
1569 case 'd': return 0177;
1570 case 'e': return 033;
1571 case 'f': return '\f';
1572 case 'n': return '\n';
1573 case 'r': return '\r';
1574 case 't': return '\t';
1575 case 'v': return '\v';
1576 case '\n': return -1;
1579 c = readchar (readcharfun);
1581 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1583 error ("Invalid escape character syntax");
1584 c = readchar (readcharfun);
1586 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1588 c = read_escape (readcharfun);
1591 /* Originally, FSF_KEYS provided a degree of FSF Emacs
1592 compatibility by defining character "modifiers" alt, super,
1593 hyper and shift to infest the characters (i.e. integers).
1595 However, this doesn't cut it for XEmacs 20, which
1596 distinguishes characters from integers. Without Mule, ?\H-a
1597 simply returns ?a because every character is clipped into
1598 0-255. Under Mule it is much worse -- ?\H-a with FSF_KEYS
1599 produces an illegal character, and moves us to crash-land.
1601 For these reasons, FSF_KEYS hack is useless and without hope
1602 of ever working under XEmacs 20. */
1606 #define alt_modifier (0x040000)
1607 #define super_modifier (0x080000)
1608 #define hyper_modifier (0x100000)
1609 #define shift_modifier (0x200000)
1610 /* fsf uses a different modifiers for meta and control. Possibly
1611 byte_compiled code will still work fsfmacs, though... --Stig
1613 #define ctl_modifier (0x400000)
1614 #define meta_modifier (0x800000)
1616 #define FSF_LOSSAGE(mask) \
1617 if (fail_on_bucky_bit_character_escapes || \
1618 ((c = readchar (readcharfun)) != '-')) \
1619 error ("Invalid escape character syntax"); \
1620 c = readchar (readcharfun); \
1622 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun))); \
1624 c = read_escape (readcharfun); \
1627 case 'S': FSF_LOSSAGE (shift_modifier);
1628 case 'H': FSF_LOSSAGE (hyper_modifier);
1629 case 'A': FSF_LOSSAGE (alt_modifier);
1630 case 's': FSF_LOSSAGE (super_modifier);
1632 #undef super_modifier
1633 #undef hyper_modifier
1634 #undef shift_modifier
1637 #endif /* FSF_KEYS */
1640 c = readchar (readcharfun);
1642 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1644 error ("Invalid escape character syntax");
1646 c = readchar (readcharfun);
1648 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1650 c = read_escape (readcharfun);
1651 /* FSFmacs junk for non-ASCII controls.
1656 return c & (0200 | 037);
1666 /* An octal escape, as in ANSI C. */
1668 REGISTER Emchar i = c - '0';
1669 REGISTER int count = 0;
1672 if ((c = readchar (readcharfun)) >= '0' && c <= '7')
1673 i = (i << 3) + (c - '0');
1676 unreadchar (readcharfun, c);
1684 /* A hex escape, as in ANSI C. */
1686 REGISTER Emchar i = 0;
1689 c = readchar (readcharfun);
1690 /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
1691 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
1692 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
1693 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
1696 unreadchar (readcharfun, c);
1704 /* #### need some way of reading an extended character with
1705 an escape sequence. */
1715 /* read symbol-constituent stuff into `Vread_buffer_stream'. */
1717 read_atom_0 (Lisp_Object readcharfun, Emchar firstchar, int *saw_a_backslash)
1719 /* This function can GC */
1720 Emchar c = ((firstchar) >= 0 ? firstchar : readchar (readcharfun));
1721 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
1723 *saw_a_backslash = 0;
1725 while (c > 040 /* #### - comma should be here as should backquote */
1726 && !(c == '\"' || c == '\'' || c == ';'
1727 || c == '(' || c == ')'
1728 #ifndef LISP_FLOAT_TYPE
1729 /* If we have floating-point support, then we need
1730 to allow <digits><dot><digits>. */
1732 #endif /* not LISP_FLOAT_TYPE */
1733 || c == '[' || c == ']' || c == '#'
1738 c = readchar (readcharfun);
1740 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
1741 *saw_a_backslash = 1;
1743 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
1745 c = readchar (readcharfun);
1749 unreadchar (readcharfun, c);
1750 /* blasted terminating 0 */
1751 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), 0);
1752 Lstream_flush (XLSTREAM (Vread_buffer_stream));
1754 return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
1757 static Lisp_Object parse_integer (CONST Bufbyte *buf, Bytecount len, int base);
1760 read_atom (Lisp_Object readcharfun,
1762 int uninterned_symbol)
1764 /* This function can GC */
1765 int saw_a_backslash;
1766 Bytecount len = read_atom_0 (readcharfun, firstchar, &saw_a_backslash);
1767 char *read_ptr = (char *)
1768 resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream));
1770 /* Is it an integer? */
1771 if (! (saw_a_backslash || uninterned_symbol))
1773 /* If a token had any backslashes in it, it is disqualified from
1774 being an integer or a float. This means that 123\456 is a
1775 symbol, as is \123 (which is the way (intern "123") prints).
1776 Also, if token was preceded by #:, it's always a symbol.
1778 char *p = read_ptr + len;
1779 char *p1 = read_ptr;
1781 if (*p1 == '+' || *p1 == '-') p1++;
1786 while (p1 != p && (c = *p1) >= '0' && c <= '9')
1788 #ifdef LISP_FLOAT_TYPE
1789 /* Integers can have trailing decimal points. */
1790 if (p1 > read_ptr && p1 < p && *p1 == '.')
1795 /* It is an integer. */
1796 #ifdef LISP_FLOAT_TYPE
1803 if (sizeof (int) == sizeof (EMACS_INT))
1804 number = atoi (read_buffer);
1805 else if (sizeof (long) == sizeof (EMACS_INT))
1806 number = atol (read_buffer);
1809 return make_int (number);
1812 return parse_integer ((Bufbyte *) read_ptr, len, 10);
1816 #ifdef LISP_FLOAT_TYPE
1817 if (isfloat_string (read_ptr))
1818 return make_float (atof (read_ptr));
1824 if (uninterned_symbol)
1825 sym = (Fmake_symbol ((purify_flag)
1826 ? make_pure_pname ((Bufbyte *) read_ptr, len, 0)
1827 : make_string ((Bufbyte *) read_ptr, len)));
1830 /* intern will purecopy pname if necessary */
1831 Lisp_Object name = make_string ((Bufbyte *) read_ptr, len);
1832 sym = Fintern (name, Qnil);
1834 if (SYMBOL_IS_KEYWORD (sym))
1836 /* the LISP way is to put keywords in their own package,
1837 but we don't have packages, so we do something simpler.
1838 Someday, maybe we'll have packages and then this will
1839 be reworked. --Stig. */
1840 XSYMBOL (sym)->value = sym;
1849 parse_integer (CONST Bufbyte *buf, Bytecount len, int base)
1851 CONST Bufbyte *lim = buf + len;
1852 CONST Bufbyte *p = buf;
1854 int negativland = 0;
1869 for (; (p < lim) && (*p != '\0'); p++)
1876 else if (isupper (c))
1878 else if (islower (c))
1883 if (c < 0 || c >= base)
1887 num = num * base + c;
1893 EMACS_INT int_result = negativland ? - (EMACS_INT) num : (EMACS_INT) num;
1894 Lisp_Object result = make_int (int_result);
1895 if (num && ((XINT (result) < 0) != negativland))
1897 if (XINT (result) != int_result)
1902 return Fsignal (Qinvalid_read_syntax,
1903 list3 (build_translated_string
1904 ("Integer constant overflow in reader"),
1905 make_string (buf, len),
1908 return Fsignal (Qinvalid_read_syntax,
1909 list3 (build_translated_string
1910 ("Invalid integer constant in reader"),
1911 make_string (buf, len),
1917 read_integer (Lisp_Object readcharfun, int base)
1919 /* This function can GC */
1920 int saw_a_backslash;
1921 Bytecount len = read_atom_0 (readcharfun, -1, &saw_a_backslash);
1922 return (parse_integer
1923 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
1925 ? 0 /* make parse_integer signal error */
1931 read_bit_vector (Lisp_Object readcharfun)
1933 unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
1938 c = readchar (readcharfun);
1939 if (c != '0' && c != '1')
1941 Dynarr_add (dyn, (unsigned char) (c - '0'));
1945 unreadchar (readcharfun, c);
1947 return make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
1948 Dynarr_length (dyn));
1955 struct structure_type *
1956 define_structure_type (Lisp_Object type,
1957 int (*validate) (Lisp_Object data,
1958 Error_behavior errb),
1959 Lisp_Object (*instantiate) (Lisp_Object data))
1961 struct structure_type st;
1964 st.keywords = Dynarr_new (structure_keyword_entry);
1965 st.validate = validate;
1966 st.instantiate = instantiate;
1967 Dynarr_add (the_structure_type_dynarr, st);
1969 return Dynarr_atp (the_structure_type_dynarr,
1970 Dynarr_length (the_structure_type_dynarr) - 1);
1974 define_structure_type_keyword (struct structure_type *st, Lisp_Object keyword,
1975 int (*validate) (Lisp_Object keyword,
1977 Error_behavior errb))
1979 struct structure_keyword_entry en;
1981 en.keyword = keyword;
1982 en.validate = validate;
1983 Dynarr_add (st->keywords, en);
1986 static struct structure_type *
1987 recognized_structure_type (Lisp_Object type)
1991 for (i = 0; i < Dynarr_length (the_structure_type_dynarr); i++)
1993 struct structure_type *st = Dynarr_atp (the_structure_type_dynarr, i);
1994 if (EQ (st->type, type))
2002 read_structure (Lisp_Object readcharfun)
2004 Emchar c = readchar (readcharfun);
2005 Lisp_Object list = Qnil;
2006 Lisp_Object orig_list = Qnil;
2007 Lisp_Object already_seen = Qnil;
2009 struct structure_type *st;
2010 struct gcpro gcpro1, gcpro2;
2012 GCPRO2 (orig_list, already_seen);
2014 RETURN_UNGCPRO (continuable_syntax_error ("#s not followed by paren"));
2015 list = read_list (readcharfun, ')', 0, 0);
2018 int len = XINT (Flength (list));
2020 RETURN_UNGCPRO (continuable_syntax_error
2021 ("structure type not specified"));
2024 (continuable_syntax_error
2025 ("structures must have alternating keyword/value pairs"));
2028 st = recognized_structure_type (XCAR (list));
2030 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2031 list2 (build_translated_string
2032 ("unrecognized structure type"),
2036 keyword_count = Dynarr_length (st->keywords);
2037 while (!NILP (list))
2039 Lisp_Object keyword, value;
2041 struct structure_keyword_entry *en = NULL;
2043 keyword = Fcar (list);
2045 value = Fcar (list);
2048 if (!NILP (memq_no_quit (keyword, already_seen)))
2049 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2050 list2 (build_translated_string
2051 ("structure keyword already seen"),
2054 for (i = 0; i < keyword_count; i++)
2056 en = Dynarr_atp (st->keywords, i);
2057 if (EQ (keyword, en->keyword))
2061 if (i == keyword_count)
2062 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2063 list2 (build_translated_string
2064 ("unrecognized structure keyword"),
2067 if (en->validate && ! (en->validate) (keyword, value, ERROR_ME))
2069 (Fsignal (Qinvalid_read_syntax,
2070 list3 (build_translated_string
2071 ("invalid value for structure keyword"),
2074 already_seen = Fcons (keyword, already_seen);
2077 if (st->validate && ! (st->validate) (orig_list, ERROR_ME))
2078 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
2079 list2 (build_translated_string
2080 ("invalid structure initializer"),
2083 RETURN_UNGCPRO ((st->instantiate) (XCDR (orig_list)));
2087 static Lisp_Object read_compiled_function (Lisp_Object readcharfun,
2089 static Lisp_Object read_vector (Lisp_Object readcharfun, int terminator);
2091 /* Get the next character; filter out whitespace and comments */
2094 reader_nextchar (Lisp_Object readcharfun)
2096 /* This function can GC */
2101 c = readchar (readcharfun);
2103 signal_error (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2109 /* Ignore whitespace and control characters */
2118 while ((c = readchar (readcharfun)) >= 0 && c != '\n')
2127 list2_pure (int pure, Lisp_Object a, Lisp_Object b)
2129 return pure ? pure_cons (a, pure_cons (b, Qnil)) : list2 (a, b);
2133 /* Read the next Lisp object from the stream READCHARFUN and return it.
2134 If the return value is a cons whose car is Qunbound, then read1()
2135 encountered a misplaced token (e.g. a right bracket, right paren,
2136 or dot followed by a non-number). To filter this stuff out,
2140 read1 (Lisp_Object readcharfun)
2145 c = reader_nextchar (readcharfun);
2151 #ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
2152 /* if this is disabled, then other code in eval.c must be enabled */
2153 Emchar ch = reader_nextchar (readcharfun);
2159 int speccount = specpdl_depth ();
2160 ++old_backquote_flag;
2161 record_unwind_protect (backquote_unwind,
2162 make_opaque_ptr (&old_backquote_flag));
2163 tem = read0 (readcharfun);
2164 unbind_to (speccount, Qnil);
2165 ch = reader_nextchar (readcharfun);
2168 unreadchar (readcharfun, ch);
2169 return Fsignal (Qinvalid_read_syntax,
2171 ("Weird old-backquote syntax")));
2173 return list2 (Qbacktick, tem);
2177 if (old_backquote_flag)
2179 Lisp_Object tem, comma_type;
2180 ch = readchar (readcharfun);
2182 comma_type = Qcomma_at;
2186 unreadchar (readcharfun, ch);
2187 comma_type = Qcomma;
2189 tem = read0 (readcharfun);
2190 ch = reader_nextchar (readcharfun);
2193 unreadchar (readcharfun, ch);
2194 return Fsignal (Qinvalid_read_syntax,
2196 ("Weird old-backquote syntax")));
2198 return list2 (comma_type, tem);
2202 unreadchar (readcharfun, ch);
2204 return Fsignal (Qinvalid_read_syntax,
2205 list1 (build_string ("Comma outside of backquote")));
2207 /* #### - yuck....but this is reverse compatible. */
2208 /* mostly this is required by edebug, which does its own
2209 annotated reading. We need to have an annotated_read
2210 function that records (with markers) the buffer
2211 positions of the elements that make up lists, then that
2212 can be used in edebug and bytecomp and the check above
2213 can go back in. --Stig */
2219 unreadchar (readcharfun, ch);
2221 #endif /* old backquote crap... */
2222 return read_list (readcharfun, ')', 1, 1);
2225 return read_vector (readcharfun, ']');
2229 /* #### - huh? these don't do what they seem... */
2230 return noseeum_cons (Qunbound, make_char (c));
2233 #ifdef LISP_FLOAT_TYPE
2234 /* If a period is followed by a number, then we should read it
2235 as a floating point number. Otherwise, it denotes a dotted
2238 c = readchar (readcharfun);
2239 unreadchar (readcharfun, c);
2241 /* Can't use isdigit on Emchars */
2242 if (c < '0' || c > '9')
2243 return noseeum_cons (Qunbound, make_char ('.'));
2245 /* Note that read_atom will loop
2246 at least once, assuring that we will not try to UNREAD
2247 two characters in a row.
2248 (I think this doesn't matter anymore because there should
2249 be no more danger in unreading multiple characters) */
2250 return read_atom (readcharfun, '.', 0);
2252 #else /* ! LISP_FLOAT_TYPE */
2253 return noseeum_cons (Qunbound, make_char ('.'));
2254 #endif /* ! LISP_FLOAT_TYPE */
2259 c = readchar (readcharfun);
2262 #if 0 /* FSFmacs silly char-table syntax */
2265 #if 0 /* FSFmacs silly bool-vector syntax */
2268 /* "#["-- byte-code constant syntax */
2269 /* purecons #[...] syntax */
2270 case '[': return read_compiled_function (readcharfun, ']'
2271 /*, purify_flag */ );
2272 /* "#:"-- gensym syntax */
2273 case ':': return read_atom (readcharfun, -1, 1);
2274 /* #'x => (function x) */
2275 case '\'': return list2 (Qfunction, read0 (readcharfun));
2277 /* RMS uses this syntax for fat-strings.
2278 If we use it for vectors, then obscure bugs happen.
2280 /* "#(" -- Scheme/CL vector syntax */
2281 case '(': return read_vector (readcharfun, ')');
2287 struct gcpro gcpro1;
2289 /* Read the string itself. */
2290 tmp = read1 (readcharfun);
2293 if (CONSP (tmp) && UNBOUNDP (XCAR (tmp)))
2294 free_cons (XCONS (tmp));
2295 return Fsignal (Qinvalid_read_syntax,
2296 list1 (build_string ("#")));
2299 /* Read the intervals and their properties. */
2302 Lisp_Object beg, end, plist;
2306 beg = read1 (readcharfun);
2307 if (CONSP (beg) && UNBOUNDP (XCAR (beg)))
2309 ch = XCHAR (XCDR (beg));
2310 free_cons (XCONS (beg));
2318 end = read1 (readcharfun);
2319 if (CONSP (end) && UNBOUNDP (XCAR (end)))
2321 free_cons (XCONS (end));
2327 plist = read1 (readcharfun);
2328 if (CONSP (plist) && UNBOUNDP (XCAR (plist)))
2330 free_cons (XCONS (plist));
2336 (Fsignal (Qinvalid_read_syntax,
2338 (build_string ("invalid string property list"),
2340 Fset_text_properties (beg, end, plist, tmp);
2348 /* #@NUMBER is used to skip NUMBER following characters.
2349 That's used in .elc files to skip over doc strings
2350 and function definitions. */
2353 /* Read a decimal integer. */
2354 while ((c = readchar (readcharfun)) >= 0
2355 && c >= '0' && c <= '9')
2356 nskip = (10 * nskip) + (c - '0');
2358 unreadchar (readcharfun, c);
2360 /* FSF has code here that maybe caches the skipped
2361 string. See above for why this is totally
2362 losing. We handle this differently. */
2364 /* Skip that many characters. */
2365 for (i = 0; i < nskip && c >= 0; i++)
2366 c = readchar (readcharfun);
2370 case '$': return Vload_file_name_internal;
2372 case '*': return read_bit_vector (readcharfun);
2373 /* #o10 => 8 -- octal constant syntax */
2374 case 'o': return read_integer (readcharfun, 8);
2375 /* #xdead => 57005 -- hex constant syntax */
2376 case 'x': return read_integer (readcharfun, 16);
2377 /* #b010 => 2 -- binary constant syntax */
2378 case 'b': return read_integer (readcharfun, 2);
2379 /* #s(foobar key1 val1 key2 val2) -- structure syntax */
2380 case 's': return read_structure (readcharfun);
2383 unreadchar (readcharfun, c);
2384 return Fsignal (Qinvalid_read_syntax,
2385 list1 (build_string ("Cannot read unreadable object")));
2387 #ifdef FEATUREP_SYNTAX
2391 Lisp_Object fexp, obj, tem;
2392 struct gcpro gcpro1, gcpro2;
2394 fexp = read0(readcharfun);
2395 obj = read0(readcharfun);
2397 /* the call to `featurep' may GC. */
2399 tem = call1 (Qfeaturep, fexp);
2402 if (c == '+' && NILP(tem)) goto retry;
2403 if (c == '-' && !NILP(tem)) goto retry;
2407 case '0': case '1': case '2': case '3': case '4':
2408 case '5': case '6': case '7': case '8': case '9':
2409 /* Reader forms that can reuse previously read objects. */
2414 /* Using read_integer() here is impossible, because it
2415 chokes on `='. Using parse_integer() is too hard.
2416 So we simply read it in, and ignore overflows, which
2418 while (c >= '0' && c <= '9')
2422 c = readchar (readcharfun);
2424 found = assq_no_quit (make_int (n), read_objects);
2427 /* #n=object returns object, but associates it with
2431 return Fsignal (Qinvalid_read_syntax,
2432 list2 (build_translated_string
2433 ("Multiply defined symbol label"),
2435 obj = read0 (readcharfun);
2436 read_objects = Fcons (Fcons (make_int (n), obj), read_objects);
2441 /* #n# returns a previously read object. */
2443 return XCDR (found);
2445 return Fsignal (Qinvalid_read_syntax,
2446 list2 (build_translated_string
2447 ("Undefined symbol label"),
2450 return Fsignal (Qinvalid_read_syntax,
2451 list1 (build_string ("#")));
2455 unreadchar (readcharfun, c);
2456 return Fsignal (Qinvalid_read_syntax,
2457 list1 (build_string ("#")));
2463 case '\'': return list2 (Qquote, read0 (readcharfun));
2465 #ifdef LISP_BACKQUOTES
2469 int speccount = specpdl_depth ();
2470 ++new_backquote_flag;
2471 record_unwind_protect (backquote_unwind,
2472 make_opaque_ptr (&new_backquote_flag));
2473 tem = read0 (readcharfun);
2474 unbind_to (speccount, Qnil);
2475 return list2 (Qbackquote, tem);
2480 if (new_backquote_flag)
2482 Lisp_Object comma_type = Qnil;
2483 int ch = readchar (readcharfun);
2486 comma_type = Qcomma_at;
2488 comma_type = Qcomma_dot;
2492 unreadchar (readcharfun, ch);
2493 comma_type = Qcomma;
2495 return list2 (comma_type, read0 (readcharfun));
2499 /* YUCK. 99.999% backwards compatibility. The Right
2500 Thing(tm) is to signal an error here, because it's
2501 really invalid read syntax. Instead, this permits
2502 commas to begin symbols (unless they're inside
2503 backquotes). If an error is signalled here in the
2504 future, then commas should be invalid read syntax
2505 outside of backquotes anywhere they're found (i.e.
2506 they must be quoted in symbols) -- Stig */
2507 return read_atom (readcharfun, c, 0);
2514 /* Evil GNU Emacs "character" (ie integer) syntax */
2515 c = readchar (readcharfun);
2517 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2520 c = read_escape (readcharfun);
2521 return make_char (c);
2528 /* #### If the input stream is translating, then the string
2529 should be marked as translatable by setting its
2530 `string-translatable' property to t. .el and .elc files
2531 normally are translating input streams. See Fgettext()
2532 and print_internal(). */
2536 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
2537 while ((c = readchar (readcharfun)) >= 0
2541 c = read_escape (readcharfun);
2542 /* c is -1 if \ newline has just been seen */
2545 if (Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) == 0)
2549 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
2553 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
2555 /* If purifying, and string starts with \ newline,
2556 return zero instead. This is for doc strings
2557 that we are really going to find in lib-src/DOC.nn.nn */
2558 if (purify_flag && NILP (Vinternal_doc_file_name) && cancel)
2561 Lstream_flush (XLSTREAM (Vread_buffer_stream));
2562 #if 0 /* FSFmacs defun hack */
2566 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
2567 Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
2572 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
2573 Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
2578 /* Ignore whitespace and control characters */
2581 return read_atom (readcharfun, c, 0);
2588 #ifdef LISP_FLOAT_TYPE
2597 isfloat_string (CONST char *cp)
2600 CONST Bufbyte *ucp = (CONST Bufbyte *) cp;
2602 if (*ucp == '+' || *ucp == '-')
2605 if (*ucp >= '0' && *ucp <= '9')
2608 while (*ucp >= '0' && *ucp <= '9')
2616 if (*ucp >= '0' && *ucp <= '9')
2619 while (*ucp >= '0' && *ucp <= '9')
2622 if (*ucp == 'e' || *ucp == 'E')
2626 if ((*ucp == '+') || (*ucp == '-'))
2630 if (*ucp >= '0' && *ucp <= '9')
2633 while (*ucp >= '0' && *ucp <= '9')
2636 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') || (*ucp == '\n')
2637 || (*ucp == '\r') || (*ucp == '\f'))
2638 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
2639 || state == (DOT_CHAR|TRAIL_INT)
2640 || state == (LEAD_INT|E_CHAR|EXP_INT)
2641 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
2642 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
2644 #endif /* LISP_FLOAT_TYPE */
2647 sequence_reader (Lisp_Object readcharfun,
2650 void * (*conser) (Lisp_Object readcharfun,
2651 void *state, Charcount len))
2655 for (len = 0; ; len++)
2660 ch = reader_nextchar (readcharfun);
2662 if (ch == terminator)
2665 unreadchar (readcharfun, ch);
2666 #ifdef FEATUREP_SYNTAX
2668 syntax_error ("\"]\" in a list");
2670 syntax_error ("\")\" in a vector");
2672 state = ((conser) (readcharfun, state, len));
2677 struct read_list_state
2682 int allow_dotted_lists;
2687 read_list_conser (Lisp_Object readcharfun, void *state, Charcount len)
2689 struct read_list_state *s = (struct read_list_state *) state;
2692 elt = read1 (readcharfun);
2694 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
2696 Lisp_Object tem = elt;
2700 free_cons (XCONS (tem));
2703 #ifdef FEATUREP_SYNTAX
2704 if (ch == s->terminator) /* deal with #+, #- reader macros */
2706 unreadchar (readcharfun, s->terminator);
2710 syntax_error ("']' in a list");
2712 syntax_error ("')' in a vector");
2716 signal_simple_error ("BUG! Internal reader error", elt);
2717 else if (!s->allow_dotted_lists)
2718 syntax_error ("\".\" in a vector");
2721 if (!NILP (s->tail))
2722 XCDR (s->tail) = read0 (readcharfun);
2724 s->head = read0 (readcharfun);
2725 elt = read1 (readcharfun);
2726 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
2728 ch = XCHAR (XCDR (elt));
2729 free_cons (XCONS (elt));
2730 if (ch == s->terminator)
2732 unreadchar (readcharfun, s->terminator);
2736 syntax_error (". in wrong context");
2740 #if 0 /* FSFmacs defun hack, or something ... */
2741 if (NILP (tail) && defun_hack && EQ (elt, Qdefun) && !read_pure)
2743 record_unwind_protect (unreadpure, Qzero);
2748 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2749 if (s->length == 1 && s->allow_dotted_lists && EQ (XCAR (s->head), Qfset))
2751 if (CONSP (elt) && EQ (XCAR (elt), Qquote) && CONSP (XCDR (elt)))
2752 Vcurrent_compiled_function_annotation = XCAR (XCDR (elt));
2754 Vcurrent_compiled_function_annotation = elt;
2758 elt = Fcons (elt, Qnil);
2759 if (!NILP (s->tail))
2760 XCDR (s->tail) = elt;
2770 #if 0 /* FSFmacs defun hack */
2771 /* -1 for allow_dotted_lists means allow_dotted_lists and check
2772 for starting with defun and make structure pure. */
2776 read_list (Lisp_Object readcharfun,
2778 int allow_dotted_lists,
2779 int check_for_doc_references)
2781 struct read_list_state s;
2782 struct gcpro gcpro1, gcpro2;
2783 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2784 Lisp_Object old_compiled_function_annotation =
2785 Vcurrent_compiled_function_annotation;
2791 s.allow_dotted_lists = allow_dotted_lists;
2792 s.terminator = terminator;
2793 GCPRO2 (s.head, s.tail);
2795 sequence_reader (readcharfun, terminator, &s, read_list_conser);
2796 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
2797 Vcurrent_compiled_function_annotation = old_compiled_function_annotation;
2800 if ((purify_flag || load_force_doc_strings) && check_for_doc_references)
2802 /* check now for any doc string references and record them
2806 /* We might be dealing with an imperfect list so don't
2808 for (tail = s.head; CONSP (tail); tail = XCDR (tail))
2810 Lisp_Object holding_cons = Qnil;
2813 Lisp_Object elem = XCAR (tail);
2814 /* elem might be (#$ . INT) ... */
2815 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
2816 holding_cons = tail;
2817 /* or it might be (quote (#$ . INT)) i.e.
2818 (quote . ((#$ . INT) . nil)) in the case of
2819 `autoload' (autoload evaluates its arguments, while
2820 `defvar', `defun', etc. don't). */
2821 if (CONSP (elem) && EQ (XCAR (elem), Qquote)
2822 && CONSP (XCDR (elem)))
2824 elem = XCAR (XCDR (elem));
2825 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
2826 holding_cons = XCDR (XCAR (tail));
2830 if (CONSP (holding_cons))
2834 if (NILP (Vinternal_doc_file_name))
2835 /* We have not yet called Snarf-documentation, so
2836 assume this file is described in the DOC file
2837 and Snarf-documentation will fill in the right
2838 value later. For now, replace the whole list
2840 XCAR (holding_cons) = Qzero;
2842 /* We have already called Snarf-documentation, so
2843 make a relative file name for this file, so it
2844 can be found properly in the installed Lisp
2845 directory. We don't use Fexpand_file_name
2846 because that would make the directory absolute
2848 XCAR (XCAR (holding_cons)) =
2849 concat2 (build_string ("../lisp/"),
2850 Ffile_name_nondirectory
2851 (Vload_file_name_internal));
2854 /* Not pure. Just add to Vload_force_doc_string_list,
2855 and the string will be filled in properly in
2856 load_force_doc_string_unwind(). */
2857 Vload_force_doc_string_list =
2858 /* We pass the cons that holds the (#$ . INT) so we
2859 can modify it in-place. */
2860 Fcons (holding_cons, Vload_force_doc_string_list);
2870 read_vector (Lisp_Object readcharfun,
2877 struct read_list_state s;
2878 struct gcpro gcpro1, gcpro2;
2883 s.allow_dotted_lists = 0;
2884 GCPRO2 (s.head, s.tail);
2886 sequence_reader (readcharfun, terminator, &s, read_list_conser);
2890 len = XINT (Flength (tem));
2892 #if 0 /* FSFmacs defun hack */
2894 s.head = make_pure_vector (len, Qnil);
2897 s.head = make_vector (len, Qnil);
2899 for (i = 0, p = &(XVECTOR_DATA (s.head)[0]);
2903 struct Lisp_Cons *otem = XCONS (tem);
2904 #if 0 /* FSFmacs defun hack */
2906 tem = Fpurecopy (Fcar (tem));
2918 read_compiled_function (Lisp_Object readcharfun, Emchar terminator)
2920 /* Accept compiled functions at read-time so that we don't
2921 have to build them at load-time. */
2923 Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
2924 struct gcpro gcpro1;
2927 int saw_a_doc_ref = 0;
2929 /* Note: we tell read_list not to search for doc references
2930 because we need to handle the "doc reference" for the
2931 instructions and constants differently. */
2932 stuff = read_list (readcharfun, terminator, 0, 0);
2933 len = XINT (Flength (stuff));
2934 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
2936 continuable_syntax_error ("#[...] used with wrong number of elements");
2938 for (iii = 0; CONSP (stuff); iii++)
2940 struct Lisp_Cons *victim = XCONS (stuff);
2941 make_byte_code_args[iii] = Fcar (stuff);
2942 if ((purify_flag || load_force_doc_strings)
2943 && CONSP (make_byte_code_args[iii])
2944 && EQ (XCAR (make_byte_code_args[iii]), Vload_file_name_internal))
2946 if (purify_flag && iii == COMPILED_DOC_STRING)
2948 /* same as in read_list(). */
2949 if (NILP (Vinternal_doc_file_name))
2950 make_byte_code_args[iii] = Qzero;
2952 XCAR (make_byte_code_args[iii]) =
2953 concat2 (build_string ("../lisp/"),
2954 Ffile_name_nondirectory
2955 (Vload_file_name_internal));
2960 stuff = Fcdr (stuff);
2963 GCPRO1 (make_byte_code_args[0]);
2966 /* v18 or v19 bytecode file. Need to Ebolify. */
2967 if (load_byte_code_version < 20 && VECTORP (make_byte_code_args[2]))
2968 ebolify_bytecode_constants (make_byte_code_args[2]);
2970 /* make-byte-code looks at purify_flag, which should have the same
2971 * value as our "read-pure" argument */
2972 stuff = Fmake_byte_code (len, make_byte_code_args);
2973 XCOMPILED_FUNCTION (stuff)->flags.ebolified = (load_byte_code_version < 20);
2975 Vload_force_doc_string_list = Fcons (stuff, Vload_force_doc_string_list);
2987 load_in_progress = 0;
2989 Vload_descriptor_list = Qnil;
2991 /* kludge: locate-file does not work for a null load-path, even if
2992 the file name is absolute. */
2994 Vload_path = Fcons (build_string (""), Qnil);
2996 /* This used to get initialized in init_lread because all streams
2997 got closed when dumping occurs. This is no longer true --
2998 Vread_buffer_stream is a resizing output stream, and there is no
2999 reason to close it at dump-time.
3001 Vread_buffer_stream is set to Qnil in vars_of_lread, and this
3002 will initialize it only once, at dump-time. */
3003 if (NILP (Vread_buffer_stream))
3004 Vread_buffer_stream = make_resizing_buffer_output_stream ();
3006 Vload_force_doc_string_list = Qnil;
3010 syms_of_lread (void)
3013 DEFSUBR (Fread_from_string);
3014 DEFSUBR (Fload_internal);
3015 DEFSUBR (Flocate_file);
3016 DEFSUBR (Flocate_file_clear_hashing);
3017 DEFSUBR (Feval_buffer);
3018 DEFSUBR (Feval_region);
3020 defsymbol (&Qstandard_input, "standard-input");
3021 defsymbol (&Qread_char, "read-char");
3022 defsymbol (&Qcurrent_load_list, "current-load-list");
3023 defsymbol (&Qload, "load");
3024 defsymbol (&Qload_file_name, "load-file-name");
3025 defsymbol (&Qlocate_file_hash_table, "locate-file-hash-table");
3026 defsymbol (&Qfset, "fset");
3028 #ifdef LISP_BACKQUOTES
3029 defsymbol (&Qbackquote, "backquote");
3030 defsymbol (&Qbacktick, "`");
3031 defsymbol (&Qcomma, ",");
3032 defsymbol (&Qcomma_at, ",@");
3033 defsymbol (&Qcomma_dot, ",.");
3038 structure_type_create (void)
3040 the_structure_type_dynarr = Dynarr_new (structure_type);
3044 vars_of_lread (void)
3046 DEFVAR_LISP ("values", &Vvalues /*
3047 List of values of all expressions which were read, evaluated and printed.
3048 Order is reverse chronological.
3051 DEFVAR_LISP ("standard-input", &Vstandard_input /*
3052 Stream for read to get input from.
3053 See documentation of `read' for possible values.
3055 Vstandard_input = Qt;
3057 DEFVAR_LISP ("load-path", &Vload_path /*
3058 *List of directories to search for files to load.
3059 Each element is a string (directory name) or nil (try default directory).
3061 Note that the elements of this list *may not* begin with "~", so you must
3062 call `expand-file-name' on them before adding them to this list.
3064 Initialized based on EMACSLOADPATH environment variable, if any,
3065 otherwise to default specified in by file `paths.h' when XEmacs was built.
3066 If there were no paths specified in `paths.h', then XEmacs chooses a default
3067 value for this variable by looking around in the file-system near the
3068 directory in which the XEmacs executable resides.
3072 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
3073 "*Location of lisp files to be used when dumping ONLY."); */
3075 DEFVAR_BOOL ("load-in-progress", &load_in_progress /*
3076 Non-nil iff inside of `load'.
3079 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist /*
3080 An alist of expressions to be evalled when particular files are loaded.
3081 Each element looks like (FILENAME FORMS...).
3082 When `load' is run and the file-name argument is FILENAME,
3083 the FORMS in the corresponding element are executed at the end of loading.
3085 FILENAME must match exactly! Normally FILENAME is the name of a library,
3086 with no directory specified, since that is how `load' is normally called.
3087 An error in FORMS does not undo the load,
3088 but does prevent execution of the rest of the FORMS.
3090 Vafter_load_alist = Qnil;
3092 DEFVAR_BOOL ("load-warn-when-source-newer", &load_warn_when_source_newer /*
3093 *Whether `load' should check whether the source is newer than the binary.
3094 If this variable is true, then when a `.elc' file is being loaded and the
3095 corresponding `.el' is newer, a warning message will be printed.
3097 load_warn_when_source_newer = 0;
3099 DEFVAR_BOOL ("load-warn-when-source-only", &load_warn_when_source_only /*
3100 *Whether `load' should warn when loading a `.el' file instead of an `.elc'.
3101 If this variable is true, then when `load' is called with a filename without
3102 an extension, and the `.elc' version doesn't exist but the `.el' version does,
3103 then a message will be printed. If an explicit extension is passed to `load',
3104 no warning will be printed.
3106 load_warn_when_source_only = 0;
3108 DEFVAR_BOOL ("load-ignore-elc-files", &load_ignore_elc_files /*
3109 *Whether `load' should ignore `.elc' files when a suffix is not given.
3110 This is normally used only to bootstrap the `.elc' files when building XEmacs.
3112 load_ignore_elc_files = 0;
3115 DEFVAR_LISP ("load-history", &Vload_history /*
3116 Alist mapping source file names to symbols and features.
3117 Each alist element is a list that starts with a file name,
3118 except for one element (optional) that starts with nil and describes
3119 definitions evaluated from buffers not visiting files.
3120 The remaining elements of each list are symbols defined as functions
3121 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
3123 Vload_history = Qnil;
3125 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list /*
3126 Used for internal purposes by `load'.
3128 Vcurrent_load_list = Qnil;
3131 DEFVAR_LISP ("load-file-name", &Vload_file_name /*
3132 Full name of file being loaded by `load'.
3134 Vload_file_name = Qnil;
3136 DEFVAR_LISP ("load-read-function", &Vload_read_function /*
3137 Function used by `load' and `eval-region' for reading expressions.
3138 The default is nil, which means use the function `read'.
3140 Vload_read_function = Qnil;
3142 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings /*
3143 Non-nil means `load' should force-load all dynamic doc strings.
3144 This is useful when the file being loaded is a temporary copy.
3146 load_force_doc_strings = 0;
3148 /* See read_escape(). */
3150 /* Used to be named `puke-on-fsf-keys' */
3151 DEFVAR_BOOL ("fail-on-bucky-bit-character-escapes",
3152 &fail_on_bucky_bit_character_escapes /*
3153 Whether `read' should signal an error when it encounters unsupported
3154 character escape syntaxes or just read them incorrectly.
3156 fail_on_bucky_bit_character_escapes = 0;
3159 /* This must be initialized in init_lread otherwise it may start out
3160 with values saved when the image is dumped. */
3161 staticpro (&Vload_descriptor_list);
3163 Vread_buffer_stream = Qnil;
3164 staticpro (&Vread_buffer_stream);
3166 /* Initialized in init_lread. */
3167 staticpro (&Vload_force_doc_string_list);
3169 Vload_file_name_internal = Qnil;
3170 staticpro (&Vload_file_name_internal);
3172 Vload_file_name_internal_the_purecopy = Qnil;
3173 staticpro (&Vload_file_name_internal_the_purecopy);
3175 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
3176 Vcurrent_compiled_function_annotation = Qnil;
3177 staticpro (&Vcurrent_compiled_function_annotation);
3180 /* So that early-early stuff will work */
3181 Ffset (Qload, intern ("load-internal"));
3183 #ifdef FEATUREP_SYNTAX
3184 defsymbol (&Qfeaturep, "featurep");
3185 Fprovide(intern("xemacs"));
3187 Fprovide(intern("infodock"));
3188 #endif /* INFODOCK */
3189 #endif /* FEATUREP_SYNTAX */
3191 #ifdef LISP_BACKQUOTES
3192 old_backquote_flag = new_backquote_flag = 0;
3196 Vfile_domain = Qnil;
3199 read_objects = Qnil;
3200 staticpro (&read_objects);