X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4773b8ca2017459333c099838aef1635c4e32fa6..0925c80cd3d8f9a973d699fc1dbdbe79cca62988:/src/lread.c diff --git a/src/lread.c b/src/lread.c index e4663e0eb8..bbe421c0eb 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1,6 +1,7 @@ /* Lisp parsing and input streams. - Copyright (C) 1985, 86, 87, 88, 89, 93, 94, 95, 97, 98, 99, 2000, 2001 - Free Software Foundation, Inc. + Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, + 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, + 2005 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -16,8 +17,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs; see the file COPYING. If not, write to -the Free Software Foundation, Inc., 59 Temple Place - Suite 330, -Boston, MA 02111-1307, USA. */ +the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +Boston, MA 02110-1301, USA. */ #include @@ -61,6 +62,9 @@ Boston, MA 02111-1307, USA. */ #include #endif /* HAVE_SETLOCALE */ +#ifdef HAVE_FCNTL_H +#include +#endif #ifndef O_RDONLY #define O_RDONLY 0 #endif @@ -82,11 +86,12 @@ Lisp_Object Qvariable_documentation, Vvalues, Vstandard_input, Vafter_load_alist Lisp_Object Qascii_character, Qload, Qload_file_name; Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction; Lisp_Object Qinhibit_file_name_operation; +Lisp_Object Qeval_buffer_list, Veval_buffer_list; extern Lisp_Object Qevent_symbol_element_mask; extern Lisp_Object Qfile_exists_p; -/* non-zero if inside `load' */ +/* non-zero iff inside `load' */ int load_in_progress; /* Directory in which the sources were found. */ @@ -203,6 +208,7 @@ static Lisp_Object Vbytecomp_version_regexp; static void to_multibyte P_ ((char **, char **, int *)); static void readevalloop P_ ((Lisp_Object, FILE*, Lisp_Object, Lisp_Object (*) (), int, + Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object)); static Lisp_Object load_unwind P_ ((Lisp_Object)); static Lisp_Object load_descriptor_unwind P_ ((Lisp_Object)); @@ -319,6 +325,7 @@ readchar (readcharfun) /* Interrupted reads have been observed while reading over the network */ while (c == EOF && ferror (instream) && errno == EINTR) { + QUIT; clearerr (instream); c = getc (instream); } @@ -668,7 +675,6 @@ Return t if file exists. */) { register FILE *stream; register int fd = -1; - register Lisp_Object lispstream; int count = SPECPDL_INDEX (); Lisp_Object temp; struct gcpro gcpro1; @@ -898,17 +904,15 @@ Return t if file exists. */) } GCPRO1 (file); - lispstream = Fcons (Qnil, Qnil); - XSETCARFASTINT (lispstream, (EMACS_UINT)stream >> 16); - XSETCDRFASTINT (lispstream, (EMACS_UINT)stream & 0xffff); - record_unwind_protect (load_unwind, lispstream); + record_unwind_protect (load_unwind, make_save_value (stream, 0)); record_unwind_protect (load_descriptor_unwind, load_descriptor_list); specbind (Qload_file_name, found); specbind (Qinhibit_file_name_operation, Qnil); load_descriptor_list = Fcons (make_number (fileno (stream)), load_descriptor_list); load_in_progress++; - readevalloop (Qget_file_char, stream, file, Feval, 0, Qnil, Qnil); + readevalloop (Qget_file_char, stream, file, Feval, + 0, Qnil, Qnil, Qnil, Qnil); unbind_to (count, Qnil); /* Run any load-hooks for this file. */ @@ -941,15 +945,21 @@ Return t if file exists. */) message_with_string ("Loading %s...done", file, 1); } + if (!NILP (Fequal (build_string ("obsolete"), + Ffile_name_nondirectory + (Fdirectory_file_name (Ffile_name_directory (found)))))) + message_with_string ("Package %s is obsolete", file, 1); + return Qt; } static Lisp_Object -load_unwind (stream) /* used as unwind-protect function in load */ - Lisp_Object stream; +load_unwind (arg) /* used as unwind-protect function in load */ + Lisp_Object arg; { - fclose ((FILE *) (XFASTINT (XCAR (stream)) << 16 - | XFASTINT (XCDR (stream)))); + FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer; + if (stream != NULL) + fclose (stream); if (--load_in_progress < 0) load_in_progress = 0; return Qnil; } @@ -994,6 +1004,7 @@ complete_filename_p (pathname) DEFUN ("locate-file-internal", Flocate_file_internal, Slocate_file_internal, 2, 4, 0, doc: /* Search for FILENAME through PATH. +Returns the file's name in absolute form, or nil if not found. If SUFFIXES is non-nil, it should be a list of suffixes to append to file name when searching. If non-nil, PREDICATE is used instead of `file-readable-p'. @@ -1049,6 +1060,8 @@ openp (path, str, suffixes, storeptr, predicate) Lisp_Object string, tail, encoded_fn; int max_suffix_len = 0; + CHECK_STRING (str); + for (tail = suffixes; CONSP (tail); tail = XCDR (tail)) { CHECK_STRING_CAR (tail); @@ -1279,16 +1292,19 @@ end_of_file_error () /* UNIBYTE specifies how to set load_convert_to_unibyte for this invocation. - READFUN, if non-nil, is used instead of `read'. */ + READFUN, if non-nil, is used instead of `read'. + START, END is region in current buffer (from eval-region). */ static void -readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, readfun) +readevalloop (readcharfun, stream, sourcename, evalfun, + printflag, unibyte, readfun, start, end) Lisp_Object readcharfun; FILE *stream; Lisp_Object sourcename; Lisp_Object (*evalfun) (); int printflag; Lisp_Object unibyte, readfun; + Lisp_Object start, end; { register int c; register Lisp_Object val; @@ -1316,28 +1332,41 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read continue_reading_p = 1; while (continue_reading_p) { + int count1 = SPECPDL_INDEX (); + if (b != 0 && NILP (b->name)) error ("Reading from killed buffer"); + if (!NILP (start)) + { + record_unwind_protect (save_excursion_restore, save_excursion_save ()); + record_unwind_protect (save_restriction_restore, save_restriction_save ()); + Fgoto_char (start); + Fnarrow_to_region (make_number (BEGV), end); + } + instream = stream; + read_next: c = READCHAR; if (c == ';') { while ((c = READCHAR) != '\n' && c != -1); - continue; + goto read_next; + } + if (c < 0) + { + unbind_to (count1, Qnil); + break; } - if (c < 0) break; /* Ignore whitespace here, so we can detect eof. */ if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r') - continue; + goto read_next; if (!NILP (Vpurify_flag) && c == '(') { - int count1 = SPECPDL_INDEX (); record_unwind_protect (unreadpure, Qnil); val = read_list (-1, readcharfun); - unbind_to (count1, Qnil); } else { @@ -1363,6 +1392,10 @@ readevalloop (readcharfun, stream, sourcename, evalfun, printflag, unibyte, read val = read_internal_start (readcharfun, Qnil, Qnil); } + if (!NILP (start) && continue_reading_p) + start = Fpoint_marker (); + unbind_to (count1, Qnil); + val = (*evalfun) (val); if (printflag) @@ -1418,10 +1451,12 @@ This function preserves the position of point. */) if (NILP (filename)) filename = XBUFFER (buf)->filename; + specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list)); specbind (Qstandard_output, tem); record_unwind_protect (save_excursion_restore, save_excursion_save ()); BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf))); - readevalloop (buf, 0, filename, Feval, !NILP (printflag), unibyte, Qnil); + readevalloop (buf, 0, filename, Feval, + !NILP (printflag), unibyte, Qnil, Qnil, Qnil); unbind_to (count, Qnil); return Qnil; @@ -1452,16 +1487,12 @@ This function does not move point. */) else tem = printflag; specbind (Qstandard_output, tem); + specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list)); - if (NILP (printflag)) - record_unwind_protect (save_excursion_restore, save_excursion_save ()); - record_unwind_protect (save_restriction_restore, save_restriction_save ()); - - /* This both uses start and checks its type. */ - Fgoto_char (start); - Fnarrow_to_region (make_number (BEGV), end); + /* readevalloop calls functions which check the type of start and end. */ readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, - !NILP (printflag), Qnil, read_function); + !NILP (printflag), Qnil, read_function, + start, end); return unbind_to (count, Qnil); } @@ -1983,8 +2014,9 @@ read1 (readcharfun, pch, first_in_list) if (c == '"') { Lisp_Object tmp, val; - int size_in_chars = ((XFASTINT (length) + BITS_PER_CHAR - 1) - / BITS_PER_CHAR); + int size_in_chars + = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1) + / BOOL_VECTOR_BITS_PER_CHAR); UNREAD (c); tmp = read1 (readcharfun, pch, first_in_list); @@ -1993,7 +2025,7 @@ read1 (readcharfun, pch, first_in_list) when the number of bits was a multiple of 8. Accept such input in case it came from an old version. */ && ! (XFASTINT (length) - == (SCHARS (tmp) - 1) * BITS_PER_CHAR)) + == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)) Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5), Qnil)); @@ -2001,9 +2033,9 @@ read1 (readcharfun, pch, first_in_list) bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data, size_in_chars); /* Clear the extraneous bits in the last byte. */ - if (XINT (length) != size_in_chars * BITS_PER_CHAR) + if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR) XBOOL_VECTOR (val)->data[size_in_chars - 1] - &= (1 << (XINT (length) % BITS_PER_CHAR)) - 1; + &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; return val; } Fsignal (Qinvalid_read_syntax, Fcons (make_string ("#&...", 5), @@ -2278,16 +2310,18 @@ read1 (readcharfun, pch, first_in_list) UNREAD (next_next_char); ok = (next_next_char <= 040 - || index ("\"';([#?", next_next_char) - || (!first_in_list && next_next_char == '`') - || (new_backquote_flag && next_next_char == ',')); + || (next_next_char < 0200 + && (index ("\"';([#?", next_next_char) + || (!first_in_list && next_next_char == '`') + || (new_backquote_flag && next_next_char == ',')))); } else { ok = (next_char <= 040 - || index ("\"';()[]#?", next_char) - || (!first_in_list && next_char == '`') - || (new_backquote_flag && next_char == ',')); + || (next_char < 0200 + && (index ("\"';()[]#?", next_char) + || (!first_in_list && next_char == '`') + || (new_backquote_flag && next_char == ',')))); } UNREAD (next_char); if (!ok) @@ -2445,9 +2479,10 @@ read1 (readcharfun, pch, first_in_list) UNREAD (next_char); if (next_char <= 040 - || index ("\"';([#?", next_char) - || (!first_in_list && next_char == '`') - || (new_backquote_flag && next_char == ',')) + || (next_char < 0200 + && (index ("\"';([#?", next_char) + || (!first_in_list && next_char == '`') + || (new_backquote_flag && next_char == ',')))) { *pch = c; return Qnil; @@ -2468,9 +2503,10 @@ read1 (readcharfun, pch, first_in_list) char *end = read_buffer + read_buffer_size; while (c > 040 - && !index ("\"';()[]#", c) - && !(!first_in_list && c == '`') - && !(new_backquote_flag && c == ',')) + && (c >= 0200 + || (!index ("\"';()[]#", c) + && !(!first_in_list && c == '`') + && !(new_backquote_flag && c == ',')))) { if (end - p < MAX_MULTIBYTE_LENGTH) { @@ -2560,6 +2596,23 @@ read1 (readcharfun, pch, first_in_list) break; case 'N': value = zero / zero; + + /* If that made a "negative" NaN, negate it. */ + + { + int i; + union { double d; char c[sizeof (double)]; } u_data, u_minus_zero; + + u_data.d = value; + u_minus_zero.d = - 0.0; + for (i = 0; i < sizeof (double); i++) + if (u_data.c[i] & u_minus_zero.c[i]) + { + value = - value; + break; + } + } + /* Now VALUE is a positive NaN. */ break; default: value = atof (read_buffer + negative); @@ -2810,7 +2863,7 @@ read_vector (readcharfun, bytecodeflag) if (i == COMPILED_BYTECODE) { if (!STRINGP (item)) - error ("invalid byte code"); + error ("Invalid byte code"); /* Delay handling the bytecode slot until we know whether it is lazily-loaded (we can tell by whether the @@ -2832,7 +2885,7 @@ read_vector (readcharfun, bytecodeflag) item = Fread (bytestr); if (!CONSP (item)) - error ("invalid byte code"); + error ("Invalid byte code"); otem = XCONS (item); bytestr = XCAR (item); @@ -3261,7 +3314,7 @@ oblookup (obarray, ptr, size, size_byte) hash %= obsize; bucket = XVECTOR (obarray)->contents[hash]; oblookup_last_bucket_number = hash; - if (XFASTINT (bucket) == 0) + if (EQ (bucket, make_number (0))) ; else if (!SYMBOLP (bucket)) error ("Bad data in guts of obarray"); /* Like CADR error message */ @@ -3481,7 +3534,6 @@ defvar_per_buffer (namestring, address, type, doc) { Lisp_Object sym, val; int offset; - extern struct buffer buffer_local_symbols; sym = intern (namestring); val = allocate_misc (); @@ -3663,11 +3715,15 @@ init_lread () } #endif -#ifndef WINDOWSNT +#if (!(defined(WINDOWSNT) || (defined(HAVE_CARBON)))) /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is almost never correct, thereby causing a warning to be printed out that confuses users. Since PATH_LOADSEARCH is always overridden by the - EMACSLOADPATH environment variable below, disable the warning on NT. */ + EMACSLOADPATH environment variable below, disable the warning on NT. + Also, when using the "self-contained" option for Carbon Emacs for MacOSX, + the "standard" paths may not exist and would be overridden by + EMACSLOADPATH as on NT. Since this depends on how the executable + was build and packaged, turn off the warnings in general */ /* Warn if dirs in the *standard* path don't exist. */ if (!turn_off_warning) @@ -3689,7 +3745,7 @@ init_lread () } } } -#endif /* WINDOWSNT */ +#endif /* !(WINDOWSNT || HAVE_CARBON) */ /* If the EMACSLOADPATH environment variable is set, use its value. This doesn't apply if we're dumping. */ @@ -3827,10 +3883,10 @@ when the corresponding call to `provide' is made. */); Each alist element is a list that starts with a file name, except for one element (optional) that starts with nil and describes definitions evaluated from buffers not visiting files. -The remaining elements of each list are symbols defined as functions, +The remaining elements of each list are symbols defined as variables and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)', -`(defvar . VARIABLE), `(autoload . SYMBOL)', and `(t . SYMBOL)'. -An element `(t . SYMBOL)' precedes an entry that is just SYMBOL, +`(defun . FUNCTION)', `(autoload . SYMBOL)', and `(t . SYMBOL)'. +An element `(t . SYMBOL)' precedes an entry `(defun . FUNCTION)', and means that SYMBOL was an autoload before this file redefined it as a function. */); Vload_history = Qnil; @@ -3841,8 +3897,8 @@ as a function. */); DEFVAR_LISP ("user-init-file", &Vuser_init_file, doc: /* File name, including directory, of user's initialization file. -If the file loaded had extension `.elc' and there was a corresponding `.el' -file, this variable contains the name of the .el file, suitable for use +If the file loaded had extension `.elc', and the corresponding source file +exists, this variable contains the name of source file, suitable for use by functions like `custom-save-all' which edit the init file. */); Vuser_init_file = Qnil; @@ -3906,6 +3962,10 @@ to load. See also `load-dangerous-libraries'. */); Vbytecomp_version_regexp = build_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)"); + DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list, + doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */); + Veval_buffer_list = Qnil; + /* Vsource_directory was initialized in init_lread. */ load_descriptor_list = Qnil; @@ -3947,12 +4007,19 @@ to load. See also `load-dangerous-libraries'. */); Qload_file_name = intern ("load-file-name"); staticpro (&Qload_file_name); + Qeval_buffer_list = intern ("eval-buffer-list"); + staticpro (&Qeval_buffer_list); + staticpro (&dump_path); staticpro (&read_objects); read_objects = Qnil; staticpro (&seen_list); + seen_list = Qnil; Vloads_in_progress = Qnil; staticpro (&Vloads_in_progress); } + +/* arch-tag: a0d02733-0f96-4844-a659-9fd53c4f414d + (do not change this comment) */