X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/8ab1650ee30cf51b9756f093975d4f58b7839688..d5a3eaaf13bf8de7e52a79f3c9e8c248dbb5a93e:/src/lread.c diff --git a/src/lread.c b/src/lread.c index c565ce9fd5..96108ec4a7 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1,7 +1,7 @@ /* Lisp parsing and input streams. Copyright (C) 1985, 1986, 1987, 1988, 1989, 1993, 1994, 1995, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, - 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. + 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -41,9 +41,6 @@ along with GNU Emacs. If not, see . */ #include "blockinput.h" #ifdef MSDOS -#if __DJGPP__ < 2 -#include /* to get X_OK */ -#endif #include "msdos.h" #endif @@ -51,10 +48,6 @@ along with GNU Emacs. If not, see . */ #include #endif -#ifndef X_OK -#define X_OK 01 -#endif - #include #ifdef HAVE_SETLOCALE @@ -76,10 +69,6 @@ along with GNU Emacs. If not, see . */ #define file_tell ftell #endif -#ifndef USE_CRT_DLL -extern int errno; -#endif - /* hash table read constants */ Lisp_Object Qhash_table, Qdata; Lisp_Object Qtest, Qsize; @@ -230,18 +219,18 @@ int force_load_messages; static Lisp_Object Vbytecomp_version_regexp; -static int read_emacs_mule_char P_ ((int, int (*) (int, Lisp_Object), - Lisp_Object)); +static int read_emacs_mule_char (int, int (*) (int, Lisp_Object), + Lisp_Object); -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)); +static void readevalloop (Lisp_Object, FILE*, Lisp_Object, + Lisp_Object (*) (Lisp_Object), int, + Lisp_Object, Lisp_Object, + Lisp_Object, Lisp_Object); +static Lisp_Object load_unwind (Lisp_Object); +static Lisp_Object load_descriptor_unwind (Lisp_Object); -static void invalid_syntax P_ ((const char *, int)) NO_RETURN; -static void end_of_file_error P_ (()) NO_RETURN; +static void invalid_syntax (const char *, int) NO_RETURN; +static void end_of_file_error (void) NO_RETURN; /* Functions that read one byte from the current source READCHARFUN @@ -250,9 +239,9 @@ static void end_of_file_error P_ (()) NO_RETURN; is 0 or positive, it unreads C, and the return value is not interesting. */ -static int readbyte_for_lambda P_ ((int, Lisp_Object)); -static int readbyte_from_file P_ ((int, Lisp_Object)); -static int readbyte_from_string P_ ((int, Lisp_Object)); +static int readbyte_for_lambda (int, Lisp_Object); +static int readbyte_from_file (int, Lisp_Object); +static int readbyte_from_string (int, Lisp_Object); /* Handle unreading and rereading of characters. Write READCHAR to read a character, @@ -273,13 +262,11 @@ static int readbyte_from_string P_ ((int, Lisp_Object)); static int unread_char; static int -readchar (readcharfun, multibyte) - Lisp_Object readcharfun; - int *multibyte; +readchar (Lisp_Object readcharfun, int *multibyte) { Lisp_Object tem; register int c; - int (*readbyte) P_ ((int, Lisp_Object)); + int (*readbyte) (int, Lisp_Object); unsigned char buf[MAX_MULTIBYTE_LENGTH]; int i, len; int emacs_mule_encoding = 0; @@ -303,7 +290,7 @@ readchar (readcharfun, multibyte) /* Fetch the character code from the buffer. */ unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, pt_byte); BUF_INC_POS (inbuffer, pt_byte); - c = STRING_CHAR (p, pt_byte - orig_pt_byte); + c = STRING_CHAR (p); if (multibyte) *multibyte = 1; } @@ -332,7 +319,7 @@ readchar (readcharfun, multibyte) /* Fetch the character code from the buffer. */ unsigned char *p = BUF_BYTE_ADDRESS (inbuffer, bytepos); BUF_INC_POS (inbuffer, bytepos); - c = STRING_CHAR (p, bytepos - orig_bytepos); + c = STRING_CHAR (p); if (multibyte) *multibyte = 1; } @@ -439,16 +426,14 @@ readchar (readcharfun, multibyte) } buf[i++] = c; } - return STRING_CHAR (buf, i); + return STRING_CHAR (buf); } /* Unread the character C in the way appropriate for the stream READCHARFUN. If the stream is a user function, call it with the char as argument. */ static void -unreadchar (readcharfun, c) - Lisp_Object readcharfun; - int c; +unreadchar (Lisp_Object readcharfun, int c) { readchar_count--; if (c == -1) @@ -512,18 +497,14 @@ unreadchar (readcharfun, c) } static int -readbyte_for_lambda (c, readcharfun) - int c; - Lisp_Object readcharfun; +readbyte_for_lambda (int c, Lisp_Object readcharfun) { return read_bytecode_char (c >= 0); } static int -readbyte_from_file (c, readcharfun) - int c; - Lisp_Object readcharfun; +readbyte_from_file (int c, Lisp_Object readcharfun) { if (c >= 0) { @@ -554,9 +535,7 @@ readbyte_from_file (c, readcharfun) } static int -readbyte_from_string (c, readcharfun) - int c; - Lisp_Object readcharfun; +readbyte_from_string (int c, Lisp_Object readcharfun) { Lisp_Object string = XCAR (readcharfun); @@ -584,10 +563,7 @@ readbyte_from_string (c, readcharfun) extern char emacs_mule_bytes[256]; static int -read_emacs_mule_char (c, readbyte, readcharfun) - int c; - int (*readbyte) P_ ((int, Lisp_Object)); - Lisp_Object readcharfun; +read_emacs_mule_char (int c, int (*readbyte) (int, Lisp_Object), Lisp_Object readcharfun) { /* Emacs-mule coding uses at most 4-byte for one character. */ unsigned char buf[4]; @@ -646,19 +622,19 @@ read_emacs_mule_char (c, readbyte, readcharfun) } -static Lisp_Object read_internal_start P_ ((Lisp_Object, Lisp_Object, - Lisp_Object)); -static Lisp_Object read0 P_ ((Lisp_Object)); -static Lisp_Object read1 P_ ((Lisp_Object, int *, int)); +static Lisp_Object read_internal_start (Lisp_Object, Lisp_Object, + Lisp_Object); +static Lisp_Object read0 (Lisp_Object); +static Lisp_Object read1 (Lisp_Object, int *, int); -static Lisp_Object read_list P_ ((int, Lisp_Object)); -static Lisp_Object read_vector P_ ((Lisp_Object, int)); +static Lisp_Object read_list (int, Lisp_Object); +static Lisp_Object read_vector (Lisp_Object, int); -static Lisp_Object substitute_object_recurse P_ ((Lisp_Object, Lisp_Object, - Lisp_Object)); -static void substitute_object_in_subtree P_ ((Lisp_Object, - Lisp_Object)); -static void substitute_in_interval P_ ((INTERVAL, Lisp_Object)); +static Lisp_Object substitute_object_recurse (Lisp_Object, Lisp_Object, + Lisp_Object); +static void substitute_object_in_subtree (Lisp_Object, + Lisp_Object); +static void substitute_in_interval (INTERVAL, Lisp_Object); /* Get a character from the tty. */ @@ -685,10 +661,8 @@ static void substitute_in_interval P_ ((INTERVAL, Lisp_Object)); return Qnil if no input arrives within that time. */ Lisp_Object -read_filtered_event (no_switch_frame, ascii_required, error_nonascii, - input_method, seconds) - int no_switch_frame, ascii_required, error_nonascii, input_method; - Lisp_Object seconds; +read_filtered_event (int no_switch_frame, int ascii_required, + int error_nonascii, int input_method, Lisp_Object seconds) { Lisp_Object val, delayed_switch_frame; EMACS_TIME end_time; @@ -803,8 +777,7 @@ If the optional argument SECONDS is non-nil, it should be a number specifying the maximum number of seconds to wait for input. If no input arrives in that time, return nil. SECONDS may be a floating-point value. */) - (prompt, inherit_input_method, seconds) - Lisp_Object prompt, inherit_input_method, seconds; + (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds) { Lisp_Object val; @@ -826,8 +799,7 @@ If the optional argument SECONDS is non-nil, it should be a number specifying the maximum number of seconds to wait for input. If no input arrives in that time, return nil. SECONDS may be a floating-point value. */) - (prompt, inherit_input_method, seconds) - Lisp_Object prompt, inherit_input_method, seconds; + (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds) { if (! NILP (prompt)) message_with_string ("%s", prompt, 0); @@ -848,8 +820,7 @@ If the optional argument SECONDS is non-nil, it should be a number specifying the maximum number of seconds to wait for input. If no input arrives in that time, return nil. SECONDS may be a floating-point value. */) - (prompt, inherit_input_method, seconds) - Lisp_Object prompt, inherit_input_method, seconds; + (Lisp_Object prompt, Lisp_Object inherit_input_method, Lisp_Object seconds) { Lisp_Object val; @@ -864,7 +835,7 @@ floating-point value. */) DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, doc: /* Don't use this yourself. */) - () + (void) { register Lisp_Object val; BLOCK_INPUT; @@ -882,8 +853,7 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0, because of an incompatible change in the byte compiler. */ static int -safe_to_load_p (fd) - int fd; +safe_to_load_p (int fd) { char buf[512]; int nbytes, i; @@ -920,8 +890,7 @@ safe_to_load_p (fd) after loading a file successfully. */ static Lisp_Object -record_load_unwind (old) - Lisp_Object old; +record_load_unwind (Lisp_Object old) { return Vloads_in_progress = old; } @@ -929,15 +898,13 @@ record_load_unwind (old) /* This handler function is used via internal_condition_case_1. */ static Lisp_Object -load_error_handler (data) - Lisp_Object data; +load_error_handler (Lisp_Object data) { return Qnil; } static Lisp_Object -load_warn_old_style_backquotes (file) - Lisp_Object file; +load_warn_old_style_backquotes (Lisp_Object file) { if (!NILP (Vold_style_backquotes)) { @@ -953,7 +920,7 @@ DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0, doc: /* Return the suffixes that `load' should try if a suffix is \ required. This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */) - () + (void) { Lisp_Object lst = Qnil, suffixes = Vload_suffixes, suffix, ext; while (CONSP (suffixes)) @@ -1008,8 +975,7 @@ Loading a file records its definitions, and its `provide' and car is the file name loaded. See `load-history'. Return t if the file exists and loads successfully. */) - (file, noerror, nomessage, nosuffix, must_suffix) - Lisp_Object file, noerror, nomessage, nosuffix, must_suffix; + (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, Lisp_Object nosuffix, Lisp_Object must_suffix) { register FILE *stream; register int fd = -1; @@ -1153,9 +1119,8 @@ Return t if the file exists and loads successfully. */) specbind (Qold_style_backquotes, Qnil); record_unwind_protect (load_warn_old_style_backquotes, file); - if (!bcmp (SDATA (found) + SBYTES (found) - 4, - ".elc", 4) - || (version = safe_to_load_p (fd)) > 0) + if (!memcmp (SDATA (found) + SBYTES (found) - 4, ".elc", 4) + || (fd >= 0 && (version = safe_to_load_p (fd)) > 0)) /* Load .elc files directly, but not when they are remote and have no handler! */ { @@ -1310,8 +1275,8 @@ Return t if the file exists and loads successfully. */) } static Lisp_Object -load_unwind (arg) /* used as unwind-protect function in load */ - Lisp_Object arg; +load_unwind (Lisp_Object arg) /* used as unwind-protect function in load */ + { FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer; if (stream != NULL) @@ -1324,8 +1289,7 @@ load_unwind (arg) /* used as unwind-protect function in load */ } static Lisp_Object -load_descriptor_unwind (oldlist) - Lisp_Object oldlist; +load_descriptor_unwind (Lisp_Object oldlist) { load_descriptor_list = oldlist; return Qnil; @@ -1335,7 +1299,7 @@ load_descriptor_unwind (oldlist) This is used when starting a subprocess. */ void -close_load_descs () +close_load_descs (void) { #ifndef WINDOWSNT Lisp_Object tail; @@ -1345,8 +1309,7 @@ close_load_descs () } static int -complete_filename_p (pathname) - Lisp_Object pathname; +complete_filename_p (Lisp_Object pathname) { register const unsigned char *s = SDATA (pathname); return (IS_DIRECTORY_SEP (s[0]) @@ -1362,8 +1325,7 @@ file name when searching. If non-nil, PREDICATE is used instead of `file-readable-p'. PREDICATE can also be an integer to pass to the access(2) function, in which case file-name-handlers are ignored. */) - (filename, path, suffixes, predicate) - Lisp_Object filename, path, suffixes, predicate; + (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate) { Lisp_Object file; int fd = openp (path, filename, suffixes, &file, predicate); @@ -1394,11 +1356,7 @@ in which case file-name-handlers are ignored. */) but store the found remote file name in *STOREPTR. */ int -openp (path, str, suffixes, storeptr, predicate) - Lisp_Object path, str; - Lisp_Object suffixes; - Lisp_Object *storeptr; - Lisp_Object predicate; +openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *storeptr, Lisp_Object predicate) { register int fd; int fn_size = 100; @@ -1550,9 +1508,7 @@ openp (path, str, suffixes, storeptr, predicate) ENTIRE is 1 if loading that entire file, 0 if evaluating part of it. */ static void -build_load_history (filename, entire) - Lisp_Object filename; - int entire; +build_load_history (Lisp_Object filename, int entire) { register Lisp_Object tail, prev, newelt; register Lisp_Object tem, tem2; @@ -1612,16 +1568,15 @@ build_load_history (filename, entire) } Lisp_Object -unreadpure (junk) /* Used as unwind-protect function in readevalloop */ - Lisp_Object junk; +unreadpure (Lisp_Object junk) /* Used as unwind-protect function in readevalloop */ + { read_pure = 0; return Qnil; } static Lisp_Object -readevalloop_1 (old) - Lisp_Object old; +readevalloop_1 (Lisp_Object old) { load_convert_to_unibyte = ! NILP (old); return Qnil; @@ -1631,7 +1586,7 @@ readevalloop_1 (old) information. */ static void -end_of_file_error () +end_of_file_error (void) { if (STRINGP (Vload_file_name)) xsignal1 (Qend_of_file, Vload_file_name); @@ -1647,15 +1602,13 @@ end_of_file_error () If the input is not from a buffer, they must be nil. */ static void -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; +readevalloop (Lisp_Object readcharfun, + FILE *stream, + Lisp_Object sourcename, + Lisp_Object (*evalfun) (Lisp_Object), + int printflag, + Lisp_Object unibyte, Lisp_Object readfun, + Lisp_Object start, Lisp_Object end) { register int c; register Lisp_Object val; @@ -1825,8 +1778,7 @@ DO-ALLOW-PRINT, if non-nil, specifies that `print' and related functions should work normally even if PRINTFLAG is nil. This function preserves the position of point. */) - (buffer, printflag, filename, unibyte, do_allow_print) - Lisp_Object buffer, printflag, filename, unibyte, do_allow_print; + (Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print) { int count = SPECPDL_INDEX (); Lisp_Object tem, buf; @@ -1869,8 +1821,7 @@ instead of `read' to read each expression. It gets one argument which is the input stream for reading characters. This function does not move point. */) - (start, end, printflag, read_function) - Lisp_Object start, end, printflag, read_function; + (Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function) { int count = SPECPDL_INDEX (); Lisp_Object tem, cbuf; @@ -1904,8 +1855,7 @@ STREAM or the value of `standard-input' may be: a string (takes text from string, starting at the beginning) t (read text line using minibuffer and use it, or read from standard input in batch mode). */) - (stream) - Lisp_Object stream; + (Lisp_Object stream) { if (NILP (stream)) stream = Vstandard_input; @@ -1922,8 +1872,7 @@ DEFUN ("read-from-string", Fread_from_string, Sread_from_string, 1, 3, 0, Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX). START and END optionally delimit a substring of STRING from which to read; they default to 0 and (length STRING) respectively. */) - (string, start, end) - Lisp_Object string, start, end; + (Lisp_Object string, Lisp_Object start, Lisp_Object end) { Lisp_Object ret; CHECK_STRING (string); @@ -1935,10 +1884,8 @@ START and END optionally delimit a substring of STRING from which to read; /* Function to set up the global context we need in toplevel read calls. */ static Lisp_Object -read_internal_start (stream, start, end) - Lisp_Object stream; - Lisp_Object start; /* Only used when stream is a string. */ - Lisp_Object end; /* Only used when stream is a string. */ +read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end) +/* start, end only used when stream is a string. */ { Lisp_Object retval; @@ -1996,9 +1943,7 @@ read_internal_start (stream, start, end) S is error string of length N (if > 0) */ static void -invalid_syntax (s, n) - const char *s; - int n; +invalid_syntax (const char *s, int n) { if (!n) n = strlen (s); @@ -2010,8 +1955,7 @@ invalid_syntax (s, n) are not allowed. */ static Lisp_Object -read0 (readcharfun) - Lisp_Object readcharfun; +read0 (Lisp_Object readcharfun) { register Lisp_Object val; int c; @@ -2031,9 +1975,7 @@ static char *read_buffer; If the escape sequence forces unibyte, return eight-bit char. */ static int -read_escape (readcharfun, stringp) - Lisp_Object readcharfun; - int stringp; +read_escape (Lisp_Object readcharfun, int stringp) { register int c = READCHAR; /* \u allows up to four hex digits, \U up to eight. Default to the @@ -2247,9 +2189,7 @@ read_escape (readcharfun, stringp) range. */ static Lisp_Object -read_integer (readcharfun, radix) - Lisp_Object readcharfun; - int radix; +read_integer (Lisp_Object readcharfun, int radix) { int ndigits = 0, invalid_p, c, sign = 0; /* We use a floating point number because */ @@ -2314,10 +2254,7 @@ read_integer (readcharfun, radix) FIRST_IN_LIST is nonzero if this is the first element of a list. */ static Lisp_Object -read1 (readcharfun, pch, first_in_list) - register Lisp_Object readcharfun; - int *pch; - int first_in_list; +read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) { register int c; int uninterned_symbol = 0; @@ -2377,28 +2314,28 @@ read1 (readcharfun, pch, first_in_list) /* This is repetitive but fast and simple. */ params[param_count] = QCsize; params[param_count+1] = Fplist_get (tmp, Qsize); - if (!NILP (params[param_count+1])) - param_count+=2; + if (!NILP (params[param_count + 1])) + param_count += 2; params[param_count] = QCtest; params[param_count+1] = Fplist_get (tmp, Qtest); - if (!NILP (params[param_count+1])) - param_count+=2; + if (!NILP (params[param_count + 1])) + param_count += 2; params[param_count] = QCweakness; params[param_count+1] = Fplist_get (tmp, Qweakness); - if (!NILP (params[param_count+1])) - param_count+=2; + if (!NILP (params[param_count + 1])) + param_count += 2; params[param_count] = QCrehash_size; params[param_count+1] = Fplist_get (tmp, Qrehash_size); - if (!NILP (params[param_count+1])) - param_count+=2; + if (!NILP (params[param_count + 1])) + param_count += 2; params[param_count] = QCrehash_threshold; params[param_count+1] = Fplist_get (tmp, Qrehash_threshold); - if (!NILP (params[param_count+1])) - param_count+=2; + if (!NILP (params[param_count + 1])) + param_count += 2; /* This is the hashtable data. */ data = Fplist_get (tmp, Qdata); @@ -2419,6 +2356,8 @@ read1 (readcharfun, pch, first_in_list) return ht; } + UNREAD (c); + invalid_syntax ("#", 1); } if (c == '^') { @@ -2481,8 +2420,7 @@ read1 (readcharfun, pch, first_in_list) invalid_syntax ("#&...", 5); val = Fmake_bool_vector (length, Qnil); - bcopy (SDATA (tmp), XBOOL_VECTOR (val)->data, - size_in_chars); + memcpy (XBOOL_VECTOR (val)->data, SDATA (tmp), size_in_chars); /* Clear the extraneous bits in the last byte. */ if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR) XBOOL_VECTOR (val)->data[size_in_chars - 1] @@ -2694,22 +2632,35 @@ read1 (readcharfun, pch, first_in_list) } case '`': - if (first_in_list) - { - Vold_style_backquotes = Qt; - goto default_label; - } - else - { - Lisp_Object value; - - new_backquote_flag++; - value = read0 (readcharfun); - new_backquote_flag--; + { + int next_char = READCHAR; + UNREAD (next_char); + /* Transition from old-style to new-style: + If we see "(`" it used to mean old-style, which usually works + fine because ` should almost never appear in such a position + for new-style. But occasionally we need "(`" to mean new + style, so we try to distinguish the two by the fact that we + can either write "( `foo" or "(` foo", where the first + intends to use new-style whereas the second intends to use + old-style. For Emacs-25, we should completely remove this + first_in_list exception (old-style can still be obtained via + "(\`" anyway). */ + if (first_in_list && next_char == ' ') + { + Vold_style_backquotes = Qt; + goto default_label; + } + else + { + Lisp_Object value; - return Fcons (Qbackquote, Fcons (value, Qnil)); - } + new_backquote_flag++; + value = read0 (readcharfun); + new_backquote_flag--; + return Fcons (Qbackquote, Fcons (value, Qnil)); + } + } case ',': if (new_backquote_flag) { @@ -2772,7 +2723,7 @@ read1 (readcharfun, pch, first_in_list) ok = (next_next_char <= 040 || (next_next_char < 0200 - && (index ("\"';([#?", next_next_char) + && (strchr ("\"';([#?", next_next_char) || (!first_in_list && next_next_char == '`') || (new_backquote_flag && next_next_char == ',')))); } @@ -2780,7 +2731,7 @@ read1 (readcharfun, pch, first_in_list) { ok = (next_char <= 040 || (next_char < 0200 - && (index ("\"';()[]#?", next_char) + && (strchr ("\"';()[]#?", next_char) || (!first_in_list && next_char == '`') || (new_backquote_flag && next_char == ',')))); } @@ -2925,7 +2876,7 @@ read1 (readcharfun, pch, first_in_list) if (next_char <= 040 || (next_char < 0200 - && (index ("\"';([#?", next_char) + && (strchr ("\"';([#?", next_char) || (!first_in_list && next_char == '`') || (new_backquote_flag && next_char == ',')))) { @@ -2952,7 +2903,7 @@ read1 (readcharfun, pch, first_in_list) while (c > 040 && c != 0x8a0 /* NBSP */ && (c >= 0200 - || (!index ("\"';()[]#", c) + || (!strchr ("\"';()[]#", c) && !(!first_in_list && c == '`') && !(new_backquote_flag && c == ',')))) { @@ -3026,7 +2977,7 @@ read1 (readcharfun, pch, first_in_list) } } } - if (isfloat_string (read_buffer)) + if (isfloat_string (read_buffer, 0)) { /* Compute NaN and infinities using 0.0 in a variable, to cope with compilers that think they are smarter @@ -3111,9 +3062,7 @@ read1 (readcharfun, pch, first_in_list) static Lisp_Object seen_list; static void -substitute_object_in_subtree (object, placeholder) - Lisp_Object object; - Lisp_Object placeholder; +substitute_object_in_subtree (Lisp_Object object, Lisp_Object placeholder) { Lisp_Object check_object; @@ -3148,10 +3097,7 @@ substitute_object_in_subtree (object, placeholder) } while (0) static Lisp_Object -substitute_object_recurse (object, placeholder, subtree) - Lisp_Object object; - Lisp_Object placeholder; - Lisp_Object subtree; +substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Object subtree) { /* If we find the placeholder, return the target object. */ if (EQ (placeholder, subtree)) @@ -3226,9 +3172,7 @@ substitute_object_recurse (object, placeholder, subtree) /* Helper function for substitute_object_recurse. */ static void -substitute_in_interval (interval, arg) - INTERVAL interval; - Lisp_Object arg; +substitute_in_interval (INTERVAL interval, Lisp_Object arg) { Lisp_Object object = Fcar (arg); Lisp_Object placeholder = Fcdr (arg); @@ -3244,12 +3188,10 @@ substitute_in_interval (interval, arg) #define EXP_INT 16 int -isfloat_string (cp) - register char *cp; +isfloat_string (const char *cp, int ignore_trailing) { - register int state; - - char *start = cp; + int state; + const char *start = cp; state = 0; if (*cp == '+' || *cp == '-') @@ -3299,7 +3241,9 @@ isfloat_string (cp) cp += 3; } - return (((*cp == 0) || (*cp == ' ') || (*cp == '\t') || (*cp == '\n') || (*cp == '\r') || (*cp == '\f')) + return ((ignore_trailing + || *cp == 0 || *cp == ' ' || *cp == '\t' || *cp == '\n' + || *cp == '\r' || *cp == '\f') && (state == (LEAD_INT|DOT_CHAR|TRAIL_INT) || state == (DOT_CHAR|TRAIL_INT) || state == (LEAD_INT|E_CHAR|EXP_INT) @@ -3309,9 +3253,7 @@ isfloat_string (cp) static Lisp_Object -read_vector (readcharfun, bytecodeflag) - Lisp_Object readcharfun; - int bytecodeflag; +read_vector (Lisp_Object readcharfun, int bytecodeflag) { register int i; register int size; @@ -3394,9 +3336,7 @@ read_vector (readcharfun, bytecodeflag) and make structure pure. */ static Lisp_Object -read_list (flag, readcharfun) - int flag; - register Lisp_Object readcharfun; +read_list (int flag, register Lisp_Object readcharfun) { /* -1 means check next element for defun, 0 means don't check, @@ -3584,14 +3524,13 @@ Lisp_Object initial_obarray; int oblookup_last_bucket_number; -static int hash_string (); +static int hash_string (const unsigned char *ptr, int len); /* Get an error if OBARRAY is not an obarray. If it is one, return it. */ Lisp_Object -check_obarray (obarray) - Lisp_Object obarray; +check_obarray (Lisp_Object obarray) { if (!VECTORP (obarray) || XVECTOR (obarray)->size == 0) { @@ -3606,8 +3545,7 @@ check_obarray (obarray) interned in the current obarray. */ Lisp_Object -intern (str) - const char *str; +intern (const char *str) { Lisp_Object tem; int len = strlen (str); @@ -3648,14 +3586,13 @@ intern_c_string (const char *str) /* Create an uninterned symbol with name STR. */ Lisp_Object -make_symbol (str) - char *str; +make_symbol (const char *str) { int len = strlen (str); - return Fmake_symbol ((!NILP (Vpurify_flag) - ? make_pure_string (str, len, len, 0) - : make_string (str, len))); + return Fmake_symbol (!NILP (Vpurify_flag) + ? make_pure_string (str, len, len, 0) + : make_string (str, len)); } DEFUN ("intern", Fintern, Sintern, 1, 2, 0, @@ -3663,8 +3600,7 @@ DEFUN ("intern", Fintern, Sintern, 1, 2, 0, If there is none, one is created by this function and returned. A second optional argument specifies the obarray to use; it defaults to the value of `obarray'. */) - (string, obarray) - Lisp_Object string, obarray; + (Lisp_Object string, Lisp_Object obarray) { register Lisp_Object tem, sym, *ptr; @@ -3692,7 +3628,8 @@ it defaults to the value of `obarray'. */) && EQ (obarray, initial_obarray)) { XSYMBOL (sym)->constant = 1; - XSYMBOL (sym)->value = sym; + XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL; + SET_SYMBOL_VAL (XSYMBOL (sym), sym); } ptr = &XVECTOR (obarray)->contents[XINT (tem)]; @@ -3710,8 +3647,7 @@ NAME may be a string or a symbol. If it is a symbol, that exact symbol is searched for. A second optional argument specifies the obarray to use; it defaults to the value of `obarray'. */) - (name, obarray) - Lisp_Object name, obarray; + (Lisp_Object name, Lisp_Object obarray) { register Lisp_Object tem, string; @@ -3739,8 +3675,7 @@ The value is t if a symbol was found and deleted, nil otherwise. NAME may be a string or a symbol. If it is a symbol, that symbol is deleted, if it belongs to OBARRAY--no other symbol is deleted. OBARRAY defaults to the value of the variable `obarray'. */) - (name, obarray) - Lisp_Object name, obarray; + (Lisp_Object name, Lisp_Object obarray) { register Lisp_Object string, tem; int hash; @@ -3773,8 +3708,6 @@ OBARRAY defaults to the value of the variable `obarray'. */) error ("Attempt to unintern t or nil"); */ XSYMBOL (tem)->interned = SYMBOL_UNINTERNED; - XSYMBOL (tem)->constant = 0; - XSYMBOL (tem)->indirect_variable = 0; hash = oblookup_last_bucket_number; @@ -3812,10 +3745,7 @@ OBARRAY defaults to the value of the variable `obarray'. */) Also store the bucket number in oblookup_last_bucket_number. */ Lisp_Object -oblookup (obarray, ptr, size, size_byte) - Lisp_Object obarray; - register const char *ptr; - int size, size_byte; +oblookup (Lisp_Object obarray, register const char *ptr, int size, int size_byte) { int hash; int obsize; @@ -3842,7 +3772,7 @@ oblookup (obarray, ptr, size, size_byte) { if (SBYTES (SYMBOL_NAME (tail)) == size_byte && SCHARS (SYMBOL_NAME (tail)) == size - && !bcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte)) + && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte)) return tail; else if (XSYMBOL (tail)->next == 0) break; @@ -3852,9 +3782,7 @@ oblookup (obarray, ptr, size, size_byte) } static int -hash_string (ptr, len) - const unsigned char *ptr; - int len; +hash_string (const unsigned char *ptr, int len) { register const unsigned char *p = ptr; register const unsigned char *end = p + len; @@ -3871,10 +3799,7 @@ hash_string (ptr, len) } void -map_obarray (obarray, fn, arg) - Lisp_Object obarray; - void (*fn) P_ ((Lisp_Object, Lisp_Object)); - Lisp_Object arg; +map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg) { register int i; register Lisp_Object tail; @@ -3894,8 +3819,7 @@ map_obarray (obarray, fn, arg) } void -mapatoms_1 (sym, function) - Lisp_Object sym, function; +mapatoms_1 (Lisp_Object sym, Lisp_Object function) { call1 (function, sym); } @@ -3903,8 +3827,7 @@ mapatoms_1 (sym, function) DEFUN ("mapatoms", Fmapatoms, Smapatoms, 1, 2, 0, doc: /* Call FUNCTION on every symbol in OBARRAY. OBARRAY defaults to the value of `obarray'. */) - (function, obarray) - Lisp_Object function, obarray; + (Lisp_Object function, Lisp_Object obarray) { if (NILP (obarray)) obarray = Vobarray; obarray = check_obarray (obarray); @@ -3916,38 +3839,34 @@ OBARRAY defaults to the value of `obarray'. */) #define OBARRAY_SIZE 1511 void -init_obarray () +init_obarray (void) { Lisp_Object oblength; - int hash; - Lisp_Object *tem; XSETFASTINT (oblength, OBARRAY_SIZE); - Qnil = Fmake_symbol (make_pure_c_string ("nil")); Vobarray = Fmake_vector (oblength, make_number (0)); initial_obarray = Vobarray; staticpro (&initial_obarray); - /* Intern nil in the obarray */ - XSYMBOL (Qnil)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY; - XSYMBOL (Qnil)->constant = 1; - - /* These locals are to kludge around a pyramid compiler bug. */ - hash = hash_string ("nil", 3); - /* Separate statement here to avoid VAXC bug. */ - hash %= OBARRAY_SIZE; - tem = &XVECTOR (Vobarray)->contents[hash]; - *tem = Qnil; Qunbound = Fmake_symbol (make_pure_c_string ("unbound")); - XSYMBOL (Qnil)->function = Qunbound; - XSYMBOL (Qunbound)->value = Qunbound; + /* Set temporary dummy values to Qnil and Vpurify_flag to satisfy the + NILP (Vpurify_flag) check in intern_c_string. */ + Qnil = make_number (-1); Vpurify_flag = make_number (1); + Qnil = intern_c_string ("nil"); + + /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil, + so those two need to be fixed manally. */ + SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound); XSYMBOL (Qunbound)->function = Qunbound; + XSYMBOL (Qunbound)->plist = Qnil; + /* XSYMBOL (Qnil)->function = Qunbound; */ + SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); + XSYMBOL (Qnil)->constant = 1; + XSYMBOL (Qnil)->plist = Qnil; Qt = intern_c_string ("t"); - XSYMBOL (Qnil)->value = Qnil; - XSYMBOL (Qnil)->plist = Qnil; - XSYMBOL (Qt)->value = Qt; + SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); XSYMBOL (Qt)->constant = 1; /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */ @@ -3961,8 +3880,7 @@ init_obarray () } void -defsubr (sname) - struct Lisp_Subr *sname; +defsubr (struct Lisp_Subr *sname) { Lisp_Object sym; sym = intern_c_string (sname->symbol_name); @@ -3986,27 +3904,29 @@ defalias (sname, string) to a C variable of type int. Sample call: DEFVAR_INT ("emacs-priority", &emacs_priority, "Documentation"); */ void -defvar_int (const char *namestring, EMACS_INT *address) +defvar_int (struct Lisp_Intfwd *i_fwd, + const char *namestring, EMACS_INT *address) { - Lisp_Object sym, val; + Lisp_Object sym; sym = intern_c_string (namestring); - val = allocate_misc (); - XMISCTYPE (val) = Lisp_Misc_Intfwd; - XINTFWD (val)->intvar = address; - SET_SYMBOL_VALUE (sym, val); + i_fwd->type = Lisp_Fwd_Int; + i_fwd->intvar = address; + XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; + SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd); } /* Similar but define a variable whose value is t if address contains 1, nil if address contains 0. */ void -defvar_bool (const char *namestring, int *address) +defvar_bool (struct Lisp_Boolfwd *b_fwd, + const char *namestring, int *address) { - Lisp_Object sym, val; + Lisp_Object sym; sym = intern_c_string (namestring); - val = allocate_misc (); - XMISCTYPE (val) = Lisp_Misc_Boolfwd; - XBOOLFWD (val)->boolvar = address; - SET_SYMBOL_VALUE (sym, val); + b_fwd->type = Lisp_Fwd_Bool; + b_fwd->boolvar = address; + XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; + SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd); Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars); } @@ -4016,20 +3936,22 @@ defvar_bool (const char *namestring, int *address) gc-marked for some other reason, since marking the same slot twice can cause trouble with strings. */ void -defvar_lisp_nopro (const char *namestring, Lisp_Object *address) +defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd, + const char *namestring, Lisp_Object *address) { - Lisp_Object sym, val; + Lisp_Object sym; sym = intern_c_string (namestring); - val = allocate_misc (); - XMISCTYPE (val) = Lisp_Misc_Objfwd; - XOBJFWD (val)->objvar = address; - SET_SYMBOL_VALUE (sym, val); + o_fwd->type = Lisp_Fwd_Obj; + o_fwd->objvar = address; + XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; + SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd); } void -defvar_lisp (const char *namestring, Lisp_Object *address) +defvar_lisp (struct Lisp_Objfwd *o_fwd, + const char *namestring, Lisp_Object *address) { - defvar_lisp_nopro (namestring, address); + defvar_lisp_nopro (o_fwd, namestring, address); staticpro (address); } @@ -4037,14 +3959,15 @@ defvar_lisp (const char *namestring, Lisp_Object *address) at a particular offset in the current kboard object. */ void -defvar_kboard (const char *namestring, int offset) +defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd, + const char *namestring, int offset) { - Lisp_Object sym, val; + Lisp_Object sym; sym = intern_c_string (namestring); - val = allocate_misc (); - XMISCTYPE (val) = Lisp_Misc_Kboard_Objfwd; - XKBOARD_OBJFWD (val)->offset = offset; - SET_SYMBOL_VALUE (sym, val); + ko_fwd->type = Lisp_Fwd_Kboard_Obj; + ko_fwd->offset = offset; + XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; + SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd); } /* Record the value of load-path used at the start of dumping @@ -4052,7 +3975,7 @@ defvar_kboard (const char *namestring, int offset) static Lisp_Object dump_path; void -init_lread () +init_lread (void) { char *normal; int turn_off_warning = 0; @@ -4245,9 +4168,7 @@ init_lread () does not exist. Print it on stderr and put it in *Messages*. */ void -dir_warning (format, dirname) - char *format; - Lisp_Object dirname; +dir_warning (const char *format, Lisp_Object dirname) { char *buffer = (char *) alloca (SCHARS (dirname) + strlen (format) + 5); @@ -4260,7 +4181,7 @@ dir_warning (format, dirname) } void -syms_of_lread () +syms_of_lread (void) { defsubr (&Sread); defsubr (&Sread_from_string); @@ -4375,20 +4296,20 @@ the rest of the FORMS. */); Vafter_load_alist = Qnil; DEFVAR_LISP ("load-history", &Vload_history, - doc: /* Alist mapping file names to symbols and features. -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 file name is absolute and is the true file name (i.e. it doesn't -contain symbolic links) of the loaded file. - -The remaining elements of each list are symbols defined as variables -and cons cells of the form `(provide . FEATURE)', `(require . FEATURE)', -`(defun . FUNCTION)', `(autoload . SYMBOL)', `(defface . 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. + doc: /* Alist mapping loaded file names to symbols and features. +Each alist element should be a list (FILE-NAME ENTRIES...), where +FILE-NAME is the name of a file that has been loaded into Emacs. +The file name is absolute and true (i.e. it doesn't contain symlinks). +As an exception, one of the alist elements may have FILE-NAME nil, +for symbols and features not associated with any file. + +The remaining ENTRIES in the alist element describe the functions and +variables defined in that file, the features provided, and the +features required. Each entry has the form `(provide . FEATURE)', +`(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)', +`(defface . SYMBOL)', or `(t . SYMBOL)'. In addition, an entry `(t +. SYMBOL)' may precede an entry `(defun . FUNCTION)', and means that +SYMBOL was an autoload before this file redefined it as a function. During preloading, the file name recorded is relative to the main Lisp directory. These file names are converted to absolute at startup. */);