428
+ − 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
+ − 6 This file is part of XEmacs.
+ − 7
+ − 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
+ − 11 later version.
+ − 12
+ − 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
+ − 16 for more details.
+ − 17
+ − 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. */
+ − 22
+ − 23 /* Synched up with: Mule 2.0, FSF 19.30. */
+ − 24
+ − 25 /* This file has been Mule-ized. */
+ − 26
+ − 27 #include <config.h>
+ − 28 #include "lisp.h"
+ − 29
+ − 30 #include "buffer.h"
+ − 31 #include "bytecode.h"
+ − 32 #include "elhash.h"
+ − 33 #include "lstream.h"
+ − 34 #include "opaque.h"
+ − 35 #ifdef FILE_CODING
+ − 36 #include "file-coding.h"
+ − 37 #endif
+ − 38
+ − 39 #include "sysfile.h"
+ − 40
+ − 41 #ifdef LISP_FLOAT_TYPE
+ − 42 #define THIS_FILENAME lread
+ − 43 #include "sysfloat.h"
+ − 44 #endif /* LISP_FLOAT_TYPE */
+ − 45
+ − 46 Lisp_Object Qread_char, Qstandard_input;
+ − 47 Lisp_Object Qvariable_documentation;
+ − 48 #define LISP_BACKQUOTES
+ − 49 #ifdef LISP_BACKQUOTES
+ − 50 /*
+ − 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.
+ − 55
+ − 56 XEmacs:
+ − 57 Nested backquotes are perfectly legal and fail utterly with
+ − 58 this silliness. */
+ − 59 static int new_backquote_flag, old_backquote_flag;
+ − 60 Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot;
+ − 61 #endif
+ − 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 Qfset;
+ − 67
+ − 68 /* Hash-table that maps directory names to hashes of their contents. */
+ − 69 static Lisp_Object Vlocate_file_hash_table;
+ − 70
+ − 71 Lisp_Object Qexists, Qreadable, Qwritable, Qexecutable;
+ − 72
+ − 73 /* See read_escape() for an explanation of this. */
+ − 74 #if 0
+ − 75 int fail_on_bucky_bit_character_escapes;
+ − 76 #endif
+ − 77
+ − 78 /* This symbol is also used in fns.c */
+ − 79 #define FEATUREP_SYNTAX
+ − 80
+ − 81 #ifdef FEATUREP_SYNTAX
+ − 82 Lisp_Object Qfeaturep;
+ − 83 #endif
+ − 84
+ − 85 /* non-zero if inside `load' */
+ − 86 int load_in_progress;
+ − 87
+ − 88 /* Whether Fload_internal() should check whether the .el is newer
+ − 89 when loading .elc */
+ − 90 int load_warn_when_source_newer;
+ − 91 /* Whether Fload_internal() should check whether the .elc doesn't exist */
+ − 92 int load_warn_when_source_only;
+ − 93 /* Whether Fload_internal() should ignore .elc files when no suffix is given */
+ − 94 int load_ignore_elc_files;
+ − 95
+ − 96 /* Search path for files to be loaded. */
+ − 97 Lisp_Object Vload_path;
+ − 98
+ − 99 /* Search path for files when dumping. */
+ − 100 /* Lisp_Object Vdump_load_path; */
+ − 101
+ − 102 /* This is the user-visible association list that maps features to
+ − 103 lists of defs in their load files. */
+ − 104 Lisp_Object Vload_history;
+ − 105
+ − 106 /* This is used to build the load history. */
+ − 107 Lisp_Object Vcurrent_load_list;
+ − 108
+ − 109 /* Name of file actually being read by `load'. */
+ − 110 Lisp_Object Vload_file_name;
+ − 111
+ − 112 /* Same as Vload_file_name but not Lisp-accessible. This ensures that
+ − 113 our #$ checks are reliable. */
+ − 114 Lisp_Object Vload_file_name_internal;
+ − 115
+ − 116 Lisp_Object Vload_file_name_internal_the_purecopy;
+ − 117
+ − 118 /* Function to use for reading, in `load' and friends. */
+ − 119 Lisp_Object Vload_read_function;
+ − 120
+ − 121 /* The association list of objects read with the #n=object form.
+ − 122 Each member of the list has the form (n . object), and is used to
+ − 123 look up the object for the corresponding #n# construct.
+ − 124 It must be set to nil before all top-level calls to read0. */
+ − 125 Lisp_Object Vread_objects;
+ − 126
+ − 127 /* Nonzero means load should forcibly load all dynamic doc strings. */
+ − 128 /* Note that this always happens (with some special behavior) when
+ − 129 purify_flag is set. */
+ − 130 static int load_force_doc_strings;
+ − 131
+ − 132 /* List of descriptors now open for Fload_internal. */
+ − 133 static Lisp_Object Vload_descriptor_list;
+ − 134
+ − 135 /* In order to implement "load_force_doc_strings", we keep
+ − 136 a list of all the compiled-function objects and such
+ − 137 that we have created in the process of loading this file.
+ − 138 See the rant below.
+ − 139
+ − 140 We specbind this just like Vload_file_name, so there's no
+ − 141 problems with recursive loading. */
+ − 142 static Lisp_Object Vload_force_doc_string_list;
+ − 143
+ − 144 /* A resizing-buffer stream used to temporarily hold data while reading */
+ − 145 static Lisp_Object Vread_buffer_stream;
+ − 146
+ − 147 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ − 148 Lisp_Object Vcurrent_compiled_function_annotation;
+ − 149 #endif
+ − 150
+ − 151 static int load_byte_code_version;
+ − 152
+ − 153 /* An array describing all known built-in structure types */
+ − 154 static structure_type_dynarr *the_structure_type_dynarr;
+ − 155
+ − 156 #if 0 /* FSF defun hack */
+ − 157 /* When nonzero, read conses in pure space */
+ − 158 static int read_pure;
+ − 159 #endif
+ − 160
+ − 161 #if 0 /* FSF stuff */
+ − 162 /* For use within read-from-string (this reader is non-reentrant!!) */
+ − 163 static int read_from_string_index;
+ − 164 static int read_from_string_limit;
+ − 165 #endif
+ − 166
+ − 167 #if 0 /* More FSF implementation kludges. */
+ − 168 /* In order to implement load-force-doc-string, FSF saves the
+ − 169 #@-quoted string when it's seen, and goes back and retrieves
+ − 170 it later.
+ − 171
+ − 172 This approach is not only kludgy, but it in general won't work
+ − 173 correctly because there's no stack of remembered #@-quoted-strings
+ − 174 and those strings don't generally appear in the file in the same
+ − 175 order as their #$ references. (Yes, that is amazingly stupid too.
+ − 176
+ − 177 It would be trivially easy to always encode the #@ string
+ − 178 [which is a comment, anyway] in the middle of the (#$ . INT) cons
+ − 179 reference. That way, it would be really easy to implement
+ − 180 load-force-doc-string in a non-kludgy way by just retrieving the
+ − 181 string immediately, because it's delivered on a silver platter.)
+ − 182
+ − 183 And finally, this stupid approach doesn't work under Mule, or
+ − 184 under MS-DOS or Windows NT, or under VMS, or any other place
+ − 185 where you either can't do an ftell() or don't get back a byte
+ − 186 count.
+ − 187
+ − 188 Oh, and one more lossage in this approach: If you attempt to
+ − 189 dump any ELC files that were compiled with `byte-compile-dynamic'
+ − 190 (as opposed to just `byte-compile-dynamic-docstring'), you
+ − 191 get hosed. FMH! (as the illustrious JWZ was prone to utter)
+ − 192
+ − 193 The approach we use is clean, solves all of these problems, and is
+ − 194 probably easier to implement anyway. We just save a list of all
+ − 195 the containing objects that have (#$ . INT) conses in them (this
+ − 196 will only be compiled-function objects and lists), and when the
+ − 197 file is finished loading, we go through and fill in all the
+ − 198 doc strings at once. */
+ − 199
+ − 200 /* This contains the last string skipped with #@. */
+ − 201 static char *saved_doc_string;
+ − 202 /* Length of buffer allocated in saved_doc_string. */
+ − 203 static int saved_doc_string_size;
+ − 204 /* Length of actual data in saved_doc_string. */
+ − 205 static int saved_doc_string_length;
+ − 206 /* This is the file position that string came from. */
+ − 207 static int saved_doc_string_position;
+ − 208 #endif
+ − 209
+ − 210 EXFUN (Fread_from_string, 3);
+ − 211
+ − 212 /* When errors are signaled, the actual readcharfun should not be used
+ − 213 as an argument if it is an lstream, so that lstreams don't escape
+ − 214 to the Lisp level. */
+ − 215 #define READCHARFUN_MAYBE(x) (LSTREAMP (x) \
+ − 216 ? (build_string ("internal input stream")) \
+ − 217 : (x))
+ − 218
+ − 219
+ − 220 static DOESNT_RETURN
442
+ − 221 read_syntax_error (const char *string)
428
+ − 222 {
563
+ − 223 signal_error (Qinvalid_read_syntax, string, Qunbound);
428
+ − 224 }
+ − 225
+ − 226 static Lisp_Object
442
+ − 227 continuable_read_syntax_error (const char *string)
428
+ − 228 {
563
+ − 229 return signal_continuable_error (Qinvalid_read_syntax, string, Qunbound);
428
+ − 230 }
+ − 231
+ − 232
+ − 233 /* Handle unreading and rereading of characters. */
+ − 234 static Emchar
+ − 235 readchar (Lisp_Object readcharfun)
+ − 236 {
+ − 237 /* This function can GC */
+ − 238
+ − 239 if (BUFFERP (readcharfun))
+ − 240 {
+ − 241 Emchar c;
+ − 242 struct buffer *b = XBUFFER (readcharfun);
+ − 243
+ − 244 if (!BUFFER_LIVE_P (b))
563
+ − 245 invalid_operation ("Reading from killed buffer", Qunbound);
428
+ − 246
+ − 247 if (BUF_PT (b) >= BUF_ZV (b))
+ − 248 return -1;
+ − 249 c = BUF_FETCH_CHAR (b, BUF_PT (b));
+ − 250 BUF_SET_PT (b, BUF_PT (b) + 1);
+ − 251
+ − 252 return c;
+ − 253 }
+ − 254 else if (LSTREAMP (readcharfun))
+ − 255 {
+ − 256 Emchar c = Lstream_get_emchar (XLSTREAM (readcharfun));
+ − 257 #ifdef DEBUG_XEMACS /* testing Mule */
+ − 258 static int testing_mule = 0; /* Change via debugger */
444
+ − 259 if (testing_mule)
+ − 260 {
+ − 261 if (c >= 0x20 && c <= 0x7E) stderr_out ("%c", c);
+ − 262 else if (c == '\n') stderr_out ("\\n\n");
+ − 263 else stderr_out ("\\%o ", c);
+ − 264 }
+ − 265 #endif /* testing Mule */
428
+ − 266 return c;
+ − 267 }
+ − 268 else if (MARKERP (readcharfun))
+ − 269 {
+ − 270 Emchar c;
+ − 271 Bufpos mpos = marker_position (readcharfun);
+ − 272 struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
+ − 273
+ − 274 if (mpos >= BUF_ZV (inbuffer))
+ − 275 return -1;
+ − 276 c = BUF_FETCH_CHAR (inbuffer, mpos);
+ − 277 set_marker_position (readcharfun, mpos + 1);
+ − 278 return c;
+ − 279 }
+ − 280 else
+ − 281 {
+ − 282 Lisp_Object tem = call0 (readcharfun);
+ − 283
+ − 284 if (!CHAR_OR_CHAR_INTP (tem))
+ − 285 return -1;
+ − 286 return XCHAR_OR_CHAR_INT (tem);
+ − 287 }
+ − 288 }
+ − 289
+ − 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. */
+ − 292
+ − 293 static void
+ − 294 unreadchar (Lisp_Object readcharfun, Emchar c)
+ − 295 {
+ − 296 if (c == -1)
+ − 297 /* Don't back up the pointer if we're unreading the end-of-input mark,
+ − 298 since readchar didn't advance it when we read it. */
+ − 299 ;
+ − 300 else if (BUFFERP (readcharfun))
+ − 301 BUF_SET_PT (XBUFFER (readcharfun), BUF_PT (XBUFFER (readcharfun)) - 1);
+ − 302 else if (LSTREAMP (readcharfun))
+ − 303 {
+ − 304 Lstream_unget_emchar (XLSTREAM (readcharfun), c);
+ − 305 #ifdef DEBUG_XEMACS /* testing Mule */
+ − 306 {
+ − 307 static int testing_mule = 0; /* Set this using debugger */
+ − 308 if (testing_mule)
+ − 309 fprintf (stderr,
+ − 310 (c >= 0x20 && c <= 0x7E) ? "UU%c" :
+ − 311 ((c == '\n') ? "UU\\n\n" : "UU\\%o"), c);
+ − 312 }
+ − 313 #endif
+ − 314 }
+ − 315 else if (MARKERP (readcharfun))
+ − 316 set_marker_position (readcharfun, marker_position (readcharfun) - 1);
+ − 317 else
+ − 318 call1 (readcharfun, make_char (c));
+ − 319 }
+ − 320
+ − 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
+ − 326 good reasons)
+ − 327 */
+ − 328 /*
+ − 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
+ − 333 them in again.)
+ − 334
+ − 335 WARNING: If you set this, you sure as hell better not call
+ − 336 free_list() on the returned list here. */
+ − 337
+ − 338 static Lisp_Object read_list (Lisp_Object readcharfun,
+ − 339 Emchar terminator,
+ − 340 int allow_dotted_lists,
+ − 341 int check_for_doc_references);
+ − 342
+ − 343 static void readevalloop (Lisp_Object readcharfun,
+ − 344 Lisp_Object sourcefile,
+ − 345 Lisp_Object (*evalfun) (Lisp_Object),
+ − 346 int printflag);
+ − 347
+ − 348 static Lisp_Object
+ − 349 load_unwind (Lisp_Object stream) /* used as unwind-protect function in load */
+ − 350 {
+ − 351 Lstream_close (XLSTREAM (stream));
+ − 352 if (--load_in_progress < 0)
+ − 353 load_in_progress = 0;
+ − 354 return Qnil;
+ − 355 }
+ − 356
+ − 357 static Lisp_Object
+ − 358 load_descriptor_unwind (Lisp_Object oldlist)
+ − 359 {
+ − 360 Vload_descriptor_list = oldlist;
+ − 361 return Qnil;
+ − 362 }
+ − 363
+ − 364 static Lisp_Object
+ − 365 load_file_name_internal_unwind (Lisp_Object oldval)
+ − 366 {
+ − 367 Vload_file_name_internal = oldval;
+ − 368 return Qnil;
+ − 369 }
+ − 370
+ − 371 static Lisp_Object
+ − 372 load_file_name_internal_the_purecopy_unwind (Lisp_Object oldval)
+ − 373 {
+ − 374 Vload_file_name_internal_the_purecopy = oldval;
+ − 375 return Qnil;
+ − 376 }
+ − 377
+ − 378 static Lisp_Object
+ − 379 load_byte_code_version_unwind (Lisp_Object oldval)
+ − 380 {
+ − 381 load_byte_code_version = XINT (oldval);
+ − 382 return Qnil;
+ − 383 }
+ − 384
+ − 385 /* The plague is coming.
+ − 386
+ − 387 Ring around the rosy, pocket full of posy,
+ − 388 Ashes ashes, they all fall down.
+ − 389 */
+ − 390 void
+ − 391 ebolify_bytecode_constants (Lisp_Object vector)
+ − 392 {
+ − 393 int len = XVECTOR_LENGTH (vector);
+ − 394 int i;
+ − 395
+ − 396 for (i = 0; i < len; i++)
+ − 397 {
+ − 398 Lisp_Object el = XVECTOR_DATA (vector)[i];
+ − 399
+ − 400 /* We don't check for `eq', `equal', and the others that have
+ − 401 bytecode opcodes. This might lose if someone passes #'eq or
+ − 402 something to `funcall', but who would really do that? As
+ − 403 they say in law, we've made a "good-faith effort" to
+ − 404 unfuckify ourselves. And doing it this way avoids screwing
+ − 405 up args to `make-hash-table' and such. As it is, we have to
+ − 406 add an extra Ebola check in decode_weak_list_type(). --ben */
+ − 407 if (EQ (el, Qassoc)) el = Qold_assoc;
+ − 408 else if (EQ (el, Qdelq)) el = Qold_delq;
+ − 409 #if 0
+ − 410 /* I think this is a bad idea because it will probably mess
+ − 411 with keymap code. */
+ − 412 else if (EQ (el, Qdelete)) el = Qold_delete;
+ − 413 #endif
+ − 414 else if (EQ (el, Qrassq)) el = Qold_rassq;
+ − 415 else if (EQ (el, Qrassoc)) el = Qold_rassoc;
+ − 416
+ − 417 XVECTOR_DATA (vector)[i] = el;
+ − 418 }
+ − 419 }
+ − 420
+ − 421 static Lisp_Object
558
+ − 422 pas_de_holgazan_ici (int fd, Lisp_Object victim)
428
+ − 423 {
+ − 424 Lisp_Object tem;
+ − 425 EMACS_INT pos;
+ − 426
+ − 427 if (!INTP (XCDR (victim)))
563
+ − 428 invalid_byte_code ("Bogus doc string reference", victim);
428
+ − 429 pos = XINT (XCDR (victim));
+ − 430 if (pos < 0)
+ − 431 pos = -pos; /* kludge to mark a user variable */
+ − 432 tem = unparesseuxify_doc_string (fd, pos, 0, Vload_file_name_internal);
+ − 433 if (!STRINGP (tem))
563
+ − 434 signal_error_1 (Qinvalid_byte_code, tem);
428
+ − 435 return tem;
+ − 436 }
+ − 437
+ − 438 static Lisp_Object
+ − 439 load_force_doc_string_unwind (Lisp_Object oldlist)
+ − 440 {
+ − 441 struct gcpro gcpro1;
+ − 442 Lisp_Object list = Vload_force_doc_string_list;
+ − 443 Lisp_Object tail;
+ − 444 int fd = XINT (XCAR (Vload_descriptor_list));
+ − 445
+ − 446 GCPRO1 (list);
+ − 447 /* restore the old value first just in case an error occurs. */
+ − 448 Vload_force_doc_string_list = oldlist;
+ − 449
+ − 450 LIST_LOOP (tail, list)
+ − 451 {
+ − 452 Lisp_Object john = Fcar (tail);
+ − 453 if (CONSP (john))
+ − 454 {
+ − 455 assert (CONSP (XCAR (john)));
+ − 456 assert (!purify_flag); /* should have been handled in read_list() */
558
+ − 457 XCAR (john) = pas_de_holgazan_ici (fd, XCAR (john));
428
+ − 458 }
+ − 459 else
+ − 460 {
+ − 461 Lisp_Object doc;
+ − 462
+ − 463 assert (COMPILED_FUNCTIONP (john));
+ − 464 if (CONSP (XCOMPILED_FUNCTION (john)->instructions))
+ − 465 {
+ − 466 struct gcpro ngcpro1;
558
+ − 467 Lisp_Object juan = (pas_de_holgazan_ici
428
+ − 468 (fd, XCOMPILED_FUNCTION (john)->instructions));
+ − 469 Lisp_Object ivan;
+ − 470
+ − 471 NGCPRO1 (juan);
+ − 472 ivan = Fread (juan);
+ − 473 if (!CONSP (ivan))
563
+ − 474 invalid_byte_code ("invalid lazy-loaded byte code", ivan);
428
+ − 475 XCOMPILED_FUNCTION (john)->instructions = XCAR (ivan);
+ − 476 /* v18 or v19 bytecode file. Need to Ebolify. */
+ − 477 if (XCOMPILED_FUNCTION (john)->flags.ebolified
+ − 478 && VECTORP (XCDR (ivan)))
+ − 479 ebolify_bytecode_constants (XCDR (ivan));
+ − 480 XCOMPILED_FUNCTION (john)->constants = XCDR (ivan);
+ − 481 NUNGCPRO;
+ − 482 }
+ − 483 doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
+ − 484 if (CONSP (doc))
+ − 485 {
+ − 486 assert (!purify_flag); /* should have been handled in
+ − 487 read_compiled_function() */
558
+ − 488 doc = pas_de_holgazan_ici (fd, doc);
428
+ − 489 set_compiled_function_documentation (XCOMPILED_FUNCTION (john),
+ − 490 doc);
+ − 491 }
+ − 492 }
+ − 493 }
+ − 494
+ − 495 if (!NILP (list))
+ − 496 free_list (list);
+ − 497
+ − 498 UNGCPRO;
+ − 499 return Qnil;
+ − 500 }
+ − 501
+ − 502 /* Close all descriptors in use for Fload_internal.
+ − 503 This is used when starting a subprocess. */
+ − 504
+ − 505 void
+ − 506 close_load_descs (void)
+ − 507 {
+ − 508 Lisp_Object tail;
+ − 509 LIST_LOOP (tail, Vload_descriptor_list)
+ − 510 close (XINT (XCAR (tail)));
+ − 511 }
+ − 512
+ − 513 #ifdef I18N3
+ − 514 Lisp_Object Vfile_domain;
+ − 515
+ − 516 Lisp_Object
+ − 517 restore_file_domain (Lisp_Object val)
+ − 518 {
+ − 519 Vfile_domain = val;
+ − 520 return Qnil;
+ − 521 }
+ − 522 #endif /* I18N3 */
+ − 523
+ − 524 DEFUN ("load-internal", Fload_internal, 1, 6, 0, /*
+ − 525 Execute a file of Lisp code named FILE; no coding-system frobbing.
+ − 526 This function is identical to `load' except for the handling of the
+ − 527 CODESYS and USED-CODESYS arguments under XEmacs/Mule. (When Mule
+ − 528 support is not present, both functions are identical and ignore the
+ − 529 CODESYS and USED-CODESYS arguments.)
+ − 530
+ − 531 If support for Mule exists in this Emacs, the file is decoded
+ − 532 according to CODESYS; if omitted, no conversion happens. If
+ − 533 USED-CODESYS is non-nil, it should be a symbol, and the actual coding
+ − 534 system that was used for the decoding is stored into it. It will in
+ − 535 general be different from CODESYS if CODESYS specifies automatic
+ − 536 encoding detection or end-of-line detection.
+ − 537 */
444
+ − 538 (file, noerror, nomessage, nosuffix, codesys, used_codesys))
428
+ − 539 {
+ − 540 /* This function can GC */
+ − 541 int fd = -1;
+ − 542 int speccount = specpdl_depth ();
+ − 543 int source_only = 0;
+ − 544 Lisp_Object newer = Qnil;
+ − 545 Lisp_Object handler = Qnil;
+ − 546 Lisp_Object found = Qnil;
+ − 547 struct gcpro gcpro1, gcpro2, gcpro3;
+ − 548 int reading_elc = 0;
+ − 549 int message_p = NILP (nomessage);
+ − 550 /*#ifdef DEBUG_XEMACS*/
+ − 551 static Lisp_Object last_file_loaded;
+ − 552 /*#endif*/
+ − 553 struct stat s1, s2;
+ − 554 GCPRO3 (file, newer, found);
+ − 555
+ − 556 CHECK_STRING (file);
+ − 557
+ − 558 /*#ifdef DEBUG_XEMACS*/
+ − 559 if (purify_flag && noninteractive)
+ − 560 {
+ − 561 message_p = 1;
+ − 562 last_file_loaded = file;
+ − 563 }
+ − 564 /*#endif / * DEBUG_XEMACS */
+ − 565
+ − 566 /* If file name is magic, call the handler. */
+ − 567 handler = Ffind_file_name_handler (file, Qload);
+ − 568 if (!NILP (handler))
444
+ − 569 RETURN_UNGCPRO (call5 (handler, Qload, file, noerror,
428
+ − 570 nomessage, nosuffix));
+ − 571
+ − 572 /* Do this after the handler to avoid
+ − 573 the need to gcpro noerror, nomessage and nosuffix.
+ − 574 (Below here, we care only whether they are nil or not.) */
+ − 575 file = Fsubstitute_in_file_name (file);
+ − 576 #ifdef FILE_CODING
+ − 577 if (!NILP (used_codesys))
+ − 578 CHECK_SYMBOL (used_codesys);
+ − 579 #endif
+ − 580
+ − 581 /* Avoid weird lossage with null string as arg,
+ − 582 since it would try to load a directory as a Lisp file.
+ − 583 Unix truly sucks. */
+ − 584 if (XSTRING_LENGTH (file) > 0)
+ − 585 {
+ − 586 char *foundstr;
+ − 587 int foundlen;
+ − 588
+ − 589 fd = locate_file (Vload_path, file,
+ − 590 ((!NILP (nosuffix)) ? Qnil :
+ − 591 build_string (load_ignore_elc_files ? ".el:" :
+ − 592 ".elc:.el:")),
+ − 593 &found,
+ − 594 -1);
+ − 595
+ − 596 if (fd < 0)
+ − 597 {
444
+ − 598 if (NILP (noerror))
563
+ − 599 signal_error (Qfile_error, "Cannot open load file", file);
428
+ − 600 else
+ − 601 {
+ − 602 UNGCPRO;
+ − 603 return Qnil;
+ − 604 }
+ − 605 }
+ − 606
+ − 607 foundstr = (char *) alloca (XSTRING_LENGTH (found) + 1);
+ − 608 strcpy (foundstr, (char *) XSTRING_DATA (found));
+ − 609 foundlen = strlen (foundstr);
+ − 610
+ − 611 /* The omniscient JWZ thinks this is worthless, but I beg to
+ − 612 differ. --ben */
+ − 613 if (load_ignore_elc_files)
+ − 614 {
+ − 615 newer = Ffile_name_nondirectory (found);
+ − 616 }
+ − 617 else if (load_warn_when_source_newer &&
+ − 618 !memcmp (".elc", foundstr + foundlen - 4, 4))
+ − 619 {
+ − 620 if (! fstat (fd, &s1)) /* can't fail, right? */
+ − 621 {
+ − 622 int result;
+ − 623 /* temporarily hack the 'c' off the end of the filename */
+ − 624 foundstr[foundlen - 1] = '\0';
442
+ − 625 result = xemacs_stat (foundstr, &s2);
428
+ − 626 if (result >= 0 &&
+ − 627 (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
+ − 628 {
+ − 629 Lisp_Object newer_name = make_string ((Bufbyte *) foundstr,
+ − 630 foundlen - 1);
+ − 631 struct gcpro nngcpro1;
+ − 632 NNGCPRO1 (newer_name);
+ − 633 newer = Ffile_name_nondirectory (newer_name);
+ − 634 NNUNGCPRO;
+ − 635 }
+ − 636 /* put the 'c' back on (kludge-o-rama) */
+ − 637 foundstr[foundlen - 1] = 'c';
+ − 638 }
+ − 639 }
+ − 640 else if (load_warn_when_source_only &&
+ − 641 /* `found' ends in ".el" */
+ − 642 !memcmp (".el", foundstr + foundlen - 3, 3) &&
+ − 643 /* `file' does not end in ".el" */
+ − 644 memcmp (".el",
+ − 645 XSTRING_DATA (file) + XSTRING_LENGTH (file) - 3,
+ − 646 3))
+ − 647 {
+ − 648 source_only = 1;
+ − 649 }
+ − 650
+ − 651 if (!memcmp (".elc", foundstr + foundlen - 4, 4))
+ − 652 reading_elc = 1;
+ − 653 }
+ − 654
+ − 655 #define PRINT_LOADING_MESSAGE(done) do { \
+ − 656 if (load_ignore_elc_files) \
+ − 657 { \
+ − 658 if (message_p) \
+ − 659 message ("Loading %s..." done, XSTRING_DATA (newer)); \
+ − 660 } \
+ − 661 else if (!NILP (newer)) \
+ − 662 message ("Loading %s..." done " (file %s is newer)", \
+ − 663 XSTRING_DATA (file), \
+ − 664 XSTRING_DATA (newer)); \
+ − 665 else if (source_only) \
+ − 666 message ("Loading %s..." done " (file %s.elc does not exist)", \
+ − 667 XSTRING_DATA (file), \
+ − 668 XSTRING_DATA (Ffile_name_nondirectory (file))); \
+ − 669 else if (message_p) \
+ − 670 message ("Loading %s..." done, XSTRING_DATA (file)); \
+ − 671 } while (0)
+ − 672
+ − 673 PRINT_LOADING_MESSAGE ("");
+ − 674
+ − 675 {
+ − 676 /* Lisp_Object's must be malloc'ed, not stack-allocated */
+ − 677 Lisp_Object lispstream = Qnil;
442
+ − 678 const int block_size = 8192;
428
+ − 679 struct gcpro ngcpro1;
+ − 680
+ − 681 NGCPRO1 (lispstream);
+ − 682 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
+ − 683 /* 64K is used for normal files; 8K should be OK here because Lisp
+ − 684 files aren't really all that big. */
+ − 685 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
+ − 686 block_size);
+ − 687 #ifdef FILE_CODING
+ − 688 lispstream = make_decoding_input_stream
+ − 689 (XLSTREAM (lispstream), Fget_coding_system (codesys));
+ − 690 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
+ − 691 block_size);
+ − 692 #endif
+ − 693 /* NOTE: Order of these is very important. Don't rearrange them. */
+ − 694 record_unwind_protect (load_unwind, lispstream);
+ − 695 record_unwind_protect (load_descriptor_unwind, Vload_descriptor_list);
+ − 696 record_unwind_protect (load_file_name_internal_unwind,
+ − 697 Vload_file_name_internal);
+ − 698 record_unwind_protect (load_file_name_internal_the_purecopy_unwind,
+ − 699 Vload_file_name_internal_the_purecopy);
+ − 700 record_unwind_protect (load_force_doc_string_unwind,
+ − 701 Vload_force_doc_string_list);
+ − 702 Vload_file_name_internal = found;
+ − 703 Vload_file_name_internal_the_purecopy = Qnil;
+ − 704 specbind (Qload_file_name, found);
+ − 705 Vload_descriptor_list = Fcons (make_int (fd), Vload_descriptor_list);
+ − 706 Vload_force_doc_string_list = Qnil;
+ − 707 #ifdef I18N3
+ − 708 record_unwind_protect (restore_file_domain, Vfile_domain);
+ − 709 Vfile_domain = Qnil; /* set it to nil; a call to #'domain will set it. */
+ − 710 #endif
+ − 711 load_in_progress++;
+ − 712
+ − 713 /* Now determine what sort of ELC file we're reading in. */
+ − 714 record_unwind_protect (load_byte_code_version_unwind,
+ − 715 make_int (load_byte_code_version));
+ − 716 if (reading_elc)
+ − 717 {
+ − 718 char elc_header[8];
+ − 719 int num_read;
+ − 720
+ − 721 num_read = Lstream_read (XLSTREAM (lispstream), elc_header, 8);
+ − 722 if (num_read < 8
+ − 723 || strncmp (elc_header, ";ELC", 4))
+ − 724 {
+ − 725 /* Huh? Probably not a valid ELC file. */
+ − 726 load_byte_code_version = 100; /* no Ebolification needed */
+ − 727 Lstream_unread (XLSTREAM (lispstream), elc_header, num_read);
+ − 728 }
+ − 729 else
+ − 730 load_byte_code_version = elc_header[4];
+ − 731 }
+ − 732 else
+ − 733 load_byte_code_version = 100; /* no Ebolification needed */
+ − 734
+ − 735 readevalloop (lispstream, file, Feval, 0);
+ − 736 #ifdef FILE_CODING
+ − 737 if (!NILP (used_codesys))
+ − 738 Fset (used_codesys,
+ − 739 XCODING_SYSTEM_NAME
+ − 740 (decoding_stream_coding_system (XLSTREAM (lispstream))));
+ − 741 #endif
+ − 742 unbind_to (speccount, Qnil);
+ − 743
+ − 744 NUNGCPRO;
+ − 745 }
+ − 746
+ − 747 {
+ − 748 Lisp_Object tem;
+ − 749 /* #### Disgusting kludge */
+ − 750 /* Run any load-hooks for this file. */
+ − 751 /* #### An even more disgusting kludge. There is horrible code */
+ − 752 /* that is relying on the fact that dumped lisp files are found */
+ − 753 /* via `load-path' search. */
+ − 754 Lisp_Object name = file;
+ − 755
+ − 756 if (!NILP(Ffile_name_absolute_p(file)))
+ − 757 {
+ − 758 name = Ffile_name_nondirectory(file);
+ − 759 }
+ − 760
+ − 761 {
+ − 762 struct gcpro ngcpro1;
+ − 763
+ − 764 NGCPRO1 (name);
+ − 765 tem = Fassoc (name, Vafter_load_alist);
+ − 766 NUNGCPRO;
+ − 767 }
+ − 768 if (!NILP (tem))
+ − 769 {
+ − 770 struct gcpro ngcpro1;
+ − 771
+ − 772 NGCPRO1 (tem);
+ − 773 /* Use eval so that errors give a semi-meaningful backtrace. --Stig */
+ − 774 tem = Fcons (Qprogn, Fcdr (tem));
+ − 775 Feval (tem);
+ − 776 NUNGCPRO;
+ − 777 }
+ − 778 }
+ − 779
+ − 780 /*#ifdef DEBUG_XEMACS*/
+ − 781 if (purify_flag && noninteractive)
+ − 782 {
+ − 783 if (!EQ (last_file_loaded, file))
+ − 784 message ("Loading %s ...done", XSTRING_DATA (file));
+ − 785 }
+ − 786 /*#endif / * DEBUG_XEMACS */
+ − 787
+ − 788 if (!noninteractive)
+ − 789 PRINT_LOADING_MESSAGE ("done");
+ − 790
+ − 791 UNGCPRO;
+ − 792 return Qt;
+ − 793 }
+ − 794
+ − 795
+ − 796 /* ------------------------------- */
+ − 797 /* locate_file */
+ − 798 /* ------------------------------- */
+ − 799
+ − 800 static int
+ − 801 decode_mode_1 (Lisp_Object mode)
+ − 802 {
+ − 803 if (EQ (mode, Qexists))
+ − 804 return F_OK;
+ − 805 else if (EQ (mode, Qexecutable))
+ − 806 return X_OK;
+ − 807 else if (EQ (mode, Qwritable))
+ − 808 return W_OK;
+ − 809 else if (EQ (mode, Qreadable))
+ − 810 return R_OK;
+ − 811 else if (INTP (mode))
+ − 812 {
+ − 813 check_int_range (XINT (mode), 0, 7);
+ − 814 return XINT (mode);
+ − 815 }
+ − 816 else
563
+ − 817 invalid_argument ("Invalid value", mode);
428
+ − 818 return 0; /* unreached */
+ − 819 }
+ − 820
+ − 821 static int
+ − 822 decode_mode (Lisp_Object mode)
+ − 823 {
+ − 824 if (NILP (mode))
+ − 825 return R_OK;
+ − 826 else if (CONSP (mode))
+ − 827 {
+ − 828 Lisp_Object tail;
+ − 829 int mask = 0;
+ − 830 EXTERNAL_LIST_LOOP (tail, mode)
+ − 831 mask |= decode_mode_1 (XCAR (tail));
+ − 832 return mask;
+ − 833 }
+ − 834 else
+ − 835 return decode_mode_1 (mode);
+ − 836 }
+ − 837
+ − 838 DEFUN ("locate-file", Flocate_file, 2, 4, 0, /*
+ − 839 Search for FILENAME through PATH-LIST.
+ − 840
+ − 841 If SUFFIXES is non-nil, it should be a list of suffixes to append to
+ − 842 file name when searching.
+ − 843
+ − 844 If MODE is non-nil, it should be a symbol or a list of symbol representing
+ − 845 requirements. Allowed symbols are `exists', `executable', `writable', and
+ − 846 `readable'. If MODE is nil, it defaults to `readable'.
+ − 847
+ − 848 `locate-file' keeps hash tables of the directories it searches through,
+ − 849 in order to speed things up. It tries valiantly to not get confused in
+ − 850 the face of a changing and unpredictable environment, but can occasionally
+ − 851 get tripped up. In this case, you will have to call
+ − 852 `locate-file-clear-hashing' to get it back on track. See that function
+ − 853 for details.
+ − 854 */
+ − 855 (filename, path_list, suffixes, mode))
+ − 856 {
+ − 857 /* This function can GC */
+ − 858 Lisp_Object tp;
+ − 859
+ − 860 CHECK_STRING (filename);
+ − 861
+ − 862 if (LISTP (suffixes))
+ − 863 {
+ − 864 Lisp_Object tail;
+ − 865 EXTERNAL_LIST_LOOP (tail, suffixes)
+ − 866 CHECK_STRING (XCAR (tail));
+ − 867 }
+ − 868 else
+ − 869 CHECK_STRING (suffixes);
+ − 870
+ − 871 locate_file (path_list, filename, suffixes, &tp, decode_mode (mode));
+ − 872 return tp;
+ − 873 }
+ − 874
+ − 875 /* Recalculate the hash table for the given string. DIRECTORY should
+ − 876 better have been through Fexpand_file_name() by now. */
+ − 877
+ − 878 static Lisp_Object
+ − 879 locate_file_refresh_hashing (Lisp_Object directory)
+ − 880 {
+ − 881 Lisp_Object hash =
+ − 882 make_directory_hash_table ((char *) XSTRING_DATA (directory));
+ − 883
+ − 884 if (!NILP (hash))
+ − 885 Fputhash (directory, hash, Vlocate_file_hash_table);
+ − 886 return hash;
+ − 887 }
+ − 888
+ − 889 /* find the hash table for the given directory, recalculating if necessary */
+ − 890
+ − 891 static Lisp_Object
+ − 892 locate_file_find_directory_hash_table (Lisp_Object directory)
+ − 893 {
+ − 894 Lisp_Object hash = Fgethash (directory, Vlocate_file_hash_table, Qnil);
+ − 895 if (NILP (hash))
+ − 896 return locate_file_refresh_hashing (directory);
+ − 897 else
+ − 898 return hash;
+ − 899 }
+ − 900
+ − 901 /* The SUFFIXES argument in any of the locate_file* functions can be
+ − 902 nil, a list, or a string (for backward compatibility), with the
+ − 903 following semantics:
+ − 904
+ − 905 a) nil - no suffix, just search for file name intact
+ − 906 (semantically different from "empty suffix list", which
+ − 907 would be meaningless.)
+ − 908 b) list - list of suffixes to append to file name. Each of these
+ − 909 must be a string.
+ − 910 c) string - colon-separated suffixes to append to file name (backward
+ − 911 compatibility).
+ − 912
+ − 913 All of this got hairy, so I decided to use a mapper. Calling a
+ − 914 function for each suffix shouldn't slow things down, since
+ − 915 locate_file is rarely called with enough suffixes for funcalls to
+ − 916 make any difference. */
+ − 917
+ − 918 /* Map FUN over SUFFIXES, as described above. FUN will be called with a
+ − 919 char * containing the current file name, and ARG. Mapping stops when
+ − 920 FUN returns non-zero. */
+ − 921 static void
+ − 922 locate_file_map_suffixes (Lisp_Object filename, Lisp_Object suffixes,
+ − 923 int (*fun) (char *, void *),
+ − 924 void *arg)
+ − 925 {
+ − 926 /* This function can GC */
+ − 927 char *fn;
+ − 928 int fn_len, max;
+ − 929
+ − 930 /* Calculate maximum size of any filename made from
+ − 931 this path element/specified file name and any possible suffix. */
+ − 932 if (CONSP (suffixes))
+ − 933 {
+ − 934 /* We must traverse the list, so why not do it right. */
+ − 935 Lisp_Object tail;
+ − 936 max = 0;
+ − 937 LIST_LOOP (tail, suffixes)
+ − 938 {
+ − 939 if (XSTRING_LENGTH (XCAR (tail)) > max)
+ − 940 max = XSTRING_LENGTH (XCAR (tail));
+ − 941 }
+ − 942 }
+ − 943 else if (NILP (suffixes))
+ − 944 max = 0;
+ − 945 else
+ − 946 /* Just take the easy way out */
+ − 947 max = XSTRING_LENGTH (suffixes);
+ − 948
+ − 949 fn_len = XSTRING_LENGTH (filename);
+ − 950 fn = (char *) alloca (max + fn_len + 1);
+ − 951 memcpy (fn, (char *) XSTRING_DATA (filename), fn_len);
+ − 952
+ − 953 /* Loop over suffixes. */
+ − 954 if (!STRINGP (suffixes))
+ − 955 {
+ − 956 if (NILP (suffixes))
+ − 957 {
+ − 958 /* Case a) discussed in the comment above. */
+ − 959 fn[fn_len] = 0;
+ − 960 if ((*fun) (fn, arg))
+ − 961 return;
+ − 962 }
+ − 963 else
+ − 964 {
+ − 965 /* Case b) */
+ − 966 Lisp_Object tail;
+ − 967 LIST_LOOP (tail, suffixes)
+ − 968 {
+ − 969 memcpy (fn + fn_len, XSTRING_DATA (XCAR (tail)),
+ − 970 XSTRING_LENGTH (XCAR (tail)));
+ − 971 fn[fn_len + XSTRING_LENGTH (XCAR (tail))] = 0;
+ − 972 if ((*fun) (fn, arg))
+ − 973 return;
+ − 974 }
+ − 975 }
+ − 976 }
+ − 977 else
+ − 978 {
+ − 979 /* Case c) */
442
+ − 980 const char *nsuffix = (const char *) XSTRING_DATA (suffixes);
428
+ − 981
+ − 982 while (1)
+ − 983 {
+ − 984 char *esuffix = (char *) strchr (nsuffix, ':');
442
+ − 985 int lsuffix = esuffix ? esuffix - nsuffix : strlen (nsuffix);
428
+ − 986
+ − 987 /* Concatenate path element/specified name with the suffix. */
+ − 988 strncpy (fn + fn_len, nsuffix, lsuffix);
+ − 989 fn[fn_len + lsuffix] = 0;
+ − 990
+ − 991 if ((*fun) (fn, arg))
+ − 992 return;
+ − 993
+ − 994 /* Advance to next suffix. */
+ − 995 if (esuffix == 0)
+ − 996 break;
+ − 997 nsuffix += lsuffix + 1;
+ − 998 }
+ − 999 }
+ − 1000 }
+ − 1001
+ − 1002 struct locate_file_in_directory_mapper_closure {
+ − 1003 int fd;
+ − 1004 Lisp_Object *storeptr;
+ − 1005 int mode;
+ − 1006 };
+ − 1007
+ − 1008 static int
+ − 1009 locate_file_in_directory_mapper (char *fn, void *arg)
+ − 1010 {
+ − 1011 struct locate_file_in_directory_mapper_closure *closure =
+ − 1012 (struct locate_file_in_directory_mapper_closure *)arg;
+ − 1013 struct stat st;
+ − 1014
+ − 1015 /* Ignore file if it's a directory. */
442
+ − 1016 if (xemacs_stat (fn, &st) >= 0
428
+ − 1017 && (st.st_mode & S_IFMT) != S_IFDIR)
+ − 1018 {
+ − 1019 /* Check that we can access or open it. */
+ − 1020 if (closure->mode >= 0)
+ − 1021 closure->fd = access (fn, closure->mode);
+ − 1022 else
+ − 1023 closure->fd = open (fn, O_RDONLY | OPEN_BINARY, 0);
+ − 1024
+ − 1025 if (closure->fd >= 0)
+ − 1026 {
+ − 1027 /* We succeeded; return this descriptor and filename. */
+ − 1028 if (closure->storeptr)
+ − 1029 *closure->storeptr = build_string (fn);
+ − 1030
442
+ − 1031 #ifndef WIN32_NATIVE
428
+ − 1032 /* If we actually opened the file, set close-on-exec flag
+ − 1033 on the new descriptor so that subprocesses can't whack
+ − 1034 at it. */
+ − 1035 if (closure->mode < 0)
+ − 1036 (void) fcntl (closure->fd, F_SETFD, FD_CLOEXEC);
+ − 1037 #endif
+ − 1038
+ − 1039 return 1;
+ − 1040 }
+ − 1041 }
+ − 1042 /* Keep mapping. */
+ − 1043 return 0;
+ − 1044 }
+ − 1045
+ − 1046
+ − 1047 /* look for STR in PATH, optionally adding SUFFIXES. DIRECTORY need
+ − 1048 not have been expanded. */
+ − 1049
+ − 1050 static int
+ − 1051 locate_file_in_directory (Lisp_Object directory, Lisp_Object str,
+ − 1052 Lisp_Object suffixes, Lisp_Object *storeptr,
+ − 1053 int mode)
+ − 1054 {
+ − 1055 /* This function can GC */
+ − 1056 struct locate_file_in_directory_mapper_closure closure;
+ − 1057 Lisp_Object filename = Qnil;
+ − 1058 struct gcpro gcpro1, gcpro2, gcpro3;
+ − 1059
+ − 1060 GCPRO3 (directory, str, filename);
+ − 1061
+ − 1062 filename = Fexpand_file_name (str, directory);
+ − 1063 if (NILP (filename) || NILP (Ffile_name_absolute_p (filename)))
+ − 1064 /* If there are non-absolute elts in PATH (eg ".") */
+ − 1065 /* Of course, this could conceivably lose if luser sets
+ − 1066 default-directory to be something non-absolute ... */
+ − 1067 {
+ − 1068 if (NILP (filename))
+ − 1069 /* NIL means current directory */
+ − 1070 filename = current_buffer->directory;
+ − 1071 else
+ − 1072 filename = Fexpand_file_name (filename,
+ − 1073 current_buffer->directory);
+ − 1074 if (NILP (Ffile_name_absolute_p (filename)))
+ − 1075 {
+ − 1076 /* Give up on this directory! */
+ − 1077 UNGCPRO;
+ − 1078 return -1;
+ − 1079 }
+ − 1080 }
+ − 1081
+ − 1082 closure.fd = -1;
+ − 1083 closure.storeptr = storeptr;
+ − 1084 closure.mode = mode;
+ − 1085
+ − 1086 locate_file_map_suffixes (filename, suffixes, locate_file_in_directory_mapper,
+ − 1087 &closure);
+ − 1088
+ − 1089 UNGCPRO;
+ − 1090 return closure.fd;
+ − 1091 }
+ − 1092
+ − 1093 /* do the same as locate_file() but don't use any hash tables. */
+ − 1094
+ − 1095 static int
+ − 1096 locate_file_without_hash (Lisp_Object path, Lisp_Object str,
+ − 1097 Lisp_Object suffixes, Lisp_Object *storeptr,
+ − 1098 int mode)
+ − 1099 {
+ − 1100 /* This function can GC */
+ − 1101 int absolute = !NILP (Ffile_name_absolute_p (str));
+ − 1102
+ − 1103 EXTERNAL_LIST_LOOP (path, path)
+ − 1104 {
+ − 1105 int val = locate_file_in_directory (XCAR (path), str, suffixes, storeptr,
+ − 1106 mode);
+ − 1107 if (val >= 0)
+ − 1108 return val;
+ − 1109 if (absolute)
+ − 1110 break;
+ − 1111 }
+ − 1112 return -1;
+ − 1113 }
+ − 1114
+ − 1115 static int
+ − 1116 locate_file_construct_suffixed_files_mapper (char *fn, void *arg)
+ − 1117 {
+ − 1118 Lisp_Object *tail = (Lisp_Object *)arg;
+ − 1119 *tail = Fcons (build_string (fn), *tail);
+ − 1120 return 0;
+ − 1121 }
+ − 1122
+ − 1123 /* Construct a list of all files to search for.
+ − 1124 It makes sense to have this despite locate_file_map_suffixes()
+ − 1125 because we need Lisp strings to access the hash-table, and it would
+ − 1126 be inefficient to create them on the fly, again and again for each
+ − 1127 path component. See locate_file(). */
+ − 1128
+ − 1129 static Lisp_Object
+ − 1130 locate_file_construct_suffixed_files (Lisp_Object filename,
+ − 1131 Lisp_Object suffixes)
+ − 1132 {
+ − 1133 Lisp_Object tail = Qnil;
+ − 1134 struct gcpro gcpro1;
+ − 1135 GCPRO1 (tail);
+ − 1136
+ − 1137 locate_file_map_suffixes (filename, suffixes,
+ − 1138 locate_file_construct_suffixed_files_mapper,
+ − 1139 &tail);
+ − 1140
+ − 1141 UNGCPRO;
+ − 1142 return Fnreverse (tail);
+ − 1143 }
+ − 1144
+ − 1145 DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
+ − 1146 Clear the hash records for the specified list of directories.
+ − 1147 `locate-file' uses a hashing scheme to speed lookup, and will correctly
+ − 1148 track the following environmental changes:
+ − 1149
+ − 1150 -- changes of any sort to the list of directories to be searched.
+ − 1151 -- addition and deletion of non-shadowing files (see below) from the
+ − 1152 directories in the list.
+ − 1153 -- byte-compilation of a .el file into a .elc file.
+ − 1154
+ − 1155 `locate-file' will primarily get confused if you add a file that shadows
+ − 1156 \(i.e. has the same name as) another file further down in the directory list.
+ − 1157 In this case, you must call `locate-file-clear-hashing'.
+ − 1158
+ − 1159 If PATH is t, it means to fully clear all the accumulated hashes. This
+ − 1160 can be used if the internal tables grow too large, or when dumping.
+ − 1161 */
+ − 1162 (path))
+ − 1163 {
+ − 1164 if (EQ (path, Qt))
+ − 1165 Fclrhash (Vlocate_file_hash_table);
+ − 1166 else
+ − 1167 {
+ − 1168 Lisp_Object pathtail;
+ − 1169 EXTERNAL_LIST_LOOP (pathtail, path)
+ − 1170 {
+ − 1171 Lisp_Object pathel = Fexpand_file_name (XCAR (pathtail), Qnil);
+ − 1172 Fremhash (pathel, Vlocate_file_hash_table);
+ − 1173 }
+ − 1174 }
+ − 1175 return Qnil;
+ − 1176 }
+ − 1177
+ − 1178 /* Search for a file whose name is STR, looking in directories
+ − 1179 in the Lisp list PATH, and trying suffixes from SUFFIXES.
+ − 1180 SUFFIXES is a list of possible suffixes, or (for backward
+ − 1181 compatibility) a string containing possible suffixes separated by
+ − 1182 colons.
+ − 1183 On success, returns a file descriptor. On failure, returns -1.
+ − 1184
+ − 1185 MODE nonnegative means don't open the files,
+ − 1186 just look for one for which access(file,MODE) succeeds. In this case,
+ − 1187 returns 1 on success.
+ − 1188
+ − 1189 If STOREPTR is nonzero, it points to a slot where the name of
+ − 1190 the file actually found should be stored as a Lisp string.
+ − 1191 Nil is stored there on failure.
+ − 1192
+ − 1193 Called openp() in FSFmacs. */
+ − 1194
+ − 1195 int
+ − 1196 locate_file (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
+ − 1197 Lisp_Object *storeptr, int mode)
+ − 1198 {
+ − 1199 /* This function can GC */
+ − 1200 Lisp_Object suffixtab = Qnil;
+ − 1201 Lisp_Object pathtail, pathel_expanded;
+ − 1202 int val;
+ − 1203 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ − 1204
+ − 1205 if (storeptr)
+ − 1206 *storeptr = Qnil;
+ − 1207
+ − 1208 /* Is it really necessary to gcpro path and str? It shouldn't be
+ − 1209 unless some caller has fucked up. There are known instances that
+ − 1210 call us with build_string("foo:bar") as SUFFIXES, though. */
+ − 1211 GCPRO4 (path, str, suffixes, suffixtab);
+ − 1212
+ − 1213 /* if this filename has directory components, it's too complicated
+ − 1214 to try and use the hash tables. */
+ − 1215 if (!NILP (Ffile_name_directory (str)))
+ − 1216 {
+ − 1217 val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
+ − 1218 UNGCPRO;
+ − 1219 return val;
+ − 1220 }
+ − 1221
+ − 1222 suffixtab = locate_file_construct_suffixed_files (str, suffixes);
+ − 1223
+ − 1224 EXTERNAL_LIST_LOOP (pathtail, path)
+ − 1225 {
+ − 1226 Lisp_Object pathel = XCAR (pathtail);
+ − 1227 Lisp_Object hash_table;
+ − 1228 Lisp_Object tail;
+ − 1229 int found = 0;
+ − 1230
+ − 1231 /* If this path element is relative, we have to look by hand. */
442
+ − 1232 if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)))
428
+ − 1233 {
+ − 1234 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
+ − 1235 mode);
+ − 1236 if (val >= 0)
+ − 1237 {
+ − 1238 UNGCPRO;
+ − 1239 return val;
+ − 1240 }
+ − 1241 continue;
+ − 1242 }
+ − 1243
+ − 1244 pathel_expanded = Fexpand_file_name (pathel, Qnil);
+ − 1245 hash_table = locate_file_find_directory_hash_table (pathel_expanded);
+ − 1246
+ − 1247 if (!NILP (hash_table))
+ − 1248 {
+ − 1249 /* Loop over suffixes. */
+ − 1250 LIST_LOOP (tail, suffixtab)
+ − 1251 if (!NILP (Fgethash (XCAR (tail), hash_table, Qnil)))
+ − 1252 {
+ − 1253 found = 1;
+ − 1254 break;
+ − 1255 }
+ − 1256 }
+ − 1257
+ − 1258 if (found)
+ − 1259 {
+ − 1260 /* This is a likely candidate. Look by hand in this directory
+ − 1261 so we don't get thrown off if someone byte-compiles a file. */
+ − 1262 val = locate_file_in_directory (pathel, str, suffixes, storeptr,
+ − 1263 mode);
+ − 1264 if (val >= 0)
+ − 1265 {
+ − 1266 UNGCPRO;
+ − 1267 return val;
+ − 1268 }
+ − 1269
+ − 1270 /* Hmm ... the file isn't actually there. (Or possibly it's
+ − 1271 a directory ...) So refresh our hashing. */
+ − 1272 locate_file_refresh_hashing (pathel_expanded);
+ − 1273 }
+ − 1274 }
+ − 1275
+ − 1276 /* File is probably not there, but check the hard way just in case. */
+ − 1277 val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
+ − 1278 if (val >= 0)
+ − 1279 {
+ − 1280 /* Sneaky user added a file without telling us. */
+ − 1281 Flocate_file_clear_hashing (path);
+ − 1282 }
+ − 1283
+ − 1284 UNGCPRO;
+ − 1285 return val;
+ − 1286 }
+ − 1287
+ − 1288
+ − 1289 #ifdef LOADHIST
+ − 1290
+ − 1291 /* Merge the list we've accumulated of globals from the current input source
+ − 1292 into the load_history variable. The details depend on whether
+ − 1293 the source has an associated file name or not. */
+ − 1294
+ − 1295 static void
+ − 1296 build_load_history (int loading, Lisp_Object source)
+ − 1297 {
+ − 1298 REGISTER Lisp_Object tail, prev, newelt;
+ − 1299 REGISTER Lisp_Object tem, tem2;
+ − 1300 int foundit;
+ − 1301
+ − 1302 #if !defined(LOADHIST_DUMPED)
+ − 1303 /* Don't bother recording anything for preloaded files. */
+ − 1304 if (purify_flag)
+ − 1305 return;
+ − 1306 #endif
+ − 1307
+ − 1308 tail = Vload_history;
+ − 1309 prev = Qnil;
+ − 1310 foundit = 0;
+ − 1311 while (!NILP (tail))
+ − 1312 {
+ − 1313 tem = Fcar (tail);
+ − 1314
+ − 1315 /* Find the feature's previous assoc list... */
+ − 1316 if (internal_equal (source, Fcar (tem), 0))
+ − 1317 {
+ − 1318 foundit = 1;
+ − 1319
+ − 1320 /* If we're loading, remove it. */
+ − 1321 if (loading)
+ − 1322 {
+ − 1323 if (NILP (prev))
+ − 1324 Vload_history = Fcdr (tail);
+ − 1325 else
+ − 1326 Fsetcdr (prev, Fcdr (tail));
+ − 1327 }
+ − 1328
+ − 1329 /* Otherwise, cons on new symbols that are not already members. */
+ − 1330 else
+ − 1331 {
+ − 1332 tem2 = Vcurrent_load_list;
+ − 1333
+ − 1334 while (CONSP (tem2))
+ − 1335 {
+ − 1336 newelt = XCAR (tem2);
+ − 1337
+ − 1338 if (NILP (Fmemq (newelt, tem)))
+ − 1339 Fsetcar (tail, Fcons (Fcar (tem),
+ − 1340 Fcons (newelt, Fcdr (tem))));
+ − 1341
+ − 1342 tem2 = XCDR (tem2);
+ − 1343 QUIT;
+ − 1344 }
+ − 1345 }
+ − 1346 }
+ − 1347 else
+ − 1348 prev = tail;
+ − 1349 tail = Fcdr (tail);
+ − 1350 QUIT;
+ − 1351 }
+ − 1352
+ − 1353 /* If we're loading, cons the new assoc onto the front of load-history,
+ − 1354 the most-recently-loaded position. Also do this if we didn't find
+ − 1355 an existing member for the current source. */
+ − 1356 if (loading || !foundit)
+ − 1357 Vload_history = Fcons (Fnreverse (Vcurrent_load_list),
+ − 1358 Vload_history);
+ − 1359 }
+ − 1360
+ − 1361 #else /* !LOADHIST */
+ − 1362 #define build_load_history(x,y)
+ − 1363 #endif /* !LOADHIST */
+ − 1364
+ − 1365
+ − 1366 #if 0 /* FSFmacs defun hack */
+ − 1367 Lisp_Object
+ − 1368 unreadpure (void) /* Used as unwind-protect function in readevalloop */
+ − 1369 {
+ − 1370 read_pure = 0;
+ − 1371 return Qnil;
+ − 1372 }
+ − 1373 #endif /* 0 */
+ − 1374
+ − 1375 static void
+ − 1376 readevalloop (Lisp_Object readcharfun,
+ − 1377 Lisp_Object sourcename,
+ − 1378 Lisp_Object (*evalfun) (Lisp_Object),
+ − 1379 int printflag)
+ − 1380 {
+ − 1381 /* This function can GC */
+ − 1382 REGISTER Emchar c;
+ − 1383 REGISTER Lisp_Object val = Qnil;
+ − 1384 int speccount = specpdl_depth ();
+ − 1385 struct gcpro gcpro1, gcpro2;
+ − 1386 struct buffer *b = 0;
+ − 1387
+ − 1388 if (BUFFERP (readcharfun))
+ − 1389 b = XBUFFER (readcharfun);
+ − 1390 else if (MARKERP (readcharfun))
+ − 1391 b = XMARKER (readcharfun)->buffer;
+ − 1392
+ − 1393 /* Don't do this. It is not necessary, and it needlessly exposes
+ − 1394 READCHARFUN (which can be a stream) to Lisp. --hniksic */
+ − 1395 /*specbind (Qstandard_input, readcharfun);*/
+ − 1396
+ − 1397 specbind (Qcurrent_load_list, Qnil);
+ − 1398
+ − 1399 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ − 1400 Vcurrent_compiled_function_annotation = Qnil;
+ − 1401 #endif
+ − 1402 GCPRO2 (val, sourcename);
+ − 1403
+ − 1404 LOADHIST_ATTACH (sourcename);
+ − 1405
+ − 1406 while (1)
+ − 1407 {
+ − 1408 QUIT;
+ − 1409
+ − 1410 if (b != 0 && !BUFFER_LIVE_P (b))
563
+ − 1411 invalid_operation ("Reading from killed buffer", Qunbound);
428
+ − 1412
+ − 1413 c = readchar (readcharfun);
+ − 1414 if (c == ';')
+ − 1415 {
+ − 1416 /* Skip comment */
+ − 1417 while ((c = readchar (readcharfun)) != '\n' && c != -1)
+ − 1418 QUIT;
+ − 1419 continue;
+ − 1420 }
+ − 1421 if (c < 0)
+ − 1422 break;
+ − 1423
+ − 1424 /* Ignore whitespace here, so we can detect eof. */
+ − 1425 if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r')
+ − 1426 continue;
+ − 1427
+ − 1428 #if 0 /* FSFmacs defun hack */
+ − 1429 if (purify_flag && c == '(')
+ − 1430 {
+ − 1431 int count1 = specpdl_depth ();
+ − 1432 record_unwind_protect (unreadpure, Qnil);
+ − 1433 val = read_list (readcharfun, ')', -1, 1);
+ − 1434 unbind_to (count1, Qnil);
+ − 1435 }
+ − 1436 else
+ − 1437 #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
+ − 1438 {
+ − 1439 unreadchar (readcharfun, c);
+ − 1440 Vread_objects = Qnil;
+ − 1441 if (NILP (Vload_read_function))
+ − 1442 val = read0 (readcharfun);
+ − 1443 else
+ − 1444 val = call1 (Vload_read_function, readcharfun);
+ − 1445 }
+ − 1446 #endif
+ − 1447 val = (*evalfun) (val);
+ − 1448 if (printflag)
+ − 1449 {
+ − 1450 Vvalues = Fcons (val, Vvalues);
+ − 1451 if (EQ (Vstandard_output, Qt))
+ − 1452 Fprin1 (val, Qnil);
+ − 1453 else
+ − 1454 Fprint (val, Qnil);
+ − 1455 }
+ − 1456 }
+ − 1457
+ − 1458 build_load_history (LSTREAMP (readcharfun) ||
+ − 1459 /* This looks weird, but it's what's in FSFmacs */
+ − 1460 (b ? BUF_NARROWED (b) : BUF_NARROWED (current_buffer)),
+ − 1461 sourcename);
+ − 1462 UNGCPRO;
+ − 1463
+ − 1464 unbind_to (speccount, Qnil);
+ − 1465 }
+ − 1466
+ − 1467 DEFUN ("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /*
+ − 1468 Execute BUFFER as Lisp code.
+ − 1469 Programs can pass two arguments, BUFFER and PRINTFLAG.
+ − 1470 BUFFER is the buffer to evaluate (nil means use current buffer).
+ − 1471 PRINTFLAG controls printing of output:
444
+ − 1472 nil means discard it; anything else is a stream for printing.
428
+ − 1473
+ − 1474 If there is no error, point does not move. If there is an error,
+ − 1475 point remains at the end of the last character read from the buffer.
+ − 1476 */
444
+ − 1477 (buffer, printflag))
428
+ − 1478 {
+ − 1479 /* This function can GC */
+ − 1480 int speccount = specpdl_depth ();
+ − 1481 Lisp_Object tem, buf;
+ − 1482
444
+ − 1483 if (NILP (buffer))
428
+ − 1484 buf = Fcurrent_buffer ();
+ − 1485 else
444
+ − 1486 buf = Fget_buffer (buffer);
428
+ − 1487 if (NILP (buf))
563
+ − 1488 invalid_argument ("No such buffer", Qunbound);
428
+ − 1489
+ − 1490 if (NILP (printflag))
+ − 1491 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
+ − 1492 else
+ − 1493 tem = printflag;
+ − 1494 specbind (Qstandard_output, tem);
+ − 1495 record_unwind_protect (save_excursion_restore, save_excursion_save ());
+ − 1496 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
+ − 1497 readevalloop (buf, XBUFFER (buf)->filename, Feval,
+ − 1498 !NILP (printflag));
+ − 1499
+ − 1500 return unbind_to (speccount, Qnil);
+ − 1501 }
+ − 1502
+ − 1503 #if 0
+ − 1504 xxDEFUN ("eval-current-buffer", Feval_current_buffer, 0, 1, "", /*
+ − 1505 Execute the current buffer as Lisp code.
+ − 1506 Programs can pass argument PRINTFLAG which controls printing of output:
+ − 1507 nil means discard it; anything else is stream for print.
+ − 1508
+ − 1509 If there is no error, point does not move. If there is an error,
+ − 1510 point remains at the end of the last character read from the buffer.
+ − 1511 */
+ − 1512 (printflag))
+ − 1513 {
+ − 1514 code omitted;
+ − 1515 }
+ − 1516 #endif /* 0 */
+ − 1517
+ − 1518 DEFUN ("eval-region", Feval_region, 2, 3, "r", /*
+ − 1519 Execute the region as Lisp code.
444
+ − 1520 When called from programs, expects two arguments START and END
428
+ − 1521 giving starting and ending indices in the current buffer
+ − 1522 of the text to be executed.
444
+ − 1523 Programs can pass third optional argument STREAM which controls output:
428
+ − 1524 nil means discard it; anything else is stream for printing it.
+ − 1525
+ − 1526 If there is no error, point does not move. If there is an error,
+ − 1527 point remains at the end of the last character read from the buffer.
+ − 1528
+ − 1529 Note: Before evaling the region, this function narrows the buffer to it.
+ − 1530 If the code being eval'd should happen to trigger a redisplay you may
+ − 1531 see some text temporarily disappear because of this.
+ − 1532 */
444
+ − 1533 (start, end, stream))
428
+ − 1534 {
+ − 1535 /* This function can GC */
+ − 1536 int speccount = specpdl_depth ();
+ − 1537 Lisp_Object tem;
+ − 1538 Lisp_Object cbuf = Fcurrent_buffer ();
+ − 1539
444
+ − 1540 if (NILP (stream))
428
+ − 1541 tem = Qsymbolp; /* #### #@[]*&$#*[& SI:NULL-STREAM */
+ − 1542 else
444
+ − 1543 tem = stream;
428
+ − 1544 specbind (Qstandard_output, tem);
+ − 1545
444
+ − 1546 if (NILP (stream))
428
+ − 1547 record_unwind_protect (save_excursion_restore, save_excursion_save ());
+ − 1548 record_unwind_protect (save_restriction_restore, save_restriction_save ());
+ − 1549
444
+ − 1550 /* This both uses start and checks its type. */
+ − 1551 Fgoto_char (start, cbuf);
+ − 1552 Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), end, cbuf);
428
+ − 1553 readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,
444
+ − 1554 !NILP (stream));
428
+ − 1555
+ − 1556 return unbind_to (speccount, Qnil);
+ − 1557 }
+ − 1558
+ − 1559 DEFUN ("read", Fread, 0, 1, 0, /*
+ − 1560 Read one Lisp expression as text from STREAM, return as Lisp object.
+ − 1561 If STREAM is nil, use the value of `standard-input' (which see).
+ − 1562 STREAM or the value of `standard-input' may be:
+ − 1563 a buffer (read from point and advance it)
+ − 1564 a marker (read from where it points and advance it)
+ − 1565 a function (call it with no arguments for each character,
+ − 1566 call it with a char as argument to push a char back)
+ − 1567 a string (takes text from string, starting at the beginning)
+ − 1568 t (read text line using minibuffer and use it).
+ − 1569 */
+ − 1570 (stream))
+ − 1571 {
+ − 1572 if (NILP (stream))
+ − 1573 stream = Vstandard_input;
+ − 1574 if (EQ (stream, Qt))
+ − 1575 stream = Qread_char;
+ − 1576
+ − 1577 Vread_objects = Qnil;
+ − 1578
+ − 1579 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ − 1580 Vcurrent_compiled_function_annotation = Qnil;
+ − 1581 #endif
+ − 1582 if (EQ (stream, Qread_char))
+ − 1583 {
+ − 1584 Lisp_Object val = call1 (Qread_from_minibuffer,
+ − 1585 build_translated_string ("Lisp expression: "));
+ − 1586 return Fcar (Fread_from_string (val, Qnil, Qnil));
+ − 1587 }
+ − 1588
+ − 1589 if (STRINGP (stream))
+ − 1590 return Fcar (Fread_from_string (stream, Qnil, Qnil));
+ − 1591
+ − 1592 return read0 (stream);
+ − 1593 }
+ − 1594
+ − 1595 DEFUN ("read-from-string", Fread_from_string, 1, 3, 0, /*
+ − 1596 Read one Lisp expression which is represented as text by STRING.
+ − 1597 Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
+ − 1598 START and END optionally delimit a substring of STRING from which to read;
+ − 1599 they default to 0 and (length STRING) respectively.
+ − 1600 */
+ − 1601 (string, start, end))
+ − 1602 {
+ − 1603 Bytecount startval, endval;
+ − 1604 Lisp_Object tem;
+ − 1605 Lisp_Object lispstream = Qnil;
+ − 1606 struct gcpro gcpro1;
+ − 1607
+ − 1608 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ − 1609 Vcurrent_compiled_function_annotation = Qnil;
+ − 1610 #endif
+ − 1611 GCPRO1 (lispstream);
+ − 1612 CHECK_STRING (string);
+ − 1613 get_string_range_byte (string, start, end, &startval, &endval,
+ − 1614 GB_HISTORICAL_STRING_BEHAVIOR);
+ − 1615 lispstream = make_lisp_string_input_stream (string, startval,
+ − 1616 endval - startval);
+ − 1617
+ − 1618 Vread_objects = Qnil;
+ − 1619
+ − 1620 tem = read0 (lispstream);
+ − 1621 /* Yeah, it's ugly. Gonna make something of it?
+ − 1622 At least our reader is reentrant ... */
+ − 1623 tem =
+ − 1624 (Fcons (tem, make_int
+ − 1625 (bytecount_to_charcount
+ − 1626 (XSTRING_DATA (string),
+ − 1627 startval + Lstream_byte_count (XLSTREAM (lispstream))))));
+ − 1628 Lstream_delete (XLSTREAM (lispstream));
+ − 1629 UNGCPRO;
+ − 1630 return tem;
+ − 1631 }
+ − 1632
+ − 1633
+ − 1634 #ifdef LISP_BACKQUOTES
+ − 1635
+ − 1636 static Lisp_Object
+ − 1637 backquote_unwind (Lisp_Object ptr)
+ − 1638 { /* used as unwind-protect function in read0() */
+ − 1639 int *counter = (int *) get_opaque_ptr (ptr);
+ − 1640 if (--*counter < 0)
+ − 1641 *counter = 0;
+ − 1642 free_opaque_ptr (ptr);
+ − 1643 return Qnil;
+ − 1644 }
+ − 1645
+ − 1646 #endif
+ − 1647
+ − 1648 /* Use this for recursive reads, in contexts where internal tokens
+ − 1649 are not allowed. See also read1(). */
+ − 1650 static Lisp_Object
+ − 1651 read0 (Lisp_Object readcharfun)
+ − 1652 {
+ − 1653 Lisp_Object val = read1 (readcharfun);
+ − 1654
+ − 1655 if (CONSP (val) && UNBOUNDP (XCAR (val)))
+ − 1656 {
+ − 1657 Emchar c = XCHAR (XCDR (val));
+ − 1658 free_cons (XCONS (val));
+ − 1659 return Fsignal (Qinvalid_read_syntax,
+ − 1660 list1 (Fchar_to_string (make_char (c))));
+ − 1661 }
+ − 1662
+ − 1663 return val;
+ − 1664 }
+ − 1665
+ − 1666 static Emchar
+ − 1667 read_escape (Lisp_Object readcharfun)
+ − 1668 {
+ − 1669 /* This function can GC */
+ − 1670 Emchar c = readchar (readcharfun);
+ − 1671
+ − 1672 if (c < 0)
563
+ − 1673 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
+ − 1674
+ − 1675 switch (c)
+ − 1676 {
+ − 1677 case 'a': return '\007';
+ − 1678 case 'b': return '\b';
+ − 1679 case 'd': return 0177;
+ − 1680 case 'e': return 033;
+ − 1681 case 'f': return '\f';
+ − 1682 case 'n': return '\n';
+ − 1683 case 'r': return '\r';
+ − 1684 case 't': return '\t';
+ − 1685 case 'v': return '\v';
+ − 1686 case '\n': return -1;
+ − 1687
+ − 1688 case 'M':
+ − 1689 c = readchar (readcharfun);
+ − 1690 if (c < 0)
563
+ − 1691 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
+ − 1692 if (c != '-')
563
+ − 1693 syntax_error ("Invalid escape character syntax", Qunbound);
428
+ − 1694 c = readchar (readcharfun);
+ − 1695 if (c < 0)
563
+ − 1696 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
+ − 1697 if (c == '\\')
+ − 1698 c = read_escape (readcharfun);
+ − 1699 return c | 0200;
+ − 1700
+ − 1701 /* Originally, FSF_KEYS provided a degree of FSF Emacs
+ − 1702 compatibility by defining character "modifiers" alt, super,
+ − 1703 hyper and shift to infest the characters (i.e. integers).
+ − 1704
+ − 1705 However, this doesn't cut it for XEmacs 20, which
+ − 1706 distinguishes characters from integers. Without Mule, ?\H-a
+ − 1707 simply returns ?a because every character is clipped into
+ − 1708 0-255. Under Mule it is much worse -- ?\H-a with FSF_KEYS
+ − 1709 produces an illegal character, and moves us to crash-land.
+ − 1710
+ − 1711 For these reasons, FSF_KEYS hack is useless and without hope
+ − 1712 of ever working under XEmacs 20. */
+ − 1713 #undef FSF_KEYS
+ − 1714
+ − 1715 #ifdef FSF_KEYS
+ − 1716 #define alt_modifier (0x040000)
+ − 1717 #define super_modifier (0x080000)
+ − 1718 #define hyper_modifier (0x100000)
+ − 1719 #define shift_modifier (0x200000)
+ − 1720 /* fsf uses a different modifiers for meta and control. Possibly
+ − 1721 byte_compiled code will still work fsfmacs, though... --Stig
+ − 1722
+ − 1723 #define ctl_modifier (0x400000)
+ − 1724 #define meta_modifier (0x800000)
+ − 1725 */
563
+ − 1726 #define FSF_LOSSAGE(mask) \
+ − 1727 if (fail_on_bucky_bit_character_escapes || \
+ − 1728 ((c = readchar (readcharfun)) != '-')) \
+ − 1729 syntax_error ("Invalid escape character syntax", Qunbound); \
+ − 1730 c = readchar (readcharfun); \
+ − 1731 if (c < 0) \
+ − 1732 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun)); \
+ − 1733 if (c == '\\') \
+ − 1734 c = read_escape (readcharfun); \
428
+ − 1735 return c | mask
+ − 1736
+ − 1737 case 'S': FSF_LOSSAGE (shift_modifier);
+ − 1738 case 'H': FSF_LOSSAGE (hyper_modifier);
+ − 1739 case 'A': FSF_LOSSAGE (alt_modifier);
+ − 1740 case 's': FSF_LOSSAGE (super_modifier);
+ − 1741 #undef alt_modifier
+ − 1742 #undef super_modifier
+ − 1743 #undef hyper_modifier
+ − 1744 #undef shift_modifier
+ − 1745 #undef FSF_LOSSAGE
+ − 1746
+ − 1747 #endif /* FSF_KEYS */
+ − 1748
+ − 1749 case 'C':
+ − 1750 c = readchar (readcharfun);
+ − 1751 if (c < 0)
563
+ − 1752 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
+ − 1753 if (c != '-')
563
+ − 1754 syntax_error ("Invalid escape character syntax", Qunbound);
428
+ − 1755 case '^':
+ − 1756 c = readchar (readcharfun);
+ − 1757 if (c < 0)
563
+ − 1758 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
+ − 1759 if (c == '\\')
+ − 1760 c = read_escape (readcharfun);
+ − 1761 /* FSFmacs junk for non-ASCII controls.
+ − 1762 Not used here. */
+ − 1763 if (c == '?')
+ − 1764 return 0177;
+ − 1765 else
+ − 1766 return c & (0200 | 037);
+ − 1767
+ − 1768 case '0':
+ − 1769 case '1':
+ − 1770 case '2':
+ − 1771 case '3':
+ − 1772 case '4':
+ − 1773 case '5':
+ − 1774 case '6':
+ − 1775 case '7':
+ − 1776 /* An octal escape, as in ANSI C. */
+ − 1777 {
+ − 1778 REGISTER Emchar i = c - '0';
+ − 1779 REGISTER int count = 0;
+ − 1780 while (++count < 3)
+ − 1781 {
+ − 1782 if ((c = readchar (readcharfun)) >= '0' && c <= '7')
+ − 1783 i = (i << 3) + (c - '0');
+ − 1784 else
+ − 1785 {
+ − 1786 unreadchar (readcharfun, c);
+ − 1787 break;
+ − 1788 }
+ − 1789 }
+ − 1790 return i;
+ − 1791 }
+ − 1792
+ − 1793 case 'x':
+ − 1794 /* A hex escape, as in ANSI C, except that we only allow latin-1
+ − 1795 characters to be read this way. What is "\x4e03" supposed to
+ − 1796 mean, anyways, if the internal representation is hidden?
+ − 1797 This is also consistent with the treatment of octal escapes. */
+ − 1798 {
+ − 1799 REGISTER Emchar i = 0;
+ − 1800 REGISTER int count = 0;
+ − 1801 while (++count <= 2)
+ − 1802 {
+ − 1803 c = readchar (readcharfun);
+ − 1804 /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
+ − 1805 if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
+ − 1806 else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
+ − 1807 else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
+ − 1808 else
+ − 1809 {
+ − 1810 unreadchar (readcharfun, c);
+ − 1811 break;
+ − 1812 }
+ − 1813 }
+ − 1814 return i;
+ − 1815 }
+ − 1816
+ − 1817 #ifdef MULE
+ − 1818 /* #### need some way of reading an extended character with
+ − 1819 an escape sequence. */
+ − 1820 #endif
+ − 1821
+ − 1822 default:
+ − 1823 return c;
+ − 1824 }
+ − 1825 }
+ − 1826
+ − 1827
+ − 1828
+ − 1829 /* read symbol-constituent stuff into `Vread_buffer_stream'. */
+ − 1830 static Bytecount
+ − 1831 read_atom_0 (Lisp_Object readcharfun, Emchar firstchar, int *saw_a_backslash)
+ − 1832 {
+ − 1833 /* This function can GC */
+ − 1834 Emchar c = ((firstchar) >= 0 ? firstchar : readchar (readcharfun));
+ − 1835 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
+ − 1836
+ − 1837 *saw_a_backslash = 0;
+ − 1838
+ − 1839 while (c > 040 /* #### - comma should be here as should backquote */
+ − 1840 && !(c == '\"' || c == '\'' || c == ';'
+ − 1841 || c == '(' || c == ')'
+ − 1842 #ifndef LISP_FLOAT_TYPE
+ − 1843 /* If we have floating-point support, then we need
+ − 1844 to allow <digits><dot><digits>. */
+ − 1845 || c =='.'
+ − 1846 #endif /* not LISP_FLOAT_TYPE */
+ − 1847 || c == '[' || c == ']' || c == '#'
+ − 1848 ))
+ − 1849 {
+ − 1850 if (c == '\\')
+ − 1851 {
+ − 1852 c = readchar (readcharfun);
+ − 1853 if (c < 0)
563
+ − 1854 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
+ − 1855 *saw_a_backslash = 1;
+ − 1856 }
+ − 1857 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
+ − 1858 QUIT;
+ − 1859 c = readchar (readcharfun);
+ − 1860 }
+ − 1861
+ − 1862 if (c >= 0)
+ − 1863 unreadchar (readcharfun, c);
+ − 1864 /* blasted terminating 0 */
+ − 1865 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), 0);
+ − 1866 Lstream_flush (XLSTREAM (Vread_buffer_stream));
+ − 1867
+ − 1868 return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
+ − 1869 }
+ − 1870
442
+ − 1871 static Lisp_Object parse_integer (const Bufbyte *buf, Bytecount len, int base);
428
+ − 1872
+ − 1873 static Lisp_Object
+ − 1874 read_atom (Lisp_Object readcharfun,
+ − 1875 Emchar firstchar,
+ − 1876 int uninterned_symbol)
+ − 1877 {
+ − 1878 /* This function can GC */
+ − 1879 int saw_a_backslash;
+ − 1880 Bytecount len = read_atom_0 (readcharfun, firstchar, &saw_a_backslash);
+ − 1881 char *read_ptr = (char *)
+ − 1882 resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream));
+ − 1883
+ − 1884 /* Is it an integer? */
+ − 1885 if (! (saw_a_backslash || uninterned_symbol))
+ − 1886 {
+ − 1887 /* If a token had any backslashes in it, it is disqualified from
+ − 1888 being an integer or a float. This means that 123\456 is a
+ − 1889 symbol, as is \123 (which is the way (intern "123") prints).
+ − 1890 Also, if token was preceded by #:, it's always a symbol.
+ − 1891 */
+ − 1892 char *p = read_ptr + len;
+ − 1893 char *p1 = read_ptr;
+ − 1894
+ − 1895 if (*p1 == '+' || *p1 == '-') p1++;
+ − 1896 if (p1 != p)
+ − 1897 {
+ − 1898 int c;
+ − 1899
+ − 1900 while (p1 != p && (c = *p1) >= '0' && c <= '9')
+ − 1901 p1++;
+ − 1902 #ifdef LISP_FLOAT_TYPE
+ − 1903 /* Integers can have trailing decimal points. */
+ − 1904 if (p1 > read_ptr && p1 < p && *p1 == '.')
+ − 1905 p1++;
+ − 1906 #endif
+ − 1907 if (p1 == p)
+ − 1908 {
+ − 1909 /* It is an integer. */
+ − 1910 #ifdef LISP_FLOAT_TYPE
+ − 1911 if (p1[-1] == '.')
+ − 1912 p1[-1] = '\0';
+ − 1913 #endif
+ − 1914 #if 0
+ − 1915 {
+ − 1916 int number = 0;
+ − 1917 if (sizeof (int) == sizeof (EMACS_INT))
+ − 1918 number = atoi (read_buffer);
+ − 1919 else if (sizeof (long) == sizeof (EMACS_INT))
+ − 1920 number = atol (read_buffer);
+ − 1921 else
+ − 1922 abort ();
+ − 1923 return make_int (number);
+ − 1924 }
+ − 1925 #else
+ − 1926 return parse_integer ((Bufbyte *) read_ptr, len, 10);
+ − 1927 #endif
+ − 1928 }
+ − 1929 }
+ − 1930 #ifdef LISP_FLOAT_TYPE
+ − 1931 if (isfloat_string (read_ptr))
+ − 1932 return make_float (atof (read_ptr));
+ − 1933 #endif
+ − 1934 }
+ − 1935
+ − 1936 {
+ − 1937 Lisp_Object sym;
+ − 1938 if (uninterned_symbol)
+ − 1939 sym = Fmake_symbol ( make_string ((Bufbyte *) read_ptr, len));
+ − 1940 else
+ − 1941 {
+ − 1942 Lisp_Object name = make_string ((Bufbyte *) read_ptr, len);
+ − 1943 sym = Fintern (name, Qnil);
+ − 1944 }
+ − 1945 return sym;
+ − 1946 }
+ − 1947 }
+ − 1948
+ − 1949
+ − 1950 static Lisp_Object
442
+ − 1951 parse_integer (const Bufbyte *buf, Bytecount len, int base)
428
+ − 1952 {
442
+ − 1953 const Bufbyte *lim = buf + len;
+ − 1954 const Bufbyte *p = buf;
428
+ − 1955 EMACS_UINT num = 0;
+ − 1956 int negativland = 0;
+ − 1957
+ − 1958 if (*p == '-')
+ − 1959 {
+ − 1960 negativland = 1;
+ − 1961 p++;
+ − 1962 }
+ − 1963 else if (*p == '+')
+ − 1964 {
+ − 1965 p++;
+ − 1966 }
+ − 1967
+ − 1968 if (p == lim)
+ − 1969 goto loser;
+ − 1970
+ − 1971 for (; (p < lim) && (*p != '\0'); p++)
+ − 1972 {
+ − 1973 int c = *p;
+ − 1974 EMACS_UINT onum;
+ − 1975
+ − 1976 if (isdigit (c))
+ − 1977 c = c - '0';
+ − 1978 else if (isupper (c))
+ − 1979 c = c - 'A' + 10;
+ − 1980 else if (islower (c))
+ − 1981 c = c - 'a' + 10;
+ − 1982 else
+ − 1983 goto loser;
+ − 1984
+ − 1985 if (c < 0 || c >= base)
+ − 1986 goto loser;
+ − 1987
+ − 1988 onum = num;
+ − 1989 num = num * base + c;
+ − 1990 if (num < onum)
+ − 1991 goto overflow;
+ − 1992 }
+ − 1993
+ − 1994 {
+ − 1995 EMACS_INT int_result = negativland ? - (EMACS_INT) num : (EMACS_INT) num;
+ − 1996 Lisp_Object result = make_int (int_result);
+ − 1997 if (num && ((XINT (result) < 0) != negativland))
+ − 1998 goto overflow;
+ − 1999 if (XINT (result) != int_result)
+ − 2000 goto overflow;
+ − 2001 return result;
+ − 2002 }
+ − 2003 overflow:
+ − 2004 return Fsignal (Qinvalid_read_syntax,
+ − 2005 list3 (build_translated_string
+ − 2006 ("Integer constant overflow in reader"),
+ − 2007 make_string (buf, len),
+ − 2008 make_int (base)));
+ − 2009 loser:
+ − 2010 return Fsignal (Qinvalid_read_syntax,
+ − 2011 list3 (build_translated_string
+ − 2012 ("Invalid integer constant in reader"),
+ − 2013 make_string (buf, len),
+ − 2014 make_int (base)));
+ − 2015 }
+ − 2016
+ − 2017
+ − 2018 static Lisp_Object
+ − 2019 read_integer (Lisp_Object readcharfun, int base)
+ − 2020 {
+ − 2021 /* This function can GC */
+ − 2022 int saw_a_backslash;
+ − 2023 Bytecount len = read_atom_0 (readcharfun, -1, &saw_a_backslash);
+ − 2024 return (parse_integer
+ − 2025 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
+ − 2026 ((saw_a_backslash)
+ − 2027 ? 0 /* make parse_integer signal error */
+ − 2028 : len),
+ − 2029 base));
+ − 2030 }
+ − 2031
+ − 2032 static Lisp_Object
+ − 2033 read_bit_vector (Lisp_Object readcharfun)
+ − 2034 {
+ − 2035 unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
440
+ − 2036 Lisp_Object val;
428
+ − 2037
+ − 2038 while (1)
+ − 2039 {
444
+ − 2040 unsigned char bit;
+ − 2041 Emchar c = readchar (readcharfun);
+ − 2042 if (c == '0')
+ − 2043 bit = 0;
+ − 2044 else if (c == '1')
+ − 2045 bit = 1;
+ − 2046 else
+ − 2047 {
+ − 2048 if (c >= 0)
+ − 2049 unreadchar (readcharfun, c);
+ − 2050 break;
+ − 2051 }
+ − 2052 Dynarr_add (dyn, bit);
428
+ − 2053 }
+ − 2054
440
+ − 2055 val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
+ − 2056 Dynarr_length (dyn));
+ − 2057 Dynarr_free (dyn);
+ − 2058
+ − 2059 return val;
428
+ − 2060 }
+ − 2061
+ − 2062
+ − 2063
+ − 2064 /* structures */
+ − 2065
+ − 2066 struct structure_type *
+ − 2067 define_structure_type (Lisp_Object type,
+ − 2068 int (*validate) (Lisp_Object data,
578
+ − 2069 Error_Behavior errb),
428
+ − 2070 Lisp_Object (*instantiate) (Lisp_Object data))
+ − 2071 {
+ − 2072 struct structure_type st;
+ − 2073
+ − 2074 st.type = type;
+ − 2075 st.keywords = Dynarr_new (structure_keyword_entry);
+ − 2076 st.validate = validate;
+ − 2077 st.instantiate = instantiate;
+ − 2078 Dynarr_add (the_structure_type_dynarr, st);
+ − 2079
+ − 2080 return Dynarr_atp (the_structure_type_dynarr,
+ − 2081 Dynarr_length (the_structure_type_dynarr) - 1);
+ − 2082 }
+ − 2083
+ − 2084 void
+ − 2085 define_structure_type_keyword (struct structure_type *st, Lisp_Object keyword,
+ − 2086 int (*validate) (Lisp_Object keyword,
+ − 2087 Lisp_Object value,
578
+ − 2088 Error_Behavior errb))
428
+ − 2089 {
+ − 2090 struct structure_keyword_entry en;
+ − 2091
+ − 2092 en.keyword = keyword;
+ − 2093 en.validate = validate;
+ − 2094 Dynarr_add (st->keywords, en);
+ − 2095 }
+ − 2096
+ − 2097 static struct structure_type *
+ − 2098 recognized_structure_type (Lisp_Object type)
+ − 2099 {
+ − 2100 int i;
+ − 2101
+ − 2102 for (i = 0; i < Dynarr_length (the_structure_type_dynarr); i++)
+ − 2103 {
+ − 2104 struct structure_type *st = Dynarr_atp (the_structure_type_dynarr, i);
+ − 2105 if (EQ (st->type, type))
+ − 2106 return st;
+ − 2107 }
+ − 2108
+ − 2109 return 0;
+ − 2110 }
+ − 2111
+ − 2112 static Lisp_Object
+ − 2113 read_structure (Lisp_Object readcharfun)
+ − 2114 {
+ − 2115 Emchar c = readchar (readcharfun);
+ − 2116 Lisp_Object list = Qnil;
+ − 2117 Lisp_Object orig_list = Qnil;
+ − 2118 Lisp_Object already_seen = Qnil;
+ − 2119 int keyword_count;
+ − 2120 struct structure_type *st;
+ − 2121 struct gcpro gcpro1, gcpro2;
+ − 2122
+ − 2123 GCPRO2 (orig_list, already_seen);
+ − 2124 if (c != '(')
442
+ − 2125 RETURN_UNGCPRO (continuable_read_syntax_error ("#s not followed by paren"));
428
+ − 2126 list = read_list (readcharfun, ')', 0, 0);
+ − 2127 orig_list = list;
+ − 2128 {
+ − 2129 int len = XINT (Flength (list));
+ − 2130 if (len == 0)
442
+ − 2131 RETURN_UNGCPRO (continuable_read_syntax_error
428
+ − 2132 ("structure type not specified"));
+ − 2133 if (!(len & 1))
+ − 2134 RETURN_UNGCPRO
442
+ − 2135 (continuable_read_syntax_error
428
+ − 2136 ("structures must have alternating keyword/value pairs"));
+ − 2137 }
+ − 2138
+ − 2139 st = recognized_structure_type (XCAR (list));
+ − 2140 if (!st)
+ − 2141 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
+ − 2142 list2 (build_translated_string
+ − 2143 ("unrecognized structure type"),
+ − 2144 XCAR (list))));
+ − 2145
+ − 2146 list = Fcdr (list);
+ − 2147 keyword_count = Dynarr_length (st->keywords);
+ − 2148 while (!NILP (list))
+ − 2149 {
+ − 2150 Lisp_Object keyword, value;
+ − 2151 int i;
+ − 2152 struct structure_keyword_entry *en = NULL;
+ − 2153
+ − 2154 keyword = Fcar (list);
+ − 2155 list = Fcdr (list);
+ − 2156 value = Fcar (list);
+ − 2157 list = Fcdr (list);
+ − 2158
+ − 2159 if (!NILP (memq_no_quit (keyword, already_seen)))
+ − 2160 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
+ − 2161 list2 (build_translated_string
+ − 2162 ("structure keyword already seen"),
+ − 2163 keyword)));
+ − 2164
+ − 2165 for (i = 0; i < keyword_count; i++)
+ − 2166 {
+ − 2167 en = Dynarr_atp (st->keywords, i);
+ − 2168 if (EQ (keyword, en->keyword))
+ − 2169 break;
+ − 2170 }
+ − 2171
+ − 2172 if (i == keyword_count)
+ − 2173 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
+ − 2174 list2 (build_translated_string
+ − 2175 ("unrecognized structure keyword"),
+ − 2176 keyword)));
+ − 2177
+ − 2178 if (en->validate && ! (en->validate) (keyword, value, ERROR_ME))
+ − 2179 RETURN_UNGCPRO
+ − 2180 (Fsignal (Qinvalid_read_syntax,
+ − 2181 list3 (build_translated_string
+ − 2182 ("invalid value for structure keyword"),
+ − 2183 keyword, value)));
+ − 2184
+ − 2185 already_seen = Fcons (keyword, already_seen);
+ − 2186 }
+ − 2187
+ − 2188 if (st->validate && ! (st->validate) (orig_list, ERROR_ME))
+ − 2189 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
+ − 2190 list2 (build_translated_string
+ − 2191 ("invalid structure initializer"),
+ − 2192 orig_list)));
+ − 2193
+ − 2194 RETURN_UNGCPRO ((st->instantiate) (XCDR (orig_list)));
+ − 2195 }
+ − 2196
+ − 2197
+ − 2198 static Lisp_Object read_compiled_function (Lisp_Object readcharfun,
+ − 2199 int terminator);
+ − 2200 static Lisp_Object read_vector (Lisp_Object readcharfun, int terminator);
+ − 2201
+ − 2202 /* Get the next character; filter out whitespace and comments */
+ − 2203
+ − 2204 static Emchar
+ − 2205 reader_nextchar (Lisp_Object readcharfun)
+ − 2206 {
+ − 2207 /* This function can GC */
+ − 2208 Emchar c;
+ − 2209
+ − 2210 retry:
+ − 2211 QUIT;
+ − 2212 c = readchar (readcharfun);
+ − 2213 if (c < 0)
563
+ − 2214 signal_error (Qend_of_file, 0, READCHARFUN_MAYBE (readcharfun));
428
+ − 2215
+ − 2216 switch (c)
+ − 2217 {
+ − 2218 default:
+ − 2219 {
+ − 2220 /* Ignore whitespace and control characters */
+ − 2221 if (c <= 040)
+ − 2222 goto retry;
+ − 2223 return c;
+ − 2224 }
+ − 2225
+ − 2226 case ';':
+ − 2227 {
+ − 2228 /* Comment */
+ − 2229 while ((c = readchar (readcharfun)) >= 0 && c != '\n')
+ − 2230 QUIT;
+ − 2231 goto retry;
+ − 2232 }
+ − 2233 }
+ − 2234 }
+ − 2235
+ − 2236 #if 0
+ − 2237 static Lisp_Object
+ − 2238 list2_pure (int pure, Lisp_Object a, Lisp_Object b)
+ − 2239 {
+ − 2240 return pure ? pure_cons (a, pure_cons (b, Qnil)) : list2 (a, b);
+ − 2241 }
+ − 2242 #endif
+ − 2243
+ − 2244 /* Read the next Lisp object from the stream READCHARFUN and return it.
+ − 2245 If the return value is a cons whose car is Qunbound, then read1()
+ − 2246 encountered a misplaced token (e.g. a right bracket, right paren,
+ − 2247 or dot followed by a non-number). To filter this stuff out,
+ − 2248 use read0(). */
+ − 2249
+ − 2250 static Lisp_Object
+ − 2251 read1 (Lisp_Object readcharfun)
+ − 2252 {
+ − 2253 Emchar c;
+ − 2254
+ − 2255 retry:
+ − 2256 c = reader_nextchar (readcharfun);
+ − 2257
+ − 2258 switch (c)
+ − 2259 {
+ − 2260 case '(':
+ − 2261 {
+ − 2262 #ifdef LISP_BACKQUOTES /* old backquote compatibility in lisp reader */
+ − 2263 /* if this is disabled, then other code in eval.c must be enabled */
+ − 2264 Emchar ch = reader_nextchar (readcharfun);
+ − 2265 switch (ch)
+ − 2266 {
+ − 2267 case '`':
+ − 2268 {
+ − 2269 Lisp_Object tem;
+ − 2270 int speccount = specpdl_depth ();
+ − 2271 ++old_backquote_flag;
+ − 2272 record_unwind_protect (backquote_unwind,
+ − 2273 make_opaque_ptr (&old_backquote_flag));
+ − 2274 tem = read0 (readcharfun);
+ − 2275 unbind_to (speccount, Qnil);
+ − 2276 ch = reader_nextchar (readcharfun);
+ − 2277 if (ch != ')')
+ − 2278 {
+ − 2279 unreadchar (readcharfun, ch);
+ − 2280 return Fsignal (Qinvalid_read_syntax,
+ − 2281 list1 (build_string
+ − 2282 ("Weird old-backquote syntax")));
+ − 2283 }
+ − 2284 return list2 (Qbacktick, tem);
+ − 2285 }
+ − 2286 case ',':
+ − 2287 {
+ − 2288 if (old_backquote_flag)
+ − 2289 {
+ − 2290 Lisp_Object tem, comma_type;
+ − 2291 ch = readchar (readcharfun);
+ − 2292 if (ch == '@')
+ − 2293 comma_type = Qcomma_at;
+ − 2294 else
+ − 2295 {
+ − 2296 if (ch >= 0)
+ − 2297 unreadchar (readcharfun, ch);
+ − 2298 comma_type = Qcomma;
+ − 2299 }
+ − 2300 tem = read0 (readcharfun);
+ − 2301 ch = reader_nextchar (readcharfun);
+ − 2302 if (ch != ')')
+ − 2303 {
+ − 2304 unreadchar (readcharfun, ch);
+ − 2305 return Fsignal (Qinvalid_read_syntax,
+ − 2306 list1 (build_string
+ − 2307 ("Weird old-backquote syntax")));
+ − 2308 }
+ − 2309 return list2 (comma_type, tem);
+ − 2310 }
+ − 2311 else
+ − 2312 {
+ − 2313 unreadchar (readcharfun, ch);
+ − 2314 #if 0
+ − 2315 return Fsignal (Qinvalid_read_syntax,
+ − 2316 list1 (build_string ("Comma outside of backquote")));
+ − 2317 #else
+ − 2318 /* #### - yuck....but this is reverse compatible. */
+ − 2319 /* mostly this is required by edebug, which does its own
+ − 2320 annotated reading. We need to have an annotated_read
+ − 2321 function that records (with markers) the buffer
+ − 2322 positions of the elements that make up lists, then that
+ − 2323 can be used in edebug and bytecomp and the check above
+ − 2324 can go back in. --Stig */
+ − 2325 break;
+ − 2326 #endif
+ − 2327 }
+ − 2328 }
+ − 2329 default:
+ − 2330 unreadchar (readcharfun, ch);
+ − 2331 } /* switch(ch) */
+ − 2332 #endif /* old backquote crap... */
+ − 2333 return read_list (readcharfun, ')', 1, 1);
+ − 2334 }
+ − 2335 case '[':
+ − 2336 return read_vector (readcharfun, ']');
+ − 2337
+ − 2338 case ')':
+ − 2339 case ']':
+ − 2340 /* #### - huh? these don't do what they seem... */
+ − 2341 return noseeum_cons (Qunbound, make_char (c));
+ − 2342 case '.':
+ − 2343 {
+ − 2344 #ifdef LISP_FLOAT_TYPE
+ − 2345 /* If a period is followed by a number, then we should read it
+ − 2346 as a floating point number. Otherwise, it denotes a dotted
+ − 2347 pair.
+ − 2348 */
+ − 2349 c = readchar (readcharfun);
+ − 2350 unreadchar (readcharfun, c);
+ − 2351
+ − 2352 /* Can't use isdigit on Emchars */
+ − 2353 if (c < '0' || c > '9')
+ − 2354 return noseeum_cons (Qunbound, make_char ('.'));
+ − 2355
+ − 2356 /* Note that read_atom will loop
+ − 2357 at least once, assuring that we will not try to UNREAD
+ − 2358 two characters in a row.
+ − 2359 (I think this doesn't matter anymore because there should
+ − 2360 be no more danger in unreading multiple characters) */
+ − 2361 return read_atom (readcharfun, '.', 0);
+ − 2362
+ − 2363 #else /* ! LISP_FLOAT_TYPE */
+ − 2364 return noseeum_cons (Qunbound, make_char ('.'));
+ − 2365 #endif /* ! LISP_FLOAT_TYPE */
+ − 2366 }
+ − 2367
+ − 2368 case '#':
+ − 2369 {
+ − 2370 c = readchar (readcharfun);
+ − 2371 switch (c)
+ − 2372 {
+ − 2373 #if 0 /* FSFmacs silly char-table syntax */
+ − 2374 case '^':
+ − 2375 #endif
+ − 2376 #if 0 /* FSFmacs silly bool-vector syntax */
+ − 2377 case '&':
+ − 2378 #endif
+ − 2379 /* "#["-- byte-code constant syntax */
+ − 2380 /* purecons #[...] syntax */
+ − 2381 case '[': return read_compiled_function (readcharfun, ']'
+ − 2382 /*, purify_flag */ );
+ − 2383 /* "#:"-- gensym syntax */
+ − 2384 case ':': return read_atom (readcharfun, -1, 1);
+ − 2385 /* #'x => (function x) */
+ − 2386 case '\'': return list2 (Qfunction, read0 (readcharfun));
+ − 2387 #if 0
+ − 2388 /* RMS uses this syntax for fat-strings.
+ − 2389 If we use it for vectors, then obscure bugs happen.
+ − 2390 */
+ − 2391 /* "#(" -- Scheme/CL vector syntax */
+ − 2392 case '(': return read_vector (readcharfun, ')');
+ − 2393 #endif
+ − 2394 #if 0 /* FSFmacs */
+ − 2395 case '(':
+ − 2396 {
+ − 2397 Lisp_Object tmp;
+ − 2398 struct gcpro gcpro1;
+ − 2399
+ − 2400 /* Read the string itself. */
+ − 2401 tmp = read1 (readcharfun);
+ − 2402 if (!STRINGP (tmp))
+ − 2403 {
+ − 2404 if (CONSP (tmp) && UNBOUNDP (XCAR (tmp)))
+ − 2405 free_cons (XCONS (tmp));
+ − 2406 return Fsignal (Qinvalid_read_syntax,
+ − 2407 list1 (build_string ("#")));
+ − 2408 }
+ − 2409 GCPRO1 (tmp);
+ − 2410 /* Read the intervals and their properties. */
+ − 2411 while (1)
+ − 2412 {
+ − 2413 Lisp_Object beg, end, plist;
+ − 2414 Emchar ch;
+ − 2415 int invalid = 0;
+ − 2416
+ − 2417 beg = read1 (readcharfun);
+ − 2418 if (CONSP (beg) && UNBOUNDP (XCAR (beg)))
+ − 2419 {
+ − 2420 ch = XCHAR (XCDR (beg));
+ − 2421 free_cons (XCONS (beg));
+ − 2422 if (ch == ')')
+ − 2423 break;
+ − 2424 else
+ − 2425 invalid = 1;
+ − 2426 }
+ − 2427 if (!invalid)
+ − 2428 {
+ − 2429 end = read1 (readcharfun);
+ − 2430 if (CONSP (end) && UNBOUNDP (XCAR (end)))
+ − 2431 {
+ − 2432 free_cons (XCONS (end));
+ − 2433 invalid = 1;
+ − 2434 }
+ − 2435 }
+ − 2436 if (!invalid)
+ − 2437 {
+ − 2438 plist = read1 (readcharfun);
+ − 2439 if (CONSP (plist) && UNBOUNDP (XCAR (plist)))
+ − 2440 {
+ − 2441 free_cons (XCONS (plist));
+ − 2442 invalid = 1;
+ − 2443 }
+ − 2444 }
+ − 2445 if (invalid)
+ − 2446 RETURN_UNGCPRO
+ − 2447 (Fsignal (Qinvalid_read_syntax,
+ − 2448 list2
+ − 2449 (build_string ("invalid string property list"),
+ − 2450 XCDR (plist))));
+ − 2451 Fset_text_properties (beg, end, plist, tmp);
+ − 2452 }
+ − 2453 UNGCPRO;
+ − 2454 return tmp;
+ − 2455 }
+ − 2456 #endif /* 0 */
+ − 2457 case '@':
+ − 2458 {
+ − 2459 /* #@NUMBER is used to skip NUMBER following characters.
+ − 2460 That's used in .elc files to skip over doc strings
+ − 2461 and function definitions. */
+ − 2462 int i, nskip = 0;
+ − 2463
+ − 2464 /* Read a decimal integer. */
+ − 2465 while ((c = readchar (readcharfun)) >= 0
+ − 2466 && c >= '0' && c <= '9')
+ − 2467 nskip = (10 * nskip) + (c - '0');
+ − 2468 if (c >= 0)
+ − 2469 unreadchar (readcharfun, c);
+ − 2470
+ − 2471 /* FSF has code here that maybe caches the skipped
+ − 2472 string. See above for why this is totally
+ − 2473 losing. We handle this differently. */
+ − 2474
+ − 2475 /* Skip that many characters. */
+ − 2476 for (i = 0; i < nskip && c >= 0; i++)
+ − 2477 c = readchar (readcharfun);
+ − 2478
+ − 2479 goto retry;
+ − 2480 }
+ − 2481 case '$': return Vload_file_name_internal;
+ − 2482 /* bit vectors */
+ − 2483 case '*': return read_bit_vector (readcharfun);
+ − 2484 /* #o10 => 8 -- octal constant syntax */
+ − 2485 case 'o': return read_integer (readcharfun, 8);
+ − 2486 /* #xdead => 57005 -- hex constant syntax */
+ − 2487 case 'x': return read_integer (readcharfun, 16);
+ − 2488 /* #b010 => 2 -- binary constant syntax */
+ − 2489 case 'b': return read_integer (readcharfun, 2);
+ − 2490 /* #s(foobar key1 val1 key2 val2) -- structure syntax */
+ − 2491 case 's': return read_structure (readcharfun);
+ − 2492 case '<':
+ − 2493 {
+ − 2494 unreadchar (readcharfun, c);
+ − 2495 return Fsignal (Qinvalid_read_syntax,
+ − 2496 list1 (build_string ("Cannot read unreadable object")));
+ − 2497 }
+ − 2498 #ifdef FEATUREP_SYNTAX
+ − 2499 case '+':
+ − 2500 case '-':
+ − 2501 {
456
+ − 2502 Lisp_Object feature_exp, obj, tem;
428
+ − 2503 struct gcpro gcpro1, gcpro2;
+ − 2504
456
+ − 2505 feature_exp = read0(readcharfun);
428
+ − 2506 obj = read0(readcharfun);
+ − 2507
+ − 2508 /* the call to `featurep' may GC. */
456
+ − 2509 GCPRO2 (feature_exp, obj);
+ − 2510 tem = call1 (Qfeaturep, feature_exp);
428
+ − 2511 UNGCPRO;
+ − 2512
+ − 2513 if (c == '+' && NILP(tem)) goto retry;
+ − 2514 if (c == '-' && !NILP(tem)) goto retry;
+ − 2515 return obj;
+ − 2516 }
+ − 2517 #endif
+ − 2518 case '0': case '1': case '2': case '3': case '4':
+ − 2519 case '5': case '6': case '7': case '8': case '9':
+ − 2520 /* Reader forms that can reuse previously read objects. */
+ − 2521 {
+ − 2522 int n = 0;
+ − 2523 Lisp_Object found;
+ − 2524
+ − 2525 /* Using read_integer() here is impossible, because it
+ − 2526 chokes on `='. Using parse_integer() is too hard.
+ − 2527 So we simply read it in, and ignore overflows, which
+ − 2528 is safe. */
+ − 2529 while (c >= '0' && c <= '9')
+ − 2530 {
+ − 2531 n *= 10;
+ − 2532 n += c - '0';
+ − 2533 c = readchar (readcharfun);
+ − 2534 }
+ − 2535 found = assq_no_quit (make_int (n), Vread_objects);
+ − 2536 if (c == '=')
+ − 2537 {
+ − 2538 /* #n=object returns object, but associates it with
+ − 2539 n for #n#. */
+ − 2540 Lisp_Object obj;
+ − 2541 if (CONSP (found))
+ − 2542 return Fsignal (Qinvalid_read_syntax,
+ − 2543 list2 (build_translated_string
+ − 2544 ("Multiply defined symbol label"),
+ − 2545 make_int (n)));
+ − 2546 obj = read0 (readcharfun);
+ − 2547 Vread_objects = Fcons (Fcons (make_int (n), obj),
+ − 2548 Vread_objects);
+ − 2549 return obj;
+ − 2550 }
+ − 2551 else if (c == '#')
+ − 2552 {
+ − 2553 /* #n# returns a previously read object. */
+ − 2554 if (CONSP (found))
+ − 2555 return XCDR (found);
+ − 2556 else
+ − 2557 return Fsignal (Qinvalid_read_syntax,
+ − 2558 list2 (build_translated_string
+ − 2559 ("Undefined symbol label"),
+ − 2560 make_int (n)));
+ − 2561 }
+ − 2562 return Fsignal (Qinvalid_read_syntax,
+ − 2563 list1 (build_string ("#")));
+ − 2564 }
+ − 2565 default:
+ − 2566 {
+ − 2567 unreadchar (readcharfun, c);
+ − 2568 return Fsignal (Qinvalid_read_syntax,
+ − 2569 list1 (build_string ("#")));
+ − 2570 }
+ − 2571 }
+ − 2572 }
+ − 2573
+ − 2574 /* Quote */
+ − 2575 case '\'': return list2 (Qquote, read0 (readcharfun));
+ − 2576
+ − 2577 #ifdef LISP_BACKQUOTES
+ − 2578 case '`':
+ − 2579 {
+ − 2580 Lisp_Object tem;
+ − 2581 int speccount = specpdl_depth ();
+ − 2582 ++new_backquote_flag;
+ − 2583 record_unwind_protect (backquote_unwind,
+ − 2584 make_opaque_ptr (&new_backquote_flag));
+ − 2585 tem = read0 (readcharfun);
+ − 2586 unbind_to (speccount, Qnil);
+ − 2587 return list2 (Qbackquote, tem);
+ − 2588 }
+ − 2589
+ − 2590 case ',':
+ − 2591 {
+ − 2592 if (new_backquote_flag)
+ − 2593 {
+ − 2594 Lisp_Object comma_type = Qnil;
+ − 2595 int ch = readchar (readcharfun);
+ − 2596
+ − 2597 if (ch == '@')
+ − 2598 comma_type = Qcomma_at;
+ − 2599 else if (ch == '.')
+ − 2600 comma_type = Qcomma_dot;
+ − 2601 else
+ − 2602 {
+ − 2603 if (ch >= 0)
+ − 2604 unreadchar (readcharfun, ch);
+ − 2605 comma_type = Qcomma;
+ − 2606 }
+ − 2607 return list2 (comma_type, read0 (readcharfun));
+ − 2608 }
+ − 2609 else
+ − 2610 {
+ − 2611 /* YUCK. 99.999% backwards compatibility. The Right
+ − 2612 Thing(tm) is to signal an error here, because it's
+ − 2613 really invalid read syntax. Instead, this permits
+ − 2614 commas to begin symbols (unless they're inside
+ − 2615 backquotes). If an error is signalled here in the
+ − 2616 future, then commas should be invalid read syntax
+ − 2617 outside of backquotes anywhere they're found (i.e.
+ − 2618 they must be quoted in symbols) -- Stig */
+ − 2619 return read_atom (readcharfun, c, 0);
+ − 2620 }
+ − 2621 }
+ − 2622 #endif
+ − 2623
+ − 2624 case '?':
+ − 2625 {
+ − 2626 /* Evil GNU Emacs "character" (ie integer) syntax */
+ − 2627 c = readchar (readcharfun);
+ − 2628 if (c < 0)
+ − 2629 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
+ − 2630
+ − 2631 if (c == '\\')
+ − 2632 c = read_escape (readcharfun);
+ − 2633 return make_char (c);
+ − 2634 }
+ − 2635
+ − 2636 case '\"':
+ − 2637 {
+ − 2638 /* String */
+ − 2639 #ifdef I18N3
+ − 2640 /* #### If the input stream is translating, then the string
+ − 2641 should be marked as translatable by setting its
+ − 2642 `string-translatable' property to t. .el and .elc files
+ − 2643 normally are translating input streams. See Fgettext()
+ − 2644 and print_internal(). */
+ − 2645 #endif
+ − 2646 int cancel = 0;
+ − 2647
+ − 2648 Lstream_rewind (XLSTREAM (Vread_buffer_stream));
+ − 2649 while ((c = readchar (readcharfun)) >= 0
+ − 2650 && c != '\"')
+ − 2651 {
+ − 2652 if (c == '\\')
+ − 2653 c = read_escape (readcharfun);
+ − 2654 /* c is -1 if \ newline has just been seen */
+ − 2655 if (c == -1)
+ − 2656 {
+ − 2657 if (Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) == 0)
+ − 2658 cancel = 1;
+ − 2659 }
+ − 2660 else
+ − 2661 Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), c);
+ − 2662 QUIT;
+ − 2663 }
+ − 2664 if (c < 0)
+ − 2665 return Fsignal (Qend_of_file, list1 (READCHARFUN_MAYBE (readcharfun)));
+ − 2666
+ − 2667 /* If purifying, and string starts with \ newline,
+ − 2668 return zero instead. This is for doc strings
+ − 2669 that we are really going to find in lib-src/DOC.nn.nn */
+ − 2670 if (purify_flag && NILP (Vinternal_doc_file_name) && cancel)
+ − 2671 return Qzero;
+ − 2672
+ − 2673 Lstream_flush (XLSTREAM (Vread_buffer_stream));
+ − 2674 return
+ − 2675 make_string
+ − 2676 (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
+ − 2677 Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
+ − 2678 }
+ − 2679
+ − 2680 default:
+ − 2681 {
+ − 2682 /* Ignore whitespace and control characters */
+ − 2683 if (c <= 040)
+ − 2684 goto retry;
+ − 2685 return read_atom (readcharfun, c, 0);
+ − 2686 }
+ − 2687 }
+ − 2688 }
+ − 2689
+ − 2690
+ − 2691
+ − 2692 #ifdef LISP_FLOAT_TYPE
+ − 2693
+ − 2694 #define LEAD_INT 1
+ − 2695 #define DOT_CHAR 2
+ − 2696 #define TRAIL_INT 4
+ − 2697 #define E_CHAR 8
+ − 2698 #define EXP_INT 16
+ − 2699
+ − 2700 int
442
+ − 2701 isfloat_string (const char *cp)
428
+ − 2702 {
+ − 2703 int state = 0;
442
+ − 2704 const Bufbyte *ucp = (const Bufbyte *) cp;
428
+ − 2705
+ − 2706 if (*ucp == '+' || *ucp == '-')
+ − 2707 ucp++;
+ − 2708
+ − 2709 if (*ucp >= '0' && *ucp <= '9')
+ − 2710 {
+ − 2711 state |= LEAD_INT;
+ − 2712 while (*ucp >= '0' && *ucp <= '9')
+ − 2713 ucp++;
+ − 2714 }
+ − 2715 if (*ucp == '.')
+ − 2716 {
+ − 2717 state |= DOT_CHAR;
+ − 2718 ucp++;
+ − 2719 }
+ − 2720 if (*ucp >= '0' && *ucp <= '9')
+ − 2721 {
+ − 2722 state |= TRAIL_INT;
+ − 2723 while (*ucp >= '0' && *ucp <= '9')
+ − 2724 ucp++;
+ − 2725 }
+ − 2726 if (*ucp == 'e' || *ucp == 'E')
+ − 2727 {
+ − 2728 state |= E_CHAR;
+ − 2729 ucp++;
+ − 2730 if ((*ucp == '+') || (*ucp == '-'))
+ − 2731 ucp++;
+ − 2732 }
+ − 2733
+ − 2734 if (*ucp >= '0' && *ucp <= '9')
+ − 2735 {
+ − 2736 state |= EXP_INT;
+ − 2737 while (*ucp >= '0' && *ucp <= '9')
+ − 2738 ucp++;
+ − 2739 }
+ − 2740 return (((*ucp == 0) || (*ucp == ' ') || (*ucp == '\t') || (*ucp == '\n')
+ − 2741 || (*ucp == '\r') || (*ucp == '\f'))
+ − 2742 && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT)
+ − 2743 || state == (DOT_CHAR|TRAIL_INT)
+ − 2744 || state == (LEAD_INT|E_CHAR|EXP_INT)
+ − 2745 || state == (LEAD_INT|DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)
+ − 2746 || state == (DOT_CHAR|TRAIL_INT|E_CHAR|EXP_INT)));
+ − 2747 }
+ − 2748 #endif /* LISP_FLOAT_TYPE */
+ − 2749
+ − 2750 static void *
+ − 2751 sequence_reader (Lisp_Object readcharfun,
+ − 2752 Emchar terminator,
+ − 2753 void *state,
+ − 2754 void * (*conser) (Lisp_Object readcharfun,
+ − 2755 void *state, Charcount len))
+ − 2756 {
+ − 2757 Charcount len;
+ − 2758
+ − 2759 for (len = 0; ; len++)
+ − 2760 {
+ − 2761 Emchar ch;
+ − 2762
+ − 2763 QUIT;
+ − 2764 ch = reader_nextchar (readcharfun);
+ − 2765
+ − 2766 if (ch == terminator)
+ − 2767 return state;
+ − 2768 else
+ − 2769 unreadchar (readcharfun, ch);
+ − 2770 #ifdef FEATUREP_SYNTAX
+ − 2771 if (ch == ']')
442
+ − 2772 read_syntax_error ("\"]\" in a list");
428
+ − 2773 else if (ch == ')')
442
+ − 2774 read_syntax_error ("\")\" in a vector");
428
+ − 2775 #endif
+ − 2776 state = ((conser) (readcharfun, state, len));
+ − 2777 }
+ − 2778 }
+ − 2779
+ − 2780
+ − 2781 struct read_list_state
+ − 2782 {
+ − 2783 Lisp_Object head;
+ − 2784 Lisp_Object tail;
+ − 2785 int length;
+ − 2786 int allow_dotted_lists;
+ − 2787 Emchar terminator;
+ − 2788 };
+ − 2789
+ − 2790 static void *
+ − 2791 read_list_conser (Lisp_Object readcharfun, void *state, Charcount len)
+ − 2792 {
+ − 2793 struct read_list_state *s = (struct read_list_state *) state;
+ − 2794 Lisp_Object elt;
+ − 2795
+ − 2796 elt = read1 (readcharfun);
+ − 2797
+ − 2798 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
+ − 2799 {
+ − 2800 Lisp_Object tem = elt;
+ − 2801 Emchar ch;
+ − 2802
+ − 2803 elt = XCDR (elt);
+ − 2804 free_cons (XCONS (tem));
+ − 2805 tem = Qnil;
+ − 2806 ch = XCHAR (elt);
+ − 2807 #ifdef FEATUREP_SYNTAX
+ − 2808 if (ch == s->terminator) /* deal with #+, #- reader macros */
+ − 2809 {
+ − 2810 unreadchar (readcharfun, s->terminator);
+ − 2811 goto done;
+ − 2812 }
+ − 2813 else if (ch == ']')
442
+ − 2814 read_syntax_error ("']' in a list");
428
+ − 2815 else if (ch == ')')
442
+ − 2816 read_syntax_error ("')' in a vector");
428
+ − 2817 else
+ − 2818 #endif
+ − 2819 if (ch != '.')
563
+ − 2820 signal_error (Qinternal_error, "BUG! Internal reader error", elt);
428
+ − 2821 else if (!s->allow_dotted_lists)
442
+ − 2822 read_syntax_error ("\".\" in a vector");
428
+ − 2823 else
+ − 2824 {
+ − 2825 if (!NILP (s->tail))
+ − 2826 XCDR (s->tail) = read0 (readcharfun);
+ − 2827 else
+ − 2828 s->head = read0 (readcharfun);
+ − 2829 elt = read1 (readcharfun);
+ − 2830 if (CONSP (elt) && UNBOUNDP (XCAR (elt)))
+ − 2831 {
+ − 2832 ch = XCHAR (XCDR (elt));
+ − 2833 free_cons (XCONS (elt));
+ − 2834 if (ch == s->terminator)
+ − 2835 {
+ − 2836 unreadchar (readcharfun, s->terminator);
+ − 2837 goto done;
+ − 2838 }
+ − 2839 }
442
+ − 2840 read_syntax_error (". in wrong context");
428
+ − 2841 }
+ − 2842 }
+ − 2843
+ − 2844 #if 0 /* FSFmacs defun hack, or something ... */
+ − 2845 if (NILP (tail) && defun_hack && EQ (elt, Qdefun) && !read_pure)
+ − 2846 {
+ − 2847 record_unwind_protect (unreadpure, Qzero);
+ − 2848 read_pure = 1;
+ − 2849 }
+ − 2850 #endif
+ − 2851
+ − 2852 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ − 2853 if (s->length == 1 && s->allow_dotted_lists && EQ (XCAR (s->head), Qfset))
+ − 2854 {
+ − 2855 if (CONSP (elt) && EQ (XCAR (elt), Qquote) && CONSP (XCDR (elt)))
+ − 2856 Vcurrent_compiled_function_annotation = XCAR (XCDR (elt));
+ − 2857 else
+ − 2858 Vcurrent_compiled_function_annotation = elt;
+ − 2859 }
+ − 2860 #endif
+ − 2861
+ − 2862 elt = Fcons (elt, Qnil);
+ − 2863 if (!NILP (s->tail))
+ − 2864 XCDR (s->tail) = elt;
+ − 2865 else
+ − 2866 s->head = elt;
+ − 2867 s->tail = elt;
+ − 2868 done:
+ − 2869 s->length++;
+ − 2870 return s;
+ − 2871 }
+ − 2872
+ − 2873
+ − 2874 #if 0 /* FSFmacs defun hack */
+ − 2875 /* -1 for allow_dotted_lists means allow_dotted_lists and check
+ − 2876 for starting with defun and make structure pure. */
+ − 2877 #endif
+ − 2878
+ − 2879 static Lisp_Object
+ − 2880 read_list (Lisp_Object readcharfun,
+ − 2881 Emchar terminator,
+ − 2882 int allow_dotted_lists,
+ − 2883 int check_for_doc_references)
+ − 2884 {
+ − 2885 struct read_list_state s;
+ − 2886 struct gcpro gcpro1, gcpro2;
+ − 2887 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ − 2888 Lisp_Object old_compiled_function_annotation =
+ − 2889 Vcurrent_compiled_function_annotation;
+ − 2890 #endif
+ − 2891
+ − 2892 s.head = Qnil;
+ − 2893 s.tail = Qnil;
+ − 2894 s.length = 0;
+ − 2895 s.allow_dotted_lists = allow_dotted_lists;
+ − 2896 s.terminator = terminator;
+ − 2897 GCPRO2 (s.head, s.tail);
+ − 2898
+ − 2899 sequence_reader (readcharfun, terminator, &s, read_list_conser);
+ − 2900 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ − 2901 Vcurrent_compiled_function_annotation = old_compiled_function_annotation;
+ − 2902 #endif
+ − 2903
+ − 2904 if ((purify_flag || load_force_doc_strings) && check_for_doc_references)
+ − 2905 {
+ − 2906 /* check now for any doc string references and record them
+ − 2907 for later. */
+ − 2908 Lisp_Object tail;
+ − 2909
+ − 2910 /* We might be dealing with an imperfect list so don't
+ − 2911 use LIST_LOOP */
+ − 2912 for (tail = s.head; CONSP (tail); tail = XCDR (tail))
+ − 2913 {
+ − 2914 Lisp_Object holding_cons = Qnil;
+ − 2915
+ − 2916 {
+ − 2917 Lisp_Object elem = XCAR (tail);
+ − 2918 /* elem might be (#$ . INT) ... */
+ − 2919 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
+ − 2920 holding_cons = tail;
+ − 2921 /* or it might be (quote (#$ . INT)) i.e.
+ − 2922 (quote . ((#$ . INT) . nil)) in the case of
+ − 2923 `autoload' (autoload evaluates its arguments, while
+ − 2924 `defvar', `defun', etc. don't). */
+ − 2925 if (CONSP (elem) && EQ (XCAR (elem), Qquote)
+ − 2926 && CONSP (XCDR (elem)))
+ − 2927 {
+ − 2928 elem = XCAR (XCDR (elem));
+ − 2929 if (CONSP (elem) && EQ (XCAR (elem), Vload_file_name_internal))
+ − 2930 holding_cons = XCDR (XCAR (tail));
+ − 2931 }
+ − 2932 }
+ − 2933
+ − 2934 if (CONSP (holding_cons))
+ − 2935 {
+ − 2936 if (purify_flag)
+ − 2937 {
+ − 2938 if (NILP (Vinternal_doc_file_name))
+ − 2939 /* We have not yet called Snarf-documentation, so
+ − 2940 assume this file is described in the DOC file
+ − 2941 and Snarf-documentation will fill in the right
+ − 2942 value later. For now, replace the whole list
+ − 2943 with 0. */
+ − 2944 XCAR (holding_cons) = Qzero;
+ − 2945 else
+ − 2946 /* We have already called Snarf-documentation, so
+ − 2947 make a relative file name for this file, so it
+ − 2948 can be found properly in the installed Lisp
+ − 2949 directory. We don't use Fexpand_file_name
+ − 2950 because that would make the directory absolute
+ − 2951 now. */
+ − 2952 XCAR (XCAR (holding_cons)) =
+ − 2953 concat2 (build_string ("../lisp/"),
+ − 2954 Ffile_name_nondirectory
+ − 2955 (Vload_file_name_internal));
+ − 2956 }
+ − 2957 else
+ − 2958 /* Not pure. Just add to Vload_force_doc_string_list,
+ − 2959 and the string will be filled in properly in
+ − 2960 load_force_doc_string_unwind(). */
+ − 2961 Vload_force_doc_string_list =
+ − 2962 /* We pass the cons that holds the (#$ . INT) so we
+ − 2963 can modify it in-place. */
+ − 2964 Fcons (holding_cons, Vload_force_doc_string_list);
+ − 2965 }
+ − 2966 }
+ − 2967 }
+ − 2968
+ − 2969 UNGCPRO;
+ − 2970 return s.head;
+ − 2971 }
+ − 2972
+ − 2973 static Lisp_Object
+ − 2974 read_vector (Lisp_Object readcharfun,
+ − 2975 Emchar terminator)
+ − 2976 {
+ − 2977 Lisp_Object tem;
+ − 2978 Lisp_Object *p;
+ − 2979 int len;
+ − 2980 int i;
+ − 2981 struct read_list_state s;
+ − 2982 struct gcpro gcpro1, gcpro2;
+ − 2983
+ − 2984 s.head = Qnil;
+ − 2985 s.tail = Qnil;
+ − 2986 s.length = 0;
+ − 2987 s.allow_dotted_lists = 0;
+ − 2988 GCPRO2 (s.head, s.tail);
+ − 2989
+ − 2990 sequence_reader (readcharfun, terminator, &s, read_list_conser);
+ − 2991
+ − 2992 UNGCPRO;
+ − 2993 tem = s.head;
+ − 2994 len = XINT (Flength (tem));
+ − 2995
+ − 2996 #if 0 /* FSFmacs defun hack */
+ − 2997 if (read_pure)
+ − 2998 s.head = make_pure_vector (len, Qnil);
+ − 2999 else
+ − 3000 #endif
+ − 3001 s.head = make_vector (len, Qnil);
+ − 3002
+ − 3003 for (i = 0, p = &(XVECTOR_DATA (s.head)[0]);
+ − 3004 i < len;
+ − 3005 i++, p++)
+ − 3006 {
440
+ − 3007 Lisp_Cons *otem = XCONS (tem);
428
+ − 3008 tem = Fcar (tem);
+ − 3009 *p = tem;
+ − 3010 tem = otem->cdr;
+ − 3011 free_cons (otem);
+ − 3012 }
+ − 3013 return s.head;
+ − 3014 }
+ − 3015
+ − 3016 static Lisp_Object
+ − 3017 read_compiled_function (Lisp_Object readcharfun, Emchar terminator)
+ − 3018 {
+ − 3019 /* Accept compiled functions at read-time so that we don't
+ − 3020 have to build them at load-time. */
+ − 3021 Lisp_Object stuff;
+ − 3022 Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
+ − 3023 struct gcpro gcpro1;
+ − 3024 int len;
+ − 3025 int iii;
+ − 3026 int saw_a_doc_ref = 0;
+ − 3027
+ − 3028 /* Note: we tell read_list not to search for doc references
+ − 3029 because we need to handle the "doc reference" for the
+ − 3030 instructions and constants differently. */
+ − 3031 stuff = read_list (readcharfun, terminator, 0, 0);
+ − 3032 len = XINT (Flength (stuff));
+ − 3033 if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
+ − 3034 return
442
+ − 3035 continuable_read_syntax_error ("#[...] used with wrong number of elements");
428
+ − 3036
+ − 3037 for (iii = 0; CONSP (stuff); iii++)
+ − 3038 {
440
+ − 3039 Lisp_Cons *victim = XCONS (stuff);
428
+ − 3040 make_byte_code_args[iii] = Fcar (stuff);
+ − 3041 if ((purify_flag || load_force_doc_strings)
+ − 3042 && CONSP (make_byte_code_args[iii])
+ − 3043 && EQ (XCAR (make_byte_code_args[iii]), Vload_file_name_internal))
+ − 3044 {
+ − 3045 if (purify_flag && iii == COMPILED_DOC_STRING)
+ − 3046 {
+ − 3047 /* same as in read_list(). */
+ − 3048 if (NILP (Vinternal_doc_file_name))
+ − 3049 make_byte_code_args[iii] = Qzero;
+ − 3050 else
+ − 3051 XCAR (make_byte_code_args[iii]) =
+ − 3052 concat2 (build_string ("../lisp/"),
+ − 3053 Ffile_name_nondirectory
+ − 3054 (Vload_file_name_internal));
+ − 3055 }
+ − 3056 else
+ − 3057 saw_a_doc_ref = 1;
+ − 3058 }
+ − 3059 stuff = Fcdr (stuff);
+ − 3060 free_cons (victim);
+ − 3061 }
+ − 3062 GCPRO1 (make_byte_code_args[0]);
+ − 3063 gcpro1.nvars = len;
+ − 3064
+ − 3065 /* v18 or v19 bytecode file. Need to Ebolify. */
+ − 3066 if (load_byte_code_version < 20 && VECTORP (make_byte_code_args[2]))
+ − 3067 ebolify_bytecode_constants (make_byte_code_args[2]);
+ − 3068
+ − 3069 /* make-byte-code looks at purify_flag, which should have the same
+ − 3070 * value as our "read-pure" argument */
+ − 3071 stuff = Fmake_byte_code (len, make_byte_code_args);
+ − 3072 XCOMPILED_FUNCTION (stuff)->flags.ebolified = (load_byte_code_version < 20);
+ − 3073 if (saw_a_doc_ref)
+ − 3074 Vload_force_doc_string_list = Fcons (stuff, Vload_force_doc_string_list);
+ − 3075 UNGCPRO;
+ − 3076 return stuff;
+ − 3077 }
+ − 3078
+ − 3079
+ − 3080
+ − 3081 void
+ − 3082 init_lread (void)
+ − 3083 {
+ − 3084 Vvalues = Qnil;
+ − 3085
+ − 3086 load_in_progress = 0;
+ − 3087
+ − 3088 Vload_descriptor_list = Qnil;
+ − 3089
+ − 3090 /* kludge: locate-file does not work for a null load-path, even if
+ − 3091 the file name is absolute. */
+ − 3092
+ − 3093 Vload_path = Fcons (build_string (""), Qnil);
+ − 3094
+ − 3095 /* This used to get initialized in init_lread because all streams
+ − 3096 got closed when dumping occurs. This is no longer true --
+ − 3097 Vread_buffer_stream is a resizing output stream, and there is no
+ − 3098 reason to close it at dump-time.
+ − 3099
+ − 3100 Vread_buffer_stream is set to Qnil in vars_of_lread, and this
+ − 3101 will initialize it only once, at dump-time. */
+ − 3102 if (NILP (Vread_buffer_stream))
+ − 3103 Vread_buffer_stream = make_resizing_buffer_output_stream ();
+ − 3104
+ − 3105 Vload_force_doc_string_list = Qnil;
+ − 3106 }
+ − 3107
+ − 3108 void
+ − 3109 syms_of_lread (void)
+ − 3110 {
+ − 3111 DEFSUBR (Fread);
+ − 3112 DEFSUBR (Fread_from_string);
+ − 3113 DEFSUBR (Fload_internal);
+ − 3114 DEFSUBR (Flocate_file);
+ − 3115 DEFSUBR (Flocate_file_clear_hashing);
+ − 3116 DEFSUBR (Feval_buffer);
+ − 3117 DEFSUBR (Feval_region);
+ − 3118
563
+ − 3119 DEFSYMBOL (Qstandard_input);
+ − 3120 DEFSYMBOL (Qread_char);
+ − 3121 DEFSYMBOL (Qcurrent_load_list);
+ − 3122 DEFSYMBOL (Qload);
+ − 3123 DEFSYMBOL (Qload_file_name);
+ − 3124 DEFSYMBOL (Qfset);
428
+ − 3125
+ − 3126 #ifdef LISP_BACKQUOTES
563
+ − 3127 DEFSYMBOL (Qbackquote);
428
+ − 3128 defsymbol (&Qbacktick, "`");
+ − 3129 defsymbol (&Qcomma, ",");
+ − 3130 defsymbol (&Qcomma_at, ",@");
+ − 3131 defsymbol (&Qcomma_dot, ",.");
+ − 3132 #endif
+ − 3133
563
+ − 3134 DEFSYMBOL (Qexists);
+ − 3135 DEFSYMBOL (Qreadable);
+ − 3136 DEFSYMBOL (Qwritable);
+ − 3137 DEFSYMBOL (Qexecutable);
428
+ − 3138 }
+ − 3139
+ − 3140 void
+ − 3141 structure_type_create (void)
+ − 3142 {
+ − 3143 the_structure_type_dynarr = Dynarr_new (structure_type);
+ − 3144 }
+ − 3145
+ − 3146 void
+ − 3147 reinit_vars_of_lread (void)
+ − 3148 {
+ − 3149 Vread_buffer_stream = Qnil;
+ − 3150 staticpro_nodump (&Vread_buffer_stream);
+ − 3151 }
+ − 3152
+ − 3153 void
+ − 3154 vars_of_lread (void)
+ − 3155 {
+ − 3156 reinit_vars_of_lread ();
+ − 3157
+ − 3158 DEFVAR_LISP ("values", &Vvalues /*
+ − 3159 List of values of all expressions which were read, evaluated and printed.
+ − 3160 Order is reverse chronological.
+ − 3161 */ );
+ − 3162
+ − 3163 DEFVAR_LISP ("standard-input", &Vstandard_input /*
+ − 3164 Stream for read to get input from.
+ − 3165 See documentation of `read' for possible values.
+ − 3166 */ );
+ − 3167 Vstandard_input = Qt;
+ − 3168
+ − 3169 DEFVAR_LISP ("load-path", &Vload_path /*
+ − 3170 *List of directories to search for files to load.
+ − 3171 Each element is a string (directory name) or nil (try default directory).
+ − 3172
+ − 3173 Note that the elements of this list *may not* begin with "~", so you must
+ − 3174 call `expand-file-name' on them before adding them to this list.
+ − 3175
+ − 3176 Initialized based on EMACSLOADPATH environment variable, if any,
+ − 3177 otherwise to default specified in by file `paths.h' when XEmacs was built.
+ − 3178 If there were no paths specified in `paths.h', then XEmacs chooses a default
+ − 3179 value for this variable by looking around in the file-system near the
+ − 3180 directory in which the XEmacs executable resides.
+ − 3181 */ );
+ − 3182 Vload_path = Qnil;
+ − 3183
+ − 3184 /* xxxDEFVAR_LISP ("dump-load-path", &Vdump_load_path,
+ − 3185 "*Location of lisp files to be used when dumping ONLY."); */
+ − 3186
+ − 3187 DEFVAR_BOOL ("load-in-progress", &load_in_progress /*
+ − 3188 Non-nil iff inside of `load'.
+ − 3189 */ );
+ − 3190
+ − 3191 DEFVAR_LISP ("after-load-alist", &Vafter_load_alist /*
+ − 3192 An alist of expressions to be evalled when particular files are loaded.
+ − 3193 Each element looks like (FILENAME FORMS...).
+ − 3194 When `load' is run and the file-name argument is FILENAME,
+ − 3195 the FORMS in the corresponding element are executed at the end of loading.
+ − 3196
+ − 3197 FILENAME must match exactly! Normally FILENAME is the name of a library,
+ − 3198 with no directory specified, since that is how `load' is normally called.
+ − 3199 An error in FORMS does not undo the load,
+ − 3200 but does prevent execution of the rest of the FORMS.
+ − 3201 */ );
+ − 3202 Vafter_load_alist = Qnil;
+ − 3203
+ − 3204 DEFVAR_BOOL ("load-warn-when-source-newer", &load_warn_when_source_newer /*
+ − 3205 *Whether `load' should check whether the source is newer than the binary.
+ − 3206 If this variable is true, then when a `.elc' file is being loaded and the
+ − 3207 corresponding `.el' is newer, a warning message will be printed.
+ − 3208 */ );
+ − 3209 load_warn_when_source_newer = 0;
+ − 3210
+ − 3211 DEFVAR_BOOL ("load-warn-when-source-only", &load_warn_when_source_only /*
+ − 3212 *Whether `load' should warn when loading a `.el' file instead of an `.elc'.
+ − 3213 If this variable is true, then when `load' is called with a filename without
+ − 3214 an extension, and the `.elc' version doesn't exist but the `.el' version does,
+ − 3215 then a message will be printed. If an explicit extension is passed to `load',
+ − 3216 no warning will be printed.
+ − 3217 */ );
+ − 3218 load_warn_when_source_only = 0;
+ − 3219
+ − 3220 DEFVAR_BOOL ("load-ignore-elc-files", &load_ignore_elc_files /*
+ − 3221 *Whether `load' should ignore `.elc' files when a suffix is not given.
+ − 3222 This is normally used only to bootstrap the `.elc' files when building XEmacs.
+ − 3223 */ );
+ − 3224 load_ignore_elc_files = 0;
+ − 3225
+ − 3226 #ifdef LOADHIST
+ − 3227 DEFVAR_LISP ("load-history", &Vload_history /*
+ − 3228 Alist mapping source file names to symbols and features.
+ − 3229 Each alist element is a list that starts with a file name,
+ − 3230 except for one element (optional) that starts with nil and describes
+ − 3231 definitions evaluated from buffers not visiting files.
+ − 3232 The remaining elements of each list are symbols defined as functions
+ − 3233 or variables, and cons cells `(provide . FEATURE)' and `(require . FEATURE)'.
+ − 3234 */ );
+ − 3235 Vload_history = Qnil;
+ − 3236
+ − 3237 DEFVAR_LISP ("current-load-list", &Vcurrent_load_list /*
+ − 3238 Used for internal purposes by `load'.
+ − 3239 */ );
+ − 3240 Vcurrent_load_list = Qnil;
+ − 3241 #endif
+ − 3242
+ − 3243 DEFVAR_LISP ("load-file-name", &Vload_file_name /*
+ − 3244 Full name of file being loaded by `load'.
+ − 3245 */ );
+ − 3246 Vload_file_name = Qnil;
+ − 3247
+ − 3248 DEFVAR_LISP ("load-read-function", &Vload_read_function /*
+ − 3249 Function used by `load' and `eval-region' for reading expressions.
+ − 3250 The default is nil, which means use the function `read'.
+ − 3251 */ );
+ − 3252 Vload_read_function = Qnil;
+ − 3253
+ − 3254 DEFVAR_BOOL ("load-force-doc-strings", &load_force_doc_strings /*
+ − 3255 Non-nil means `load' should force-load all dynamic doc strings.
+ − 3256 This is useful when the file being loaded is a temporary copy.
+ − 3257 */ );
+ − 3258 load_force_doc_strings = 0;
+ − 3259
+ − 3260 /* See read_escape(). */
+ − 3261 #if 0
+ − 3262 /* Used to be named `puke-on-fsf-keys' */
+ − 3263 DEFVAR_BOOL ("fail-on-bucky-bit-character-escapes",
+ − 3264 &fail_on_bucky_bit_character_escapes /*
+ − 3265 Whether `read' should signal an error when it encounters unsupported
+ − 3266 character escape syntaxes or just read them incorrectly.
+ − 3267 */ );
+ − 3268 fail_on_bucky_bit_character_escapes = 0;
+ − 3269 #endif
+ − 3270
+ − 3271 /* This must be initialized in init_lread otherwise it may start out
+ − 3272 with values saved when the image is dumped. */
+ − 3273 staticpro (&Vload_descriptor_list);
+ − 3274
+ − 3275 /* Initialized in init_lread. */
+ − 3276 staticpro (&Vload_force_doc_string_list);
+ − 3277
+ − 3278 Vload_file_name_internal = Qnil;
+ − 3279 staticpro (&Vload_file_name_internal);
+ − 3280
+ − 3281 Vload_file_name_internal_the_purecopy = Qnil;
+ − 3282 staticpro (&Vload_file_name_internal_the_purecopy);
+ − 3283
+ − 3284 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
+ − 3285 Vcurrent_compiled_function_annotation = Qnil;
+ − 3286 staticpro (&Vcurrent_compiled_function_annotation);
+ − 3287 #endif
+ − 3288
+ − 3289 /* So that early-early stuff will work */
+ − 3290 Ffset (Qload, intern ("load-internal"));
+ − 3291
+ − 3292 #ifdef FEATUREP_SYNTAX
563
+ − 3293 DEFSYMBOL (Qfeaturep);
428
+ − 3294 Fprovide(intern("xemacs"));
+ − 3295 #ifdef INFODOCK
+ − 3296 Fprovide(intern("infodock"));
+ − 3297 #endif /* INFODOCK */
+ − 3298 #endif /* FEATUREP_SYNTAX */
+ − 3299
+ − 3300 #ifdef LISP_BACKQUOTES
+ − 3301 old_backquote_flag = new_backquote_flag = 0;
+ − 3302 #endif
+ − 3303
+ − 3304 #ifdef I18N3
+ − 3305 Vfile_domain = Qnil;
+ − 3306 #endif
+ − 3307
+ − 3308 Vread_objects = Qnil;
+ − 3309 staticpro (&Vread_objects);
+ − 3310
+ − 3311 Vlocate_file_hash_table = make_lisp_hash_table (200,
+ − 3312 HASH_TABLE_NON_WEAK,
+ − 3313 HASH_TABLE_EQUAL);
+ − 3314 staticpro (&Vlocate_file_hash_table);
+ − 3315 #ifdef DEBUG_XEMACS
+ − 3316 symbol_value (XSYMBOL (intern ("Vlocate-file-hash-table")))
+ − 3317 = Vlocate_file_hash_table;
+ − 3318 #endif
+ − 3319 }
