X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7e09ef09a479731d01b1ca46e94ddadd73ac98e3..2c59be9c67e50f70f0407794bfe79038ded58a72:/src/lread.c diff --git a/src/lread.c b/src/lread.c index 6463e1051b..ae175296dd 100644 --- a/src/lread.c +++ b/src/lread.c @@ -18,6 +18,8 @@ GNU General Public License for more details. You should have received a copy of the GNU General Public License along with GNU Emacs. If not, see . */ +/* Tell globals.h to define tables needed by init_obarray. */ +#define DEFINE_SYMBOLS #include #include "sysstdio.h" @@ -26,6 +28,7 @@ along with GNU Emacs. If not, see . */ #include #include #include /* For CHAR_BIT. */ +#include #include #include "lisp.h" #include "intervals.h" @@ -64,32 +67,6 @@ along with GNU Emacs. If not, see . */ #define file_tell ftell #endif -/* Hash table read constants. */ -static Lisp_Object Qhash_table, Qdata; -static Lisp_Object Qtest; -Lisp_Object Qsize; -static Lisp_Object Qweakness; -static Lisp_Object Qrehash_size; -static Lisp_Object Qrehash_threshold; - -static Lisp_Object Qread_char, Qget_file_char, Qcurrent_load_list; -Lisp_Object Qstandard_input; -Lisp_Object Qvariable_documentation; -static Lisp_Object Qascii_character, Qload, Qload_file_name; -Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction; -static Lisp_Object Qinhibit_file_name_operation; -static Lisp_Object Qeval_buffer_list; -Lisp_Object Qlexical_binding; -static Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */ - -/* Used instead of Qget_file_char while loading *.elc files compiled - by Emacs 21 or older. */ -static Lisp_Object Qget_emacs_mule_file_char; - -static Lisp_Object Qload_force_doc_strings; - -static Lisp_Object Qload_in_progress; - /* The association list of objects read with the #n=object form. Each member of the list has the form (n . object), and is used to look up the object for the corresponding #n# construct. @@ -133,7 +110,6 @@ static file_offset prev_saved_doc_string_position; Fread initializes this to false, so we need not specbind it or worry about what happens to it when there is an error. */ static bool new_backquote_flag; -static Lisp_Object Qold_style_backquotes; /* A list of file names for files being loaded in Fload. Used to check for recursive loads. */ @@ -972,7 +948,7 @@ load_warn_old_style_backquotes (Lisp_Object file) if (!NILP (Vold_style_backquotes)) { AUTO_STRING (format, "Loading `%s': old-style backquotes detected!"); - Fmessage (2, (Lisp_Object []) {format, file}); + CALLN (Fmessage, format, file); } } @@ -1057,13 +1033,9 @@ Return t if the file exists and loads successfully. */) bool compiled = 0; Lisp_Object handler; bool safe_p = 1; - const char *fmode = "r"; + const char *fmode = "r" FOPEN_TEXT; int version; -#ifdef DOS_NT - fmode = "rt"; -#endif /* DOS_NT */ - CHECK_STRING (file); /* If file name is magic, call the handler. */ @@ -1125,12 +1097,7 @@ Return t if the file exists and loads successfully. */) { suffixes = Fget_load_suffixes (); if (NILP (must_suffix)) - { - Lisp_Object arg[2]; - arg[0] = suffixes; - arg[1] = Vload_file_rep_suffixes; - suffixes = Fappend (2, arg); - } + suffixes = CALLN (Fappend, suffixes, Vload_file_rep_suffixes); } fd = openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer); @@ -1252,10 +1219,7 @@ Return t if the file exists and loads successfully. */) compiled = 1; efound = ENCODE_FILE (found); - -#ifdef DOS_NT - fmode = "rb"; -#endif /* DOS_NT */ + fmode = "r" FOPEN_BINARY; /* openp already checked for newness, no point doing it again. FIXME would be nice to get a message when openp @@ -1430,8 +1394,6 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) return file; } -static Lisp_Object Qdir_ok; - /* Search for a file whose name is STR, looking in directories in the Lisp list PATH, and trying suffixes from SUFFIX. On success, return a file descriptor (or 1 or -2 as described below). @@ -3401,10 +3363,6 @@ string_to_number (char const *string, int base, bool ignore_trailing) bool float_syntax = 0; double value = 0; - /* Compute NaN and infinities using a variable, to cope with compilers that - think they are smarter than we are. */ - double zero = 0; - /* Negate the value ourselves. This treats 0, NaNs, and infinity properly on IEEE floating point hosts, and works around a formerly-common bug where atof ("-0.0") drops the sign. */ @@ -3456,30 +3414,15 @@ string_to_number (char const *string, int base, bool ignore_trailing) { state |= E_EXP; cp += 3; - value = 1.0 / zero; + value = INFINITY; } else if (cp[-1] == '+' && cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N') { state |= E_EXP; cp += 3; - 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. */ + /* NAN is a "positive" NaN on all known Emacs hosts. */ + value = NAN; } else cp = ecp; @@ -3792,30 +3735,38 @@ check_obarray (Lisp_Object obarray) return obarray; } -/* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */ +/* Intern symbol SYM in OBARRAY using bucket INDEX. */ -Lisp_Object -intern_driver (Lisp_Object string, Lisp_Object obarray, ptrdiff_t index) +static Lisp_Object +intern_sym (Lisp_Object sym, Lisp_Object obarray, Lisp_Object index) { - Lisp_Object *ptr, sym = Fmake_symbol (string); + Lisp_Object *ptr; XSYMBOL (sym)->interned = (EQ (obarray, initial_obarray) ? SYMBOL_INTERNED_IN_INITIAL_OBARRAY : SYMBOL_INTERNED); - if ((SREF (string, 0) == ':') && EQ (obarray, initial_obarray)) + if (SREF (SYMBOL_NAME (sym), 0) == ':' && EQ (obarray, initial_obarray)) { XSYMBOL (sym)->constant = 1; XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL; SET_SYMBOL_VAL (XSYMBOL (sym), sym); } - ptr = aref_addr (obarray, index); + ptr = aref_addr (obarray, XINT (index)); set_symbol_next (sym, SYMBOLP (*ptr) ? XSYMBOL (*ptr) : NULL); *ptr = sym; return sym; } +/* Intern a symbol with name STRING in OBARRAY using bucket INDEX. */ + +Lisp_Object +intern_driver (Lisp_Object string, Lisp_Object obarray, Lisp_Object index) +{ + return intern_sym (Fmake_symbol (string), obarray, index); +} + /* Intern the C string STR: return a symbol with that name, interned in the current obarray. */ @@ -3826,7 +3777,7 @@ intern_1 (const char *str, ptrdiff_t len) Lisp_Object tem = oblookup (obarray, str, len, len); return SYMBOLP (tem) ? tem : intern_driver (make_string (str, len), - obarray, XINT (tem)); + obarray, tem); } Lisp_Object @@ -3840,10 +3791,27 @@ intern_c_string_1 (const char *str, ptrdiff_t len) /* Creating a non-pure string from a string literal not implemented yet. We could just use make_string here and live with the extra copy. */ eassert (!NILP (Vpurify_flag)); - tem = intern_driver (make_pure_c_string (str, len), obarray, XINT (tem)); + tem = intern_driver (make_pure_c_string (str, len), obarray, tem); } return tem; } + +static void +define_symbol (Lisp_Object sym, char const *str) +{ + ptrdiff_t len = strlen (str); + Lisp_Object string = make_pure_c_string (str, len); + init_symbol (sym, string); + + /* Qunbound is uninterned, so that it's not confused with any symbol + 'unbound' created by a Lisp program. */ + if (! EQ (sym, Qunbound)) + { + Lisp_Object bucket = oblookup (initial_obarray, str, len, len); + eassert (INTEGERP (bucket)); + intern_sym (sym, initial_obarray, bucket); + } +} DEFUN ("intern", Fintern, Sintern, 1, 2, 0, doc: /* Return the canonical symbol whose name is STRING. @@ -3859,8 +3827,8 @@ it defaults to the value of `obarray'. */) tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); if (!SYMBOLP (tem)) - tem = intern_driver (NILP (Vpurify_flag) ? string - : Fpurecopy (string), obarray, XINT (tem)); + tem = intern_driver (NILP (Vpurify_flag) ? string : Fpurecopy (string), + obarray, tem); return tem; } @@ -4059,24 +4027,17 @@ init_obarray (void) initial_obarray = Vobarray; staticpro (&initial_obarray); - Qunbound = Fmake_symbol (build_pure_c_string ("unbound")); - /* 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 manually. */ - SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound); - set_symbol_function (Qunbound, Qnil); - set_symbol_plist (Qunbound, Qnil); + for (int i = 0; i < ARRAYELTS (lispsym); i++) + define_symbol (builtin_lisp_symbol (i), defsym_name[i]); + + DEFSYM (Qunbound, "unbound"); + + DEFSYM (Qnil, "nil"); SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); XSYMBOL (Qnil)->constant = 1; XSYMBOL (Qnil)->declared_special = true; - set_symbol_plist (Qnil, Qnil); - set_symbol_function (Qnil, Qnil); - Qt = intern_c_string ("t"); + DEFSYM (Qt, "t"); SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); XSYMBOL (Qt)->constant = 1; XSYMBOL (Qt)->declared_special = true; @@ -4410,12 +4371,10 @@ init_lread (void) /* Replace nils from EMACSLOADPATH by default. */ while (CONSP (elpath)) { - Lisp_Object arg[2]; elem = XCAR (elpath); elpath = XCDR (elpath); - arg[0] = Vload_path; - arg[1] = NILP (elem) ? default_lpath : Fcons (elem, Qnil); - Vload_path = Fappend (2, arg); + Vload_path = CALLN (Fappend, Vload_path, + NILP (elem) ? default_lpath : list1 (elem)); } } /* Fmemq (Qnil, Vload_path) */ } @@ -4729,7 +4688,11 @@ that are loaded before your customizations are read! */); DEFSYM (Qstandard_input, "standard-input"); DEFSYM (Qread_char, "read-char"); DEFSYM (Qget_file_char, "get-file-char"); + + /* Used instead of Qget_file_char while loading *.elc files compiled + by Emacs 21 or older. */ DEFSYM (Qget_emacs_mule_file_char, "get-emacs-mule-file-char"); + DEFSYM (Qload_force_doc_strings, "load-force-doc-strings"); DEFSYM (Qbackquote, "`");