X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/91f2d272895257f23596075a0cc42e6e5f4e490f..844e0de1bc2bf56118b749f50a4880db7c918fd5:/src/lread.c diff --git a/src/lread.c b/src/lread.c index b42ac5908e..9ce2bcb7a2 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1,6 +1,6 @@ /* Lisp parsing and input streams. -Copyright (C) 1985-1989, 1993-1995, 1997-2013 Free Software Foundation, +Copyright (C) 1985-1989, 1993-1995, 1997-2014 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -64,6 +64,8 @@ along with GNU Emacs. If not, see . */ #define file_tell ftell #endif +static SCM obarrays; + /* Hash table read constants. */ static Lisp_Object Qhash_table, Qdata; static Lisp_Object Qtest, Qsize; @@ -213,7 +215,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte) else { c = BUF_FETCH_BYTE (inbuffer, pt_byte); - if (! ASCII_BYTE_P (c)) + if (! ASCII_CHAR_P (c)) c = BYTE8_TO_CHAR (c); pt_byte++; } @@ -242,7 +244,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte) else { c = BUF_FETCH_BYTE (inbuffer, bytepos); - if (! ASCII_BYTE_P (c)) + if (! ASCII_CHAR_P (c)) c = BYTE8_TO_CHAR (c); bytepos++; } @@ -324,7 +326,7 @@ readchar (Lisp_Object readcharfun, bool *multibyte) return c; if (multibyte) *multibyte = 1; - if (ASCII_BYTE_P (c)) + if (ASCII_CHAR_P (c)) return c; if (emacs_mule_encoding) return read_emacs_mule_char (c, readbyte, readcharfun); @@ -1030,6 +1032,10 @@ in `load-file-rep-suffixes'. If MUST-SUFFIX is non-nil, only the return value of `get-load-suffixes' is used, i.e. the file name is required to have a non-empty suffix. +When searching suffixes, this function normally stops at the first +one that exists. If the option `load-prefer-newer' is non-nil, +however, it tries all suffixes, and uses whichever file is the newest. + Loading a file records its definitions, and its `provide' and `require' calls, in an element of `load-history' whose car is the file name loaded. See `load-history'. @@ -1042,10 +1048,9 @@ Return t if the file exists and loads successfully. */) (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, Lisp_Object nosuffix, Lisp_Object must_suffix) { - FILE *stream; + FILE *stream = NULL; int fd; - int fd_index; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); struct gcpro gcpro1, gcpro2, gcpro3; Lisp_Object found, efound, hist_file_name; /* True means we printed the ".el is newer" message. */ @@ -1081,8 +1086,10 @@ Return t if the file exists and loads successfully. */) { file = internal_condition_case_1 (Fsubstitute_in_file_name, file, Qt, load_error_handler); - if (NILP (file)) - return Qnil; + if (NILP (file)) { + dynwind_end (); + return Qnil; + } } else file = Fsubstitute_in_file_name (file); @@ -1130,7 +1137,7 @@ Return t if the file exists and loads successfully. */) } } - fd = openp (Vload_path, file, suffixes, &found, Qnil); + fd = openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer); UNGCPRO; } @@ -1138,6 +1145,7 @@ Return t if the file exists and loads successfully. */) { if (NILP (noerror)) report_file_error ("Cannot open load file", file); + dynwind_end (); return Qnil; } @@ -1155,8 +1163,10 @@ Return t if the file exists and loads successfully. */) handler = Ffind_file_name_handler (found, Qt); else handler = Ffind_file_name_handler (found, Qload); - if (! NILP (handler)) - return call5 (handler, Qload, found, noerror, nomessage, Qt); + if (! NILP (handler)) { + dynwind_end (); + return call5 (handler, Qload, found, noerror, nomessage, Qt); + } #ifdef DOS_NT /* Tramp has to deal with semi-broken packages that prepend drive letters to remote files. For that reason, Tramp @@ -1175,15 +1185,10 @@ Return t if the file exists and loads successfully. */) #endif } - if (fd < 0) + if (fd >= 0) { - /* Pacify older GCC with --enable-gcc-warnings. */ - IF_LINT (fd_index = 0); - } - else - { - fd_index = SPECPDL_INDEX (); - record_unwind_protect_int (close_file_unwind, fd); + record_unwind_protect_ptr (close_file_ptr_unwind, &fd); + record_unwind_protect_ptr (fclose_ptr_unwind, &stream); } /* Check if we're stuck in a recursive load cycle. @@ -1253,29 +1258,36 @@ Return t if the file exists and loads successfully. */) #ifdef DOS_NT fmode = "rb"; #endif /* DOS_NT */ - result = stat (SSDATA (efound), &s1); - if (result == 0) - { - SSET (efound, SBYTES (efound) - 1, 0); - result = stat (SSDATA (efound), &s2); - SSET (efound, SBYTES (efound) - 1, 'c'); - } - if (result == 0 - && timespec_cmp (get_stat_mtime (&s1), get_stat_mtime (&s2)) < 0) - { - /* Make the progress messages mention that source is newer. */ - newer = 1; + /* openp already checked for newness, no point doing it again. + FIXME would be nice to get a message when openp + ignores suffix order due to load_prefer_newer. */ + if (!load_prefer_newer) + { + result = stat (SSDATA (efound), &s1); + if (result == 0) + { + SSET (efound, SBYTES (efound) - 1, 0); + result = stat (SSDATA (efound), &s2); + SSET (efound, SBYTES (efound) - 1, 'c'); + } - /* If we won't print another message, mention this anyway. */ - if (!NILP (nomessage) && !force_load_messages) - { - Lisp_Object msg_file; - msg_file = Fsubstring (found, make_number (0), make_number (-1)); - message_with_string ("Source file `%s' newer than byte-compiled file", - msg_file, 1); - } - } + if (result == 0 + && timespec_cmp (get_stat_mtime (&s1), get_stat_mtime (&s2)) < 0) + { + /* Make the progress messages mention that source is newer. */ + newer = 1; + + /* If we won't print another message, mention this anyway. */ + if (!NILP (nomessage) && !force_load_messages) + { + Lisp_Object msg_file; + msg_file = Fsubstring (found, make_number (0), make_number (-1)); + message_with_string ("Source file `%s' newer than byte-compiled file", + msg_file, 1); + } + } + } /* !load_prefer_newer */ UNGCPRO; } } @@ -1289,12 +1301,13 @@ Return t if the file exists and loads successfully. */) if (fd >= 0) { emacs_close (fd); - clear_unwind_protect (fd_index); + fd = -1; } val = call4 (Vload_source_file_function, found, hist_file_name, NILP (noerror) ? Qnil : Qt, (NILP (nomessage) || force_load_messages) ? Qnil : Qt); - return unbind_to (count, val); + dynwind_end (); + return val; } } @@ -1312,7 +1325,7 @@ Return t if the file exists and loads successfully. */) { #ifdef WINDOWSNT emacs_close (fd); - clear_unwind_protect (fd_index); + fd = -1; efound = ENCODE_FILE (found); stream = emacs_fopen (SSDATA (efound), fmode); #else @@ -1321,7 +1334,6 @@ Return t if the file exists and loads successfully. */) } if (! stream) report_file_error ("Opening stdio stream", file); - set_unwind_protect_ptr (fd_index, fclose_unwind, stream); if (! NILP (Vpurify_flag)) Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list); @@ -1359,7 +1371,7 @@ Return t if the file exists and loads successfully. */) readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, 0, Qnil, Qnil, Qnil, Qnil); } - unbind_to (count, Qnil); + dynwind_end (); /* Run any eval-after-load forms for this file. */ if (!NILP (Ffboundp (Qdo_after_load_evaluation))) @@ -1414,7 +1426,7 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */) (Lisp_Object filename, Lisp_Object path, Lisp_Object suffixes, Lisp_Object predicate) { Lisp_Object file; - int fd = openp (path, filename, suffixes, &file, predicate); + int fd = openp (path, filename, suffixes, &file, predicate, false); if (NILP (predicate) && fd >= 0) emacs_close (fd); return file; @@ -1441,22 +1453,31 @@ static Lisp_Object Qdir_ok; nil is stored there on failure. If the file we find is remote, return -2 - but store the found remote file name in *STOREPTR. */ + but store the found remote file name in *STOREPTR. + + If NEWER is true, try all SUFFIXes and return the result for the + newest file that exists. Does not apply to remote files, + or if PREDICATE is specified. */ int openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, - Lisp_Object *storeptr, Lisp_Object predicate) + Lisp_Object *storeptr, Lisp_Object predicate, bool newer) { ptrdiff_t fn_size = 100; char buf[100]; char *fn = buf; - bool absolute = 0; + bool absolute; ptrdiff_t want_length; Lisp_Object filename; - struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6; - Lisp_Object string, tail, encoded_fn; + struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6, gcpro7; + Lisp_Object string, tail, encoded_fn, save_string; ptrdiff_t max_suffix_len = 0; int last_errno = ENOENT; + int save_fd = -1; + + /* The last-modified time of the newest matching file found. + Initialize it to something less than all valid timestamps. */ + struct timespec save_mtime = make_timespec (TYPE_MINIMUM (time_t), -1); CHECK_STRING (str); @@ -1467,14 +1488,13 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, SBYTES (XCAR (tail))); } - string = filename = encoded_fn = Qnil; - GCPRO6 (str, string, filename, path, suffixes, encoded_fn); + string = filename = encoded_fn = save_string = Qnil; + GCPRO7 (str, string, save_string, filename, path, suffixes, encoded_fn); if (storeptr) *storeptr = Qnil; - if (complete_filename_p (str)) - absolute = 1; + absolute = complete_filename_p (str); for (; CONSP (path); path = XCDR (path)) { @@ -1500,7 +1520,8 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, for (tail = NILP (suffixes) ? list1 (empty_unibyte_string) : suffixes; CONSP (tail); tail = XCDR (tail)) { - ptrdiff_t fnlen, lsuffix = SBYTES (XCAR (tail)); + Lisp_Object suffix = XCAR (tail); + ptrdiff_t fnlen, lsuffix = SBYTES (suffix); Lisp_Object handler; /* Concatenate path element/specified name with the suffix. @@ -1511,7 +1532,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, ? 2 : 0); fnlen = SBYTES (filename) - prefixlen; memcpy (fn, SDATA (filename) + prefixlen, fnlen); - memcpy (fn + fnlen, SDATA (XCAR (tail)), lsuffix + 1); + memcpy (fn + fnlen, SDATA (suffix), lsuffix + 1); fnlen += lsuffix; /* Check that the file exists and is not a directory. */ /* We used to only check for handlers on non-absolute file names: @@ -1521,7 +1542,18 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, handler = Ffind_file_name_handler (filename, Qfile_exists_p); It's not clear why that was the case and it breaks things like (load "/bar.el") where the file is actually "/bar.el.gz". */ - string = make_string (fn, fnlen); + /* make_string has its own ideas on when to return a unibyte + string and when a multibyte string, but we know better. + We must have a unibyte string when dumping, since + file-name encoding is shaky at best at that time, and in + particular default-file-name-coding-system is reset + several times during loadup. We therefore don't want to + encode the file before passing it to file I/O library + functions. */ + if (!STRING_MULTIBYTE (filename) && !STRING_MULTIBYTE (suffix)) + string = make_unibyte_string (fn, fnlen); + else + string = make_string (fn, fnlen); handler = Ffind_file_name_handler (string, Qfile_exists_p); if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate)) { @@ -1532,30 +1564,31 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, { Lisp_Object tmp = call1 (predicate, string); if (NILP (tmp)) - exists = 0; + exists = false; else if (EQ (tmp, Qdir_ok) || NILP (Ffile_directory_p (string))) - exists = 1; + exists = true; else { - exists = 0; + exists = false; last_errno = EISDIR; } } if (exists) { - /* We succeeded; return this descriptor and filename. */ - if (storeptr) - *storeptr = string; - UNGCPRO; - return -2; + /* We succeeded; return this descriptor and filename. */ + if (storeptr) + *storeptr = string; + UNGCPRO; + return -2; } } else { int fd; const char *pfn; + struct stat st; encoded_fn = ENCODE_FILE (string); pfn = SSDATA (encoded_fn); @@ -1586,7 +1619,6 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, } else { - struct stat st; int err = (fstat (fd, &st) != 0 ? errno : S_ISDIR (st.st_mode) ? EISDIR : 0); if (err) @@ -1600,12 +1632,39 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, if (fd >= 0) { - /* We succeeded; return this descriptor and filename. */ - if (storeptr) - *storeptr = string; - UNGCPRO; - return fd; + if (newer && !NATNUMP (predicate)) + { + struct timespec mtime = get_stat_mtime (&st); + + if (timespec_cmp (mtime, save_mtime) <= 0) + emacs_close (fd); + else + { + if (0 <= save_fd) + emacs_close (save_fd); + save_fd = fd; + save_mtime = mtime; + save_string = string; + } + } + else + { + /* We succeeded; return this descriptor and filename. */ + if (storeptr) + *storeptr = string; + UNGCPRO; + return fd; + } } + + /* No more suffixes. Return the newest. */ + if (0 <= save_fd && ! CONSP (XCDR (tail))) + { + if (storeptr) + *storeptr = save_string; + UNGCPRO; + return save_fd; + } } } if (absolute) @@ -1705,6 +1764,29 @@ end_of_file_error (void) xsignal0 (Qend_of_file); } +static Lisp_Object +readevalloop_eager_expand_eval (Lisp_Object val, Lisp_Object macroexpand) +{ + /* If we macroexpand the toplevel form non-recursively and it ends + up being a `progn' (or if it was a progn to start), treat each + form in the progn as a top-level form. This way, if one form in + the progn defines a macro, that macro is in effect when we expand + the remaining forms. See similar code in bytecomp.el. */ + val = call2 (macroexpand, val, Qnil); + if (EQ (CAR_SAFE (val), Qprogn)) + { + Lisp_Object subforms = XCDR (val); + val = Qnil; + for (; CONSP (subforms); subforms = XCDR (subforms)) + val = readevalloop_eager_expand_eval (XCAR (subforms), + macroexpand); + } + else + val = eval_sub (call2 (macroexpand, val, Qt)); + + return val; +} + /* UNIBYTE specifies how to set load_convert_to_unibyte for this invocation. READFUN, if non-nil, is used instead of `read'. @@ -1722,7 +1804,7 @@ readevalloop (Lisp_Object readcharfun, { register int c; register Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); struct gcpro gcpro1, gcpro2, gcpro3, gcpro4; struct buffer *b = 0; bool continue_reading_p; @@ -1784,7 +1866,7 @@ readevalloop (Lisp_Object readcharfun, continue_reading_p = 1; while (continue_reading_p) { - ptrdiff_t count1 = SPECPDL_INDEX (); + dynwind_begin (); if (b != 0 && !BUFFER_LIVE_P (b)) error ("Reading from killed buffer"); @@ -1827,7 +1909,7 @@ readevalloop (Lisp_Object readcharfun, } if (c < 0) { - unbind_to (count1, Qnil); + dynwind_end (); break; } @@ -1868,12 +1950,13 @@ readevalloop (Lisp_Object readcharfun, start = Fpoint_marker (); /* Restore saved point and BEGV. */ - unbind_to (count1, Qnil); + dynwind_end (); /* Now eval what we just read. */ if (!NILP (macroexpand)) - val = call1 (macroexpand, val); - val = eval_sub (val); + val = readevalloop_eager_expand_eval (val, macroexpand); + else + val = eval_sub (val); if (printflag) { @@ -1892,7 +1975,7 @@ readevalloop (Lisp_Object readcharfun, UNGCPRO; - unbind_to (count, Qnil); + dynwind_end (); } DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "", @@ -1911,7 +1994,7 @@ DO-ALLOW-PRINT, if non-nil, specifies that `print' and related This function preserves the position of point. */) (Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print) { - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); Lisp_Object tem, buf; if (NILP (buffer)) @@ -1936,7 +2019,7 @@ This function preserves the position of point. */) specbind (Qlexical_binding, lisp_file_lexically_bound_p (buf) ? Qt : Qnil); readevalloop (buf, 0, filename, !NILP (printflag), unibyte, Qnil, Qnil, Qnil); - unbind_to (count, Qnil); + dynwind_end (); return Qnil; } @@ -1956,7 +2039,7 @@ This function does not move point. */) (Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function) { /* FIXME: Do the eval-sexp-add-defvars dance! */ - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); Lisp_Object tem, cbuf; cbuf = Fcurrent_buffer (); @@ -1973,7 +2056,8 @@ This function does not move point. */) !NILP (printflag), Qnil, read_function, start, end); - return unbind_to (count, Qnil); + dynwind_end (); + return Qnil; } @@ -1995,7 +2079,7 @@ STREAM or the value of `standard-input' may be: if (EQ (stream, Qt)) stream = Qread_char; if (EQ (stream, Qread_char)) - /* FIXME: ¿¡ When is this used !? */ + /* FIXME: ?! When is this used !? */ return call1 (intern ("read-minibuffer"), build_string ("Lisp expression: ")); @@ -2553,7 +2637,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE); return tmp; } - invalid_syntax ("#^^"); + invalid_syntax ("#^" "^"); } invalid_syntax ("#^"); } @@ -2565,9 +2649,8 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (c == '"') { Lisp_Object tmp, val; - EMACS_INT size_in_chars - = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1) - / BOOL_VECTOR_BITS_PER_CHAR); + EMACS_INT size_in_chars = bool_vector_bytes (XFASTINT (length)); + unsigned char *data; UNREAD (c); tmp = read1 (readcharfun, pch, first_in_list); @@ -2581,11 +2664,12 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) == (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR))) invalid_syntax ("#&..."); - val = Fmake_bool_vector (length, Qnil); - memcpy (XBOOL_VECTOR (val)->data, SDATA (tmp), size_in_chars); + val = make_uninit_bool_vector (XFASTINT (length)); + data = bool_vector_uchar_data (val); + memcpy (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] + data[size_in_chars - 1] &= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1; return val; } @@ -2596,9 +2680,10 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) /* Accept compiled functions at read-time so that we don't have to build them using function calls. */ Lisp_Object tmp; + struct Lisp_Vector *vec; tmp = read_vector (readcharfun, 1); - struct Lisp_Vector* vec = XVECTOR (tmp); - if (vec->header.size==0) + vec = XVECTOR (tmp); + if (vec->header.size == 0) invalid_syntax ("Empty byte-code object"); make_byte_code (vec); return tmp; @@ -2695,7 +2780,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (saved_doc_string_size == 0) { - saved_doc_string = xmalloc (nskip + extra); + saved_doc_string = xmalloc_atomic (nskip + extra); saved_doc_string_size = nskip + extra; } if (nskip > saved_doc_string_size) @@ -3224,58 +3309,52 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj /* Recurse according to subtree's type. Every branch must return a Lisp_Object. */ - switch (XTYPE (subtree)) + if (VECTORLIKEP (subtree)) { - case Lisp_Vectorlike: - { - ptrdiff_t i, length = 0; - if (BOOL_VECTOR_P (subtree)) - return subtree; /* No sub-objects anyway. */ - else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree) - || COMPILEDP (subtree) || HASH_TABLE_P (subtree)) - length = ASIZE (subtree) & PSEUDOVECTOR_SIZE_MASK; - else if (VECTORP (subtree)) - length = ASIZE (subtree); - else - /* An unknown pseudovector may contain non-Lisp fields, so we - can't just blindly traverse all its fields. We used to call - `Flength' which signaled `sequencep', so I just preserved this - behavior. */ - wrong_type_argument (Qsequencep, subtree); - - for (i = 0; i < length; i++) - SUBSTITUTE (AREF (subtree, i), - ASET (subtree, i, true_value)); - return subtree; - } - - case Lisp_Cons: - { - SUBSTITUTE (XCAR (subtree), - XSETCAR (subtree, true_value)); - SUBSTITUTE (XCDR (subtree), - XSETCDR (subtree, true_value)); - return subtree; - } - - case Lisp_String: - { - /* Check for text properties in each interval. - substitute_in_interval contains part of the logic. */ - - INTERVAL root_interval = string_intervals (subtree); - Lisp_Object arg = Fcons (object, placeholder); + ptrdiff_t i, length = 0; + if (BOOL_VECTOR_P (subtree)) + return subtree; /* No sub-objects anyway. */ + else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree) + || COMPILEDP (subtree) || HASH_TABLE_P (subtree)) + length = ASIZE (subtree) & PSEUDOVECTOR_SIZE_MASK; + else if (VECTORP (subtree)) + length = ASIZE (subtree); + else + /* An unknown pseudovector may contain non-Lisp fields, so we + can't just blindly traverse all its fields. We used to call + `Flength' which signaled `sequencep', so I just preserved this + behavior. */ + wrong_type_argument (Qsequencep, subtree); + + for (i = 0; i < length; i++) + SUBSTITUTE (AREF (subtree, i), + ASET (subtree, i, true_value)); + return subtree; + } + else if (CONSP (subtree)) + { + SUBSTITUTE (XCAR (subtree), + XSETCAR (subtree, true_value)); + SUBSTITUTE (XCDR (subtree), + XSETCDR (subtree, true_value)); + return subtree; + } + else if (STRINGP (subtree)) + { + /* Check for text properties in each interval. + substitute_in_interval contains part of the logic. */ - traverse_intervals_noorder (root_interval, - &substitute_in_interval, arg); + INTERVAL root_interval = string_intervals (subtree); + Lisp_Object arg = Fcons (object, placeholder); - return subtree; - } + traverse_intervals_noorder (root_interval, + &substitute_in_interval, arg); - /* Other types don't recurse any further. */ - default: return subtree; } + else + /* Other types don't recurse any further. */ + return subtree; } /* Helper function for substitute_object_recurse. */ @@ -3454,7 +3533,6 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag) ptrdiff_t i, size; Lisp_Object *ptr; Lisp_Object tem, item, vector; - struct Lisp_Cons *otem; Lisp_Object len; tem = read_list (1, readcharfun); @@ -3499,10 +3577,8 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag) if (!CONSP (item)) error ("Invalid byte code"); - otem = XCONS (item); bytestr = XCAR (item); item = XCDR (item); - free_cons (otem); } /* Now handle the bytecode slot. */ @@ -3519,14 +3595,12 @@ read_vector (Lisp_Object readcharfun, bool bytecodeflag) } } ASET (vector, i, item); - otem = XCONS (tem); tem = Fcdr (tem); - free_cons (otem); } return vector; } -/* FLAG means check for ] to terminate rather than ) and . */ +/* FLAG means check for ']' to terminate rather than ')' and '.'. */ static Lisp_Object read_list (bool flag, Lisp_Object readcharfun) @@ -3681,9 +3755,15 @@ read_list (bool flag, Lisp_Object readcharfun) static Lisp_Object initial_obarray; -/* `oblookup' stores the bucket number here, for the sake of Funintern. */ - -static size_t oblookup_last_bucket_number; +Lisp_Object +obhash (Lisp_Object obarray) +{ + Lisp_Object tem = scm_hashq_get_handle (obarrays, obarray); + if (SCM_UNLIKELY (scm_is_false (tem))) + tem = scm_hashq_create_handle_x (obarrays, obarray, + scm_make_obarray ()); + return scm_cdr (tem); +} /* Get an error if OBARRAY is not an obarray. If it is one, return it. */ @@ -3747,33 +3827,28 @@ it defaults to the value of `obarray'. */) tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); - if (!INTEGERP (tem)) + if (SYMBOLP (tem)) return tem; if (!NILP (Vpurify_flag)) string = Fpurecopy (string); - sym = Fmake_symbol (string); - if (EQ (obarray, initial_obarray)) - XSYMBOL (sym)->interned = SYMBOL_INTERNED_IN_INITIAL_OBARRAY; - else - XSYMBOL (sym)->interned = SYMBOL_INTERNED; + sym = scm_intern (scm_from_utf8_stringn (SSDATA (string), + SBYTES (string)), + obhash (obarray)); + initialize_symbol (sym, string); if ((SREF (string, 0) == ':') && EQ (obarray, initial_obarray)) { - XSYMBOL (sym)->constant = 1; - XSYMBOL (sym)->redirect = SYMBOL_PLAINVAL; + SET_SYMBOL_CONSTANT (XSYMBOL (sym), 1); + SET_SYMBOL_REDIRECT (XSYMBOL (sym), SYMBOL_PLAINVAL); SET_SYMBOL_VAL (XSYMBOL (sym), sym); } - ptr = aref_addr (obarray, XINT(tem)); - if (SYMBOLP (*ptr)) - set_symbol_next (sym, XSYMBOL (*ptr)); - else - set_symbol_next (sym, NULL); - *ptr = sym; - return sym; + return scm_intern (scm_from_utf8_stringn (SSDATA (string), + SBYTES (string)), + obhash (obarray)); } DEFUN ("intern-soft", Fintern_soft, Sintern_soft, 1, 2, 0, @@ -3803,138 +3878,100 @@ it defaults to the value of `obarray'. */) else return tem; } + +DEFUN ("find-symbol", Ffind_symbol, Sfind_symbol, 1, 2, 0, + doc: /* find-symbol */) + (Lisp_Object string, Lisp_Object obarray) +{ + Lisp_Object tem; + + obarray = check_obarray (NILP (obarray) ? Vobarray : obarray); + CHECK_STRING (string); + + tem = oblookup (obarray, SSDATA (string), SCHARS (string), SBYTES (string)); + if (INTEGERP (tem)) + return scm_values (scm_list_2 (Qnil, Qnil)); + else + return scm_values (scm_list_2 (tem, Qt)); +} DEFUN ("unintern", Funintern, Sunintern, 1, 2, 0, doc: /* Delete the symbol named NAME, if any, from OBARRAY. 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'. */) +OBARRAY, if nil, defaults to the value of the variable `obarray'. +usage: (unintern NAME OBARRAY) */) (Lisp_Object name, Lisp_Object obarray) { - register Lisp_Object string, tem; - size_t hash; + Lisp_Object string; + Lisp_Object tem; - if (NILP (obarray)) obarray = Vobarray; + if (NILP (obarray)) + obarray = Vobarray; obarray = check_obarray (obarray); if (SYMBOLP (name)) - string = SYMBOL_NAME (name); - else - { - CHECK_STRING (name); - string = name; - } - - tem = oblookup (obarray, SSDATA (string), - SCHARS (string), - SBYTES (string)); - if (INTEGERP (tem)) - return Qnil; - /* If arg was a symbol, don't delete anything but that symbol itself. */ - if (SYMBOLP (name) && !EQ (name, tem)) - return Qnil; - - /* There are plenty of other symbols which will screw up the Emacs - session if we unintern them, as well as even more ways to use - `setq' or `fset' or whatnot to make the Emacs session - unusable. Let's not go down this silly road. --Stef */ - /* if (EQ (tem, Qnil) || EQ (tem, Qt)) - error ("Attempt to unintern t or nil"); */ - - XSYMBOL (tem)->interned = SYMBOL_UNINTERNED; - - hash = oblookup_last_bucket_number; - - if (EQ (AREF (obarray, hash), tem)) { - if (XSYMBOL (tem)->next) - { - Lisp_Object sym; - XSETSYMBOL (sym, XSYMBOL (tem)->next); - ASET (obarray, hash, sym); - } - else - ASET (obarray, hash, make_number (0)); + if (! EQ (name, + scm_find_symbol (scm_symbol_to_string (name), + obhash (obarray)))) + return Qnil; + string = SYMBOL_NAME (name); } else { - Lisp_Object tail, following; - - for (tail = AREF (obarray, hash); - XSYMBOL (tail)->next; - tail = following) - { - XSETSYMBOL (following, XSYMBOL (tail)->next); - if (EQ (following, tem)) - { - set_symbol_next (tail, XSYMBOL (following)->next); - break; - } - } + CHECK_STRING (name); + string = name; + } - return Qt; + return (scm_is_true (scm_unintern (name, obhash (obarray))) ? Qt : Qnil); } /* Return the symbol in OBARRAY whose names matches the string of SIZE characters (SIZE_BYTE bytes) at PTR. - If there is no such symbol in OBARRAY, return nil. + If there is no such symbol, return the integer bucket number of + where the symbol would be if it were present. Also store the bucket number in oblookup_last_bucket_number. */ Lisp_Object oblookup (Lisp_Object obarray, register const char *ptr, ptrdiff_t size, ptrdiff_t size_byte) { - size_t hash; - size_t obsize; - register Lisp_Object tail; - Lisp_Object bucket, tem; + Lisp_Object sym; + Lisp_Object string2 = scm_from_utf8_stringn (ptr, size_byte); obarray = check_obarray (obarray); - obsize = ASIZE (obarray); - - /* This is sometimes needed in the middle of GC. */ - obsize &= ~ARRAY_MARK_FLAG; - hash = hash_string (ptr, size_byte) % obsize; - bucket = AREF (obarray, hash); - oblookup_last_bucket_number = hash; - if (EQ (bucket, make_number (0))) - ; - else if (!SYMBOLP (bucket)) - error ("Bad data in guts of obarray"); /* Like CADR error message. */ + sym = scm_find_symbol (string2, obhash (obarray)); + if (scm_is_true (sym) + && scm_is_true (scm_module_variable (symbol_module, sym))) + { + if (EQ (sym, Qnil_)) + return Qnil; + else if (EQ (sym, Qt_)) + return Qt; + else + return sym; + } else - for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next)) - { - if (SBYTES (SYMBOL_NAME (tail)) == size_byte - && SCHARS (SYMBOL_NAME (tail)) == size - && !memcmp (SDATA (SYMBOL_NAME (tail)), ptr, size_byte)) - return tail; - else if (XSYMBOL (tail)->next == 0) - break; - } - XSETINT (tem, hash); - return tem; + return make_number (0); } void map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Object arg) { - ptrdiff_t i; - register Lisp_Object tail; + Lisp_Object proc (Lisp_Object sym) + { + Lisp_Object tem = Ffind_symbol (SYMBOL_NAME (sym), obarray); + if (scm_is_true (scm_c_value_ref (tem, 1)) + && EQ (sym, scm_c_value_ref (tem, 0))) + fn (sym, arg); + return SCM_UNSPECIFIED; + } CHECK_VECTOR (obarray); - for (i = ASIZE (obarray) - 1; i >= 0; i--) - { - tail = AREF (obarray, i); - if (SYMBOLP (tail)) - while (1) - { - (*fn) (tail, arg); - if (XSYMBOL (tail)->next == 0) - break; - XSETSYMBOL (tail, XSYMBOL (tail)->next); - } - } + scm_obarray_for_each (scm_c_make_gsubr ("proc", 1, 0, 0, proc), + obhash (obarray)); } static void @@ -3969,56 +4006,62 @@ 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"); + obarrays = scm_make_hash_table (SCM_UNDEFINED); + scm_hashq_set_x (obarrays, Vobarray, SCM_UNDEFINED); + + Qnil = SCM_ELISP_NIL; + Qt = SCM_BOOL_T; + + Qnil_ = intern_c_string ("nil"); + SET_SYMBOL_VAL (XSYMBOL (Qnil_), Qnil); + SET_SYMBOL_CONSTANT (XSYMBOL (Qnil_), 1); + SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (Qnil_), 1); + + Qt_ = intern_c_string ("t"); + SET_SYMBOL_VAL (XSYMBOL (Qt_), Qt); + SET_SYMBOL_CONSTANT (XSYMBOL (Qt_), 1); + SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (Qt_), 1); - /* Fmake_symbol inits fields of new symbols with Qunbound and Qnil, - so those two need to be fixed manually. */ + Qunbound = Fmake_symbol (build_pure_c_string ("unbound")); SET_SYMBOL_VAL (XSYMBOL (Qunbound), Qunbound); - set_symbol_function (Qunbound, Qnil); - set_symbol_plist (Qunbound, Qnil); - SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil); - XSYMBOL (Qnil)->constant = 1; - XSYMBOL (Qnil)->declared_special = 1; - set_symbol_plist (Qnil, Qnil); - set_symbol_function (Qnil, Qnil); - - Qt = intern_c_string ("t"); - SET_SYMBOL_VAL (XSYMBOL (Qt), Qt); - XSYMBOL (Qnil)->declared_special = 1; - XSYMBOL (Qt)->constant = 1; /* Qt is correct even if CANNOT_DUMP. loadup.el will set to nil at end. */ Vpurify_flag = Qt; DEFSYM (Qvariable_documentation, "variable-documentation"); - read_buffer = xmalloc (size); + read_buffer = xmalloc_atomic (size); read_buffer_size = size; } void -defsubr (struct Lisp_Subr *sname) +defsubr (const char *lname, scm_t_subr gsubr_fn, short min_args, short max_args, const char *intspec) { - Lisp_Object sym, tem; - sym = intern_c_string (sname->symbol_name); - XSETPVECTYPE (sname, PVEC_SUBR); - XSETSUBR (tem, sname); - set_symbol_function (sym, tem); -} - -#ifdef NOTDEF /* Use fset in subr.el now! */ -void -defalias (struct Lisp_Subr *sname, char *string) -{ - Lisp_Object sym; - sym = intern (string); - XSETSUBR (XSYMBOL (sym)->function, sname); + Lisp_Object sym = intern_c_string (lname); + Lisp_Object fn; + switch (max_args) + { + case MANY: + fn = scm_c_make_gsubr (lname, 0, 0, 1, gsubr_fn); + break; + case UNEVALLED: + fn = Fcons (Qspecial_operator, + scm_c_make_gsubr (lname, 0, 0, 1, gsubr_fn)); + break; + default: + fn = scm_c_make_gsubr (lname, min_args, max_args - min_args, 0, gsubr_fn); + break; + } + set_symbol_function (sym, fn); + if (intspec) + { + Lisp_Object tem = ((*intspec != '(') + ? build_string (intspec) + : Fcar (Fread_from_string (build_string (intspec), + Qnil, Qnil))); + scm_set_procedure_property_x (fn, Qinteractive_form, tem); + } } -#endif /* NOTDEF */ /* Define an "integer variable"; a symbol whose value is forwarded to a C variable of type EMACS_INT. Sample call (with "xx" to fool make-docfile): @@ -4031,8 +4074,8 @@ defvar_int (struct Lisp_Intfwd *i_fwd, sym = intern_c_string (namestring); i_fwd->type = Lisp_Fwd_Int; i_fwd->intvar = address; - XSYMBOL (sym)->declared_special = 1; - XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; + SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym), 1); + SET_SYMBOL_REDIRECT (XSYMBOL (sym), SYMBOL_FORWARDED); SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd); } @@ -4046,8 +4089,8 @@ defvar_bool (struct Lisp_Boolfwd *b_fwd, sym = intern_c_string (namestring); b_fwd->type = Lisp_Fwd_Bool; b_fwd->boolvar = address; - XSYMBOL (sym)->declared_special = 1; - XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; + SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym), 1); + SET_SYMBOL_REDIRECT (XSYMBOL (sym), SYMBOL_FORWARDED); SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd); Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars); } @@ -4065,8 +4108,8 @@ defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd, sym = intern_c_string (namestring); o_fwd->type = Lisp_Fwd_Obj; o_fwd->objvar = address; - XSYMBOL (sym)->declared_special = 1; - XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; + SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym), 1); + SET_SYMBOL_REDIRECT (XSYMBOL (sym), SYMBOL_FORWARDED); SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd); } @@ -4089,22 +4132,22 @@ defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd, sym = intern_c_string (namestring); ko_fwd->type = Lisp_Fwd_Kboard_Obj; ko_fwd->offset = offset; - XSYMBOL (sym)->declared_special = 1; - XSYMBOL (sym)->redirect = SYMBOL_FORWARDED; + SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym), 1); + SET_SYMBOL_REDIRECT (XSYMBOL (sym), SYMBOL_FORWARDED); SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd); } -/* Check that the elements of Vload_path exist. */ +/* Check that the elements of lpath exist. */ static void -load_path_check (void) +load_path_check (Lisp_Object lpath) { Lisp_Object path_tail; /* The only elements that might not exist are those from PATH_LOADSEARCH, EMACSLOADPATH. Anything else is only added if it exists. */ - for (path_tail = Vload_path; !NILP (path_tail); path_tail = XCDR (path_tail)) + for (path_tail = lpath; !NILP (path_tail); path_tail = XCDR (path_tail)) { Lisp_Object dirfile; dirfile = Fcar (path_tail); @@ -4117,45 +4160,40 @@ load_path_check (void) } } -/* Record the value of load-path used at the start of dumping - so we can see if the site changed it later during dumping. */ -static Lisp_Object dump_path; +/* Return the default load-path, to be used if EMACSLOADPATH is unset. + This does not include the standard site-lisp directories + under the installation prefix (i.e., PATH_SITELOADSEARCH), + but it does (unless no_site_lisp is set) include site-lisp + directories in the source/build directories if those exist and we + are running uninstalled. -/* Compute the default Vload_path, with the following logic: - If CANNOT_DUMP: - use EMACSLOADPATH env-var if set; otherwise use PATH_LOADSEARCH, - prepending PATH_SITELOADSEARCH unless --no-site-lisp. + Uses the following logic: + If CANNOT_DUMP: Use PATH_LOADSEARCH. The remainder is what happens when dumping works: If purify-flag (ie dumping) just use PATH_DUMPLOADSEARCH. - Otherwise use EMACSLOADPATH if set, else PATH_LOADSEARCH. + Otherwise use PATH_LOADSEARCH. - If !initialized, then just set both Vload_path and dump_path. - If initialized, then if Vload_path != dump_path, do nothing. - (Presumably the load-path has already been changed by something. - This can only be from a site-load file during dumping, - or because EMACSLOADPATH is set.) + If !initialized, then just return PATH_DUMPLOADSEARCH. + If initialized: If Vinstallation_directory is not nil (ie, running uninstalled): If installation-dir/lisp exists and not already a member, we must be running uninstalled. Reset the load-path to just installation-dir/lisp. (The default PATH_LOADSEARCH refers to the eventual installation directories. Since we are not yet installed, we should not use them, even if they exist.) - If installation-dir/lisp does not exist, just add dump_path at the - end instead. - Add installation-dir/leim (if exists and not already a member) at the front. + If installation-dir/lisp does not exist, just add + PATH_DUMPLOADSEARCH at the end instead. Add installation-dir/site-lisp (if !no_site_lisp, and exists and not already a member) at the front. If installation-dir != source-dir (ie running an uninstalled, out-of-tree build) AND install-dir/src/Makefile exists BUT install-dir/src/Makefile.in does NOT exist (this is a sanity - check), then repeat the above steps for source-dir/lisp, - leim and site-lisp. - Finally, add the site-lisp directories at the front (if !no_site_lisp). -*/ + check), then repeat the above steps for source-dir/lisp, site-lisp. */ -void -init_lread (void) +static Lisp_Object +load_path_default (void) { + Lisp_Object lpath = Qnil; const char *normal; #ifdef CANNOT_DUMP @@ -4165,190 +4203,193 @@ init_lread (void) normal = PATH_LOADSEARCH; #ifdef HAVE_NS - Vload_path = decode_env_path ("EMACSLOADPATH", loadpath ? loadpath : normal); + lpath = decode_env_path (0, loadpath ? loadpath : normal, 0); #else - Vload_path = decode_env_path ("EMACSLOADPATH", normal); + lpath = decode_env_path (0, normal, 0); #endif - load_path_check (); - - /* FIXME CANNOT_DUMP platforms should get source-dir/lisp etc added - to their load-path too, AFAICS. I don't think we can tell the - difference between initialized and !initialized in this case, - so we'll have to do it unconditionally when Vinstallation_directory - is non-nil. */ - if (!no_site_lisp && !egetenv ("EMACSLOADPATH")) - { - Lisp_Object sitelisp; - sitelisp = decode_env_path (0, PATH_SITELOADSEARCH); - if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path); - } #else /* !CANNOT_DUMP */ - if (NILP (Vpurify_flag)) - { - normal = PATH_LOADSEARCH; - /* If the EMACSLOADPATH environment variable is set, use its value. - This doesn't apply if we're dumping. */ - if (egetenv ("EMACSLOADPATH")) - Vload_path = decode_env_path ("EMACSLOADPATH", normal); - } - else - normal = PATH_DUMPLOADSEARCH; - - /* In a dumped Emacs, we normally reset the value of Vload_path using - PATH_LOADSEARCH, since the value that was dumped uses lisp/ in - the source directory, instead of the path of the installed elisp - libraries. However, if it appears that Vload_path has already been - changed from the default that was saved before dumping, don't - change it further. Changes can only be due to EMACSLOADPATH, or - site-lisp files that were processed during dumping. */ + + normal = NILP (Vpurify_flag) ? PATH_LOADSEARCH : PATH_DUMPLOADSEARCH; + if (initialized) { - if (NILP (Fequal (dump_path, Vload_path))) - { - /* Do not make any changes, just check the elements exist. */ - /* Note: --no-site-lisp is ignored. - I don't know what to do about this. */ - load_path_check (); - } - else - { #ifdef HAVE_NS - const char *loadpath = ns_load_path (); - Vload_path = decode_env_path (0, loadpath ? loadpath : normal); + const char *loadpath = ns_load_path (); + lpath = decode_env_path (0, loadpath ? loadpath : normal, 0); #else - Vload_path = decode_env_path (0, normal); + lpath = decode_env_path (0, normal, 0); #endif - if (!NILP (Vinstallation_directory)) - { - Lisp_Object tem, tem1; - - /* Add to the path the lisp subdir of the installation - dir, if it is accessible. Note: in out-of-tree builds, - this directory is empty save for Makefile. */ - tem = Fexpand_file_name (build_string ("lisp"), - Vinstallation_directory); - tem1 = Ffile_accessible_directory_p (tem); - if (!NILP (tem1)) + if (!NILP (Vinstallation_directory)) + { + Lisp_Object tem, tem1; + + /* Add to the path the lisp subdir of the installation + dir, if it is accessible. Note: in out-of-tree builds, + this directory is empty save for Makefile. */ + tem = Fexpand_file_name (build_string ("lisp"), + Vinstallation_directory); + tem1 = Ffile_accessible_directory_p (tem); + if (!NILP (tem1)) + { + if (NILP (Fmember (tem, lpath))) { - if (NILP (Fmember (tem, Vload_path))) - { - /* We are running uninstalled. The default load-path - points to the eventual installed lisp, leim - directories. We should not use those now, even - if they exist, so start over from a clean slate. */ - Vload_path = list1 (tem); - } + /* We are running uninstalled. The default load-path + points to the eventual installed lisp directories. + We should not use those now, even if they exist, + so start over from a clean slate. */ + lpath = list1 (tem); } - else - /* That dir doesn't exist, so add the build-time - Lisp dirs instead. */ - Vload_path = nconc2 (Vload_path, dump_path); + } + else + /* That dir doesn't exist, so add the build-time + Lisp dirs instead. */ + { + Lisp_Object dump_path = + decode_env_path (0, PATH_DUMPLOADSEARCH, 0); + lpath = nconc2 (lpath, dump_path); + } - /* Add leim under the installation dir, if it is accessible. */ - tem = Fexpand_file_name (build_string ("leim"), + /* Add site-lisp under the installation dir, if it exists. */ + if (!no_site_lisp) + { + tem = Fexpand_file_name (build_string ("site-lisp"), Vinstallation_directory); tem1 = Ffile_accessible_directory_p (tem); if (!NILP (tem1)) { - if (NILP (Fmember (tem, Vload_path))) - Vload_path = Fcons (tem, Vload_path); + if (NILP (Fmember (tem, lpath))) + lpath = Fcons (tem, lpath); } + } - /* Add site-lisp under the installation dir, if it exists. */ - if (!no_site_lisp) + /* If Emacs was not built in the source directory, + and it is run from where it was built, add to load-path + the lisp and site-lisp dirs under that directory. */ + + if (NILP (Fequal (Vinstallation_directory, Vsource_directory))) + { + Lisp_Object tem2; + + tem = Fexpand_file_name (build_string ("src/Makefile"), + Vinstallation_directory); + tem1 = Ffile_exists_p (tem); + + /* Don't be fooled if they moved the entire source tree + AFTER dumping Emacs. If the build directory is indeed + different from the source dir, src/Makefile.in and + src/Makefile will not be found together. */ + tem = Fexpand_file_name (build_string ("src/Makefile.in"), + Vinstallation_directory); + tem2 = Ffile_exists_p (tem); + if (!NILP (tem1) && NILP (tem2)) { - tem = Fexpand_file_name (build_string ("site-lisp"), - Vinstallation_directory); - tem1 = Ffile_accessible_directory_p (tem); - if (!NILP (tem1)) + tem = Fexpand_file_name (build_string ("lisp"), + Vsource_directory); + + if (NILP (Fmember (tem, lpath))) + lpath = Fcons (tem, lpath); + + if (!no_site_lisp) { - if (NILP (Fmember (tem, Vload_path))) - Vload_path = Fcons (tem, Vload_path); + tem = Fexpand_file_name (build_string ("site-lisp"), + Vsource_directory); + tem1 = Ffile_accessible_directory_p (tem); + if (!NILP (tem1)) + { + if (NILP (Fmember (tem, lpath))) + lpath = Fcons (tem, lpath); + } } } + } /* Vinstallation_directory != Vsource_directory */ - /* If Emacs was not built in the source directory, - and it is run from where it was built, add to load-path - the lisp, leim and site-lisp dirs under that directory. */ + } /* if Vinstallation_directory */ + } + else /* !initialized */ + { + /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the + source directory. We used to add ../lisp (ie the lisp dir in + the build directory) at the front here, but that should not + be necessary, since in out of tree builds lisp/ is empty, save + for Makefile. */ + lpath = decode_env_path (0, normal, 0); + } +#endif /* !CANNOT_DUMP */ - if (NILP (Fequal (Vinstallation_directory, Vsource_directory))) - { - Lisp_Object tem2; - - tem = Fexpand_file_name (build_string ("src/Makefile"), - Vinstallation_directory); - tem1 = Ffile_exists_p (tem); - - /* Don't be fooled if they moved the entire source tree - AFTER dumping Emacs. If the build directory is indeed - different from the source dir, src/Makefile.in and - src/Makefile will not be found together. */ - tem = Fexpand_file_name (build_string ("src/Makefile.in"), - Vinstallation_directory); - tem2 = Ffile_exists_p (tem); - if (!NILP (tem1) && NILP (tem2)) - { - tem = Fexpand_file_name (build_string ("lisp"), - Vsource_directory); + return lpath; +} - if (NILP (Fmember (tem, Vload_path))) - Vload_path = Fcons (tem, Vload_path); +void +init_lread (void) +{ + /* First, set Vload_path. */ - tem = Fexpand_file_name (build_string ("leim"), - Vsource_directory); + /* Ignore EMACSLOADPATH when dumping. */ +#ifdef CANNOT_DUMP + bool use_loadpath = true; +#else + bool use_loadpath = NILP (Vpurify_flag); +#endif - if (NILP (Fmember (tem, Vload_path))) - Vload_path = Fcons (tem, Vload_path); + if (use_loadpath && egetenv ("EMACSLOADPATH")) + { + Vload_path = decode_env_path ("EMACSLOADPATH", 0, 1); - if (!no_site_lisp) - { - tem = Fexpand_file_name (build_string ("site-lisp"), - Vsource_directory); - tem1 = Ffile_accessible_directory_p (tem); - if (!NILP (tem1)) - { - if (NILP (Fmember (tem, Vload_path))) - Vload_path = Fcons (tem, Vload_path); - } - } - } - } /* Vinstallation_directory != Vsource_directory */ + /* Check (non-nil) user-supplied elements. */ + load_path_check (Vload_path); - } /* if Vinstallation_directory */ + /* If no nils in the environment variable, use as-is. + Otherwise, replace any nils with the default. */ + if (! NILP (Fmemq (Qnil, Vload_path))) + { + Lisp_Object elem, elpath = Vload_path; + Lisp_Object default_lpath = load_path_default (); - /* Check before adding the site-lisp directories. - The install should have created them, but they are not - required, so no need to warn if they are absent. - Or we might be running before installation. */ - load_path_check (); + /* Check defaults, before adding site-lisp. */ + load_path_check (default_lpath); - /* Add the site-lisp directories at the front. */ + /* Add the site-lisp directories to the front of the default. */ if (!no_site_lisp) { Lisp_Object sitelisp; - sitelisp = decode_env_path (0, PATH_SITELOADSEARCH); - if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path); + sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0); + if (! NILP (sitelisp)) + default_lpath = nconc2 (sitelisp, default_lpath); + } + + Vload_path = Qnil; + + /* 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); } - } /* if dump_path == Vload_path */ + } /* Fmemq (Qnil, Vload_path) */ } - else /* !initialized */ + else { - /* NORMAL refers to PATH_DUMPLOADSEARCH, ie the lisp dir in the - source directory. We used to add ../lisp (ie the lisp dir in - the build directory) at the front here, but that caused trouble - because it was copied from dump_path into Vload_path, above, - when Vinstallation_directory was non-nil. It should not be - necessary, since in out of tree builds lisp/ is empty, save - for Makefile. */ - Vload_path = decode_env_path (0, normal); - dump_path = Vload_path; - /* No point calling load_path_check; load-path only contains essential - elements from the source directory at this point. They cannot - be missing unless something went extremely (and improbably) - wrong, in which case the build will fail in obvious ways. */ + Vload_path = load_path_default (); + + /* Check before adding site-lisp directories. + The install should have created them, but they are not + required, so no need to warn if they are absent. + Or we might be running before installation. */ + load_path_check (Vload_path); + + /* Add the site-lisp directories at the front. */ + if (initialized && !no_site_lisp) + { + Lisp_Object sitelisp; + sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0); + if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path); + } } -#endif /* !CANNOT_DUMP */ Vvalues = Qnil; @@ -4388,21 +4429,7 @@ dir_warning (char const *use, Lisp_Object dirname) void syms_of_lread (void) { - defsubr (&Sread); - defsubr (&Sread_from_string); - defsubr (&Sintern); - defsubr (&Sintern_soft); - defsubr (&Sunintern); - defsubr (&Sget_load_suffixes); - defsubr (&Sload); - defsubr (&Seval_buffer); - defsubr (&Seval_region); - defsubr (&Sread_char); - defsubr (&Sread_char_exclusive); - defsubr (&Sread_event); - defsubr (&Sget_file_char); - defsubr (&Smapatoms); - defsubr (&Slocate_file_internal); +#include "lread.x" DEFVAR_LISP ("obarray", Vobarray, doc: /* Symbol table for use by `intern' and `read'. @@ -4413,7 +4440,7 @@ to find all the symbols in an obarray, use `mapatoms'. */); DEFVAR_LISP ("values", Vvalues, doc: /* List of values of all expressions which were read, evaluated and printed. Order is reverse chronological. */); - XSYMBOL (intern ("values"))->declared_special = 0; + SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (intern ("values")), 0); DEFVAR_LISP ("standard-input", Vstandard_input, doc: /* Stream for read to get input from. @@ -4455,9 +4482,8 @@ were read in. */); DEFVAR_LISP ("load-path", Vload_path, doc: /* List of directories to search for files to load. -Each element is a string (directory name) or nil (try default directory). -Initialized based on EMACSLOADPATH environment variable, if any, -otherwise to default specified by file `epaths.h' when Emacs was built. */); +Each element is a string (directory name) or nil (meaning `default-directory'). +Initialized during startup as described in Info node `(elisp)Library Search'. */); DEFVAR_LISP ("load-suffixes", Vload_suffixes, doc: /* List of suffixes for (compiled or source) Emacs Lisp files. @@ -4573,7 +4599,7 @@ and is not meant for users to change. */); You cannot count on them to still be there! */); Vsource_directory = Fexpand_file_name (build_string ("../"), - Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH))); + Fcar (decode_env_path (0, PATH_DUMPLOADSEARCH, 0))); DEFVAR_LISP ("preloaded-file-list", Vpreloaded_file_list, doc: /* List of files that were preloaded (when dumping Emacs). */); @@ -4624,6 +4650,18 @@ variables, this must be set in the first line of a file. */); Vold_style_backquotes = Qnil; DEFSYM (Qold_style_backquotes, "old-style-backquotes"); + DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer, + doc: /* Non-nil means `load' prefers the newest version of a file. +This applies when a filename suffix is not explicitly specified and +`load' is trying various possible suffixes (see `load-suffixes' and +`load-file-rep-suffixes'). Normally, it stops at the first file +that exists unless you explicitly specify one or the other. If this +option is non-nil, it checks all suffixes and uses whichever file is +newest. +Note that if you customize this, obviously it will not affect files +that are loaded before your customizations are read! */); + load_prefer_newer = 1; + /* Vsource_directory was initialized in init_lread. */ DEFSYM (Qcurrent_load_list, "current-load-list"); @@ -4648,8 +4686,6 @@ variables, this must be set in the first line of a file. */); DEFSYM (Qdir_ok, "dir-ok"); DEFSYM (Qdo_after_load_evaluation, "do-after-load-evaluation"); - staticpro (&dump_path); - staticpro (&read_objects); read_objects = Qnil; staticpro (&seen_list);