X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/6e9ddbb313cf7db66550f93a74cbba12e39e93c0..f6196b87e1ceee0d56f2fe6f3aa2b9d1d82c44b0:/src/lread.c
diff --git a/src/lread.c b/src/lread.c
index 23cda8eed6..02b13affb6 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -24,12 +24,13 @@ along with GNU Emacs. If not, see . */
#include
#include
#include
-#include /* for CHAR_BIT */
+#include /* For CHAR_BIT. */
#include
+#include
#include "lisp.h"
#include "intervals.h"
-#include "buffer.h"
#include "character.h"
+#include "buffer.h"
#include "charset.h"
#include "coding.h"
#include
@@ -44,8 +45,11 @@ along with GNU Emacs. If not, see . */
#include "msdos.h"
#endif
+#ifdef HAVE_NS
+#include "nsterm.h"
+#endif
+
#include
-#include
#ifdef HAVE_SETLOCALE
#include
@@ -61,7 +65,7 @@ along with GNU Emacs. If not, see . */
#define file_tell ftell
#endif
-/* hash table read constants */
+/* Hash table read constants. */
static Lisp_Object Qhash_table, Qdata;
static Lisp_Object Qtest, Qsize;
static Lisp_Object Qweakness;
@@ -75,7 +79,7 @@ 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;
-static Lisp_Object Qlexical_binding;
+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
@@ -84,8 +88,6 @@ static Lisp_Object Qget_emacs_mule_file_char;
static Lisp_Object Qload_force_doc_strings;
-extern Lisp_Object Qinternal_interpreter_environment;
-
static Lisp_Object Qload_in_progress;
/* The association list of objects read with the #n=object form.
@@ -105,16 +107,13 @@ static Lisp_Object load_descriptor_list;
/* File for get_file_char to read from. Use by load. */
static FILE *instream;
-/* When nonzero, read conses in pure space */
-static int read_pure;
-
/* For use within read-from-string (this reader is non-reentrant!!) */
-static EMACS_INT read_from_string_index;
-static EMACS_INT read_from_string_index_byte;
-static EMACS_INT read_from_string_limit;
+static ptrdiff_t read_from_string_index;
+static ptrdiff_t read_from_string_index_byte;
+static ptrdiff_t read_from_string_limit;
/* Number of characters read in the current call to Fread or
- Fread_from_string. */
+ Fread_from_string. */
static EMACS_INT readchar_count;
/* This contains the last string skipped with #@. */
@@ -157,10 +156,6 @@ static void readevalloop (Lisp_Object, FILE*, Lisp_Object, int,
Lisp_Object, Lisp_Object);
static Lisp_Object load_unwind (Lisp_Object);
static Lisp_Object load_descriptor_unwind (Lisp_Object);
-
-static void invalid_syntax (const char *) NO_RETURN;
-static void end_of_file_error (void) NO_RETURN;
-
/* Functions that read one byte from the current source READCHARFUN
or unreads one byte. If the integer argument C is -1, it returns
@@ -187,11 +182,11 @@ static int readbyte_from_string (int, Lisp_Object);
/* When READCHARFUN is Qget_file_char, Qget_emacs_mule_file_char,
Qlambda, or a cons, we use this to keep an unread character because
a file stream can't handle multibyte-char unreading. The value -1
- means that there's no unread character. */
+ means that there's no unread character. */
static int unread_char;
static int
-readchar (Lisp_Object readcharfun, int *multibyte)
+readchar (Lisp_Object readcharfun, bool *multibyte)
{
Lisp_Object tem;
register int c;
@@ -209,7 +204,7 @@ readchar (Lisp_Object readcharfun, int *multibyte)
{
register struct buffer *inbuffer = XBUFFER (readcharfun);
- EMACS_INT pt_byte = BUF_PT_BYTE (inbuffer);
+ ptrdiff_t pt_byte = BUF_PT_BYTE (inbuffer);
if (pt_byte >= BUF_ZV_BYTE (inbuffer))
return -1;
@@ -238,7 +233,7 @@ readchar (Lisp_Object readcharfun, int *multibyte)
{
register struct buffer *inbuffer = XMARKER (readcharfun)->buffer;
- EMACS_INT bytepos = marker_byte_position (readcharfun);
+ ptrdiff_t bytepos = marker_byte_position (readcharfun);
if (bytepos >= BUF_ZV_BYTE (inbuffer))
return -1;
@@ -372,8 +367,8 @@ unreadchar (Lisp_Object readcharfun, int c)
else if (BUFFERP (readcharfun))
{
struct buffer *b = XBUFFER (readcharfun);
- EMACS_INT charpos = BUF_PT (b);
- EMACS_INT bytepos = BUF_PT_BYTE (b);
+ ptrdiff_t charpos = BUF_PT (b);
+ ptrdiff_t bytepos = BUF_PT_BYTE (b);
if (! NILP (BVAR (b, enable_multibyte_characters)))
BUF_DEC_POS (b, bytepos);
@@ -385,7 +380,7 @@ unreadchar (Lisp_Object readcharfun, int c)
else if (MARKERP (readcharfun))
{
struct buffer *b = XMARKER (readcharfun)->buffer;
- EMACS_INT bytepos = XMARKER (readcharfun)->bytepos;
+ ptrdiff_t bytepos = XMARKER (readcharfun)->bytepos;
XMARKER (readcharfun)->charpos--;
if (! NILP (BVAR (b, enable_multibyte_characters)))
@@ -447,7 +442,7 @@ readbyte_from_file (int c, Lisp_Object readcharfun)
c = getc (instream);
#ifdef EINTR
- /* Interrupted reads have been observed while reading over the network */
+ /* Interrupted reads have been observed while reading over the network. */
while (c == EOF && ferror (instream) && errno == EINTR)
{
UNBLOCK_INPUT;
@@ -604,15 +599,9 @@ read_filtered_event (int no_switch_frame, int ascii_required,
/* Compute timeout. */
if (NUMBERP (seconds))
{
- EMACS_TIME wait_time;
- int sec, usec;
double duration = extract_float (seconds);
-
- sec = (int) duration;
- usec = (duration - sec) * 1000000;
- EMACS_GET_TIME (end_time);
- EMACS_SET_SECS_USECS (wait_time, sec, usec);
- EMACS_ADD_TIME (end_time, end_time, wait_time);
+ EMACS_TIME wait_time = EMACS_TIME_FROM_DOUBLE (duration);
+ end_time = add_emacs_time (current_emacs_time (), wait_time);
}
/* Read until we get an acceptable event. */
@@ -839,7 +828,7 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun)
}
/* Stop scanning if no colon was found before end marker. */
- if (!in_file_vars)
+ if (!in_file_vars || ch == '\n' || ch == EOF)
break;
while (i > 0 && (var[i - 1] == ' ' || var[i - 1] == '\t'))
@@ -863,8 +852,7 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun)
ch = READCHAR;
}
if (! in_file_vars)
- /* The value was terminated by an end-marker, which
- remove. */
+ /* The value was terminated by an end-marker, which remove. */
i -= 3;
while (i > 0 && (val[i - 1] == ' ' || val[i - 1] == '\t'))
i--;
@@ -915,7 +903,7 @@ safe_to_load_p (int fd)
if (i >= nbytes
|| fast_c_string_match_ignore_case (Vbytecomp_version_regexp,
- buf + i) < 0)
+ buf + i, nbytes - i) < 0)
safe_p = 0;
}
if (safe_p)
@@ -1023,7 +1011,7 @@ Return t if the file exists and loads successfully. */)
{
register FILE *stream;
register int fd = -1;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object found, efound, hist_file_name;
/* 1 means we printed the ".el is newer" message. */
@@ -1068,7 +1056,7 @@ Return t if the file exists and loads successfully. */)
/* Avoid weird lossage with null string as arg,
- since it would try to load a directory as a Lisp file */
+ since it would try to load a directory as a Lisp file. */
if (SBYTES (file) > 0)
{
ptrdiff_t size = SBYTES (file);
@@ -1172,7 +1160,7 @@ Return t if the file exists and loads successfully. */)
Vload_source_file_function. */
specbind (Qlexical_binding, Qnil);
- /* Get the name for load-history. */
+ /* Get the name for load-history. */
hist_file_name = (! NILP (Vpurify_flag)
? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
tmp[1] = Ffile_name_nondirectory (found),
@@ -1227,7 +1215,8 @@ Return t if the file exists and loads successfully. */)
SSET (efound, SBYTES (efound) - 1, 'c');
}
- if (result == 0 && s1.st_mtime < s2.st_mtime)
+ if (result == 0
+ && EMACS_TIME_LT (get_stat_mtime (&s1), get_stat_mtime (&s2)))
{
/* Make the progress messages mention that source is newer. */
newer = 1;
@@ -1325,7 +1314,7 @@ Return t if the file exists and loads successfully. */)
}
unbind_to (count, Qnil);
- /* Run any eval-after-load forms for this file */
+ /* Run any eval-after-load forms for this file. */
if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
call1 (Qdo_after_load_evaluation, hist_file_name) ;
@@ -1357,7 +1346,7 @@ Return t if the file exists and loads successfully. */)
}
static Lisp_Object
-load_unwind (Lisp_Object arg) /* used as unwind-protect function in load */
+load_unwind (Lisp_Object arg) /* Used as unwind-protect function in load. */
{
FILE *stream = (FILE *) XSAVE_VALUE (arg)->pointer;
if (stream != NULL)
@@ -1443,16 +1432,16 @@ int
openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *storeptr, Lisp_Object predicate)
{
register int fd;
- EMACS_INT fn_size = 100;
+ ptrdiff_t fn_size = 100;
char buf[100];
register char *fn = buf;
int absolute = 0;
- EMACS_INT want_length;
+ ptrdiff_t want_length;
Lisp_Object filename;
struct stat st;
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
Lisp_Object string, tail, encoded_fn;
- EMACS_INT max_suffix_len = 0;
+ ptrdiff_t max_suffix_len = 0;
CHECK_STRING (str);
@@ -1476,13 +1465,13 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
{
filename = Fexpand_file_name (str, XCAR (path));
if (!complete_filename_p (filename))
- /* If there are non-absolute elts in PATH (eg ".") */
+ /* If there are non-absolute elts in PATH (eg "."). */
/* Of course, this could conceivably lose if luser sets
- default-directory to be something non-absolute... */
+ default-directory to be something non-absolute... */
{
filename = Fexpand_file_name (filename, BVAR (current_buffer, directory));
if (!complete_filename_p (filename))
- /* Give up on this path element! */
+ /* Give up on this path element! */
continue;
}
@@ -1490,36 +1479,26 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
this path element/specified file name and any possible suffix. */
want_length = max_suffix_len + SBYTES (filename);
if (fn_size <= want_length)
- fn = (char *) alloca (fn_size = 100 + want_length);
+ fn = alloca (fn_size = 100 + want_length);
/* Loop over suffixes. */
for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes;
CONSP (tail); tail = XCDR (tail))
{
- ptrdiff_t lsuffix = SBYTES (XCAR (tail));
+ ptrdiff_t fnlen, lsuffix = SBYTES (XCAR (tail));
Lisp_Object handler;
int exists;
/* Concatenate path element/specified name with the suffix.
If the directory starts with /:, remove that. */
- if (SCHARS (filename) > 2
- && SREF (filename, 0) == '/'
- && SREF (filename, 1) == ':')
- {
- strncpy (fn, SSDATA (filename) + 2,
- SBYTES (filename) - 2);
- fn[SBYTES (filename) - 2] = 0;
- }
- else
- {
- strncpy (fn, SSDATA (filename),
- SBYTES (filename));
- fn[SBYTES (filename)] = 0;
- }
-
- if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
- strncat (fn, SSDATA (XCAR (tail)), lsuffix);
-
+ int prefixlen = ((SCHARS (filename) > 2
+ && SREF (filename, 0) == '/'
+ && SREF (filename, 1) == ':')
+ ? 2 : 0);
+ fnlen = SBYTES (filename) - prefixlen;
+ memcpy (fn, SDATA (filename) + prefixlen, fnlen);
+ memcpy (fn + fnlen, SDATA (XCAR (tail)), 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:
if (absolute)
@@ -1528,7 +1507,7 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
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 = build_string (fn);
+ string = make_string (fn, fnlen);
handler = Ffind_file_name_handler (string, Qfile_exists_p);
if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
{
@@ -1562,7 +1541,9 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *sto
{
/* Check that we can access or open it. */
if (NATNUMP (predicate))
- fd = (access (pfn, XFASTINT (predicate)) == 0) ? 1 : -1;
+ fd = (((XFASTINT (predicate) & ~INT_MAX) == 0
+ && access (pfn, XFASTINT (predicate)) == 0)
+ ? 1 : -1);
else
fd = emacs_open (pfn, O_RDONLY, 0);
@@ -1607,12 +1588,12 @@ build_load_history (Lisp_Object filename, int entire)
{
tem = XCAR (tail);
- /* Find the feature's previous assoc list... */
+ /* Find the feature's previous assoc list... */
if (!NILP (Fequal (filename, Fcar (tem))))
{
foundit = 1;
- /* If we're loading the entire file, remove old data. */
+ /* If we're loading the entire file, remove old data. */
if (entire)
{
if (NILP (prev))
@@ -1653,13 +1634,6 @@ build_load_history (Lisp_Object filename, int entire)
Vload_history);
}
-static Lisp_Object
-unreadpure (Lisp_Object junk) /* Used as unwind-protect function in readevalloop */
-{
- read_pure = 0;
- return Qnil;
-}
-
static Lisp_Object
readevalloop_1 (Lisp_Object old)
{
@@ -1670,7 +1644,7 @@ readevalloop_1 (Lisp_Object old)
/* Signal an `end-of-file' error, if possible with file name
information. */
-static void
+static _Noreturn void
end_of_file_error (void)
{
if (STRINGP (Vload_file_name))
@@ -1696,7 +1670,7 @@ readevalloop (Lisp_Object readcharfun,
{
register int c;
register Lisp_Object val;
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
struct buffer *b = 0;
int continue_reading_p;
@@ -1705,6 +1679,17 @@ readevalloop (Lisp_Object readcharfun,
int whole_buffer = 0;
/* 1 on the first time around. */
int first_sexp = 1;
+ Lisp_Object macroexpand = intern ("internal-macroexpand-for-load");
+
+ if (NILP (Ffboundp (macroexpand))
+ /* Don't macroexpand in .elc files, since it should have been done
+ already. We actually don't know whether we're in a .elc file or not,
+ so we use circumstancial evidence: .el files normally go through
+ Vload_source_file_function -> load-with-code-conversion
+ -> eval-buffer. */
+ || EQ (readcharfun, Qget_file_char)
+ || EQ (readcharfun, Qget_emacs_mule_file_char))
+ macroexpand = Qnil;
if (MARKERP (readcharfun))
{
@@ -1719,7 +1704,7 @@ readevalloop (Lisp_Object readcharfun,
/* We assume START is nil when input is not from a buffer. */
if (! NILP (start) && !b)
- abort ();
+ emacs_abort ();
specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */
specbind (Qcurrent_load_list, Qnil);
@@ -1736,7 +1721,7 @@ readevalloop (Lisp_Object readcharfun,
GCPRO4 (sourcename, readfun, start, end);
- /* Try to ensure sourcename is a truename, except whilst preloading. */
+ /* Try to ensure sourcename is a truename, except whilst preloading. */
if (NILP (Vpurify_flag)
&& !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))
&& !NILP (Ffboundp (Qfile_truename)))
@@ -1747,7 +1732,7 @@ readevalloop (Lisp_Object readcharfun,
continue_reading_p = 1;
while (continue_reading_p)
{
- int count1 = SPECPDL_INDEX ();
+ ptrdiff_t count1 = SPECPDL_INDEX ();
if (b != 0 && NILP (BVAR (b, name)))
error ("Reading from killed buffer");
@@ -1801,8 +1786,7 @@ readevalloop (Lisp_Object readcharfun,
if (!NILP (Vpurify_flag) && c == '(')
{
- record_unwind_protect (unreadpure, Qnil);
- val = read_list (-1, readcharfun);
+ val = read_list (0, readcharfun);
}
else
{
@@ -1835,6 +1819,8 @@ readevalloop (Lisp_Object readcharfun,
unbind_to (count1, Qnil);
/* Now eval what we just read. */
+ if (!NILP (macroexpand))
+ val = call1 (macroexpand, val);
val = eval_sub (val);
if (printflag)
@@ -1873,7 +1859,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)
{
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object tem, buf;
if (NILP (buffer))
@@ -1918,7 +1904,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! */
- int count = SPECPDL_INDEX ();
+ ptrdiff_t count = SPECPDL_INDEX ();
Lisp_Object tem, cbuf;
cbuf = Fcurrent_buffer ();
@@ -1930,7 +1916,7 @@ This function does not move point. */)
specbind (Qstandard_output, tem);
specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list));
- /* readevalloop calls functions which check the type of start and end. */
+ /* `readevalloop' calls functions which check the type of start and end. */
readevalloop (cbuf, 0, BVAR (XBUFFER (cbuf), filename),
!NILP (printflag), Qnil, read_function,
start, end);
@@ -1973,16 +1959,16 @@ START and END optionally delimit a substring of STRING from which to read;
{
Lisp_Object ret;
CHECK_STRING (string);
- /* read_internal_start sets read_from_string_index. */
+ /* `read_internal_start' sets `read_from_string_index'. */
ret = read_internal_start (string, start, end);
return Fcons (ret, make_number (read_from_string_index));
}
/* Function to set up the global context we need in toplevel read
- calls. */
+ calls. */
static Lisp_Object
read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
-/* start, end only used when stream is a string. */
+/* `start', `end' only used when stream is a string. */
{
Lisp_Object retval;
@@ -1996,7 +1982,7 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
if (STRINGP (stream)
|| ((CONSP (stream) && STRINGP (XCAR (stream)))))
{
- EMACS_INT startval, endval;
+ ptrdiff_t startval, endval;
Lisp_Object string;
if (STRINGP (stream))
@@ -2009,9 +1995,9 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
else
{
CHECK_NUMBER (end);
- endval = XINT (end);
- if (endval < 0 || endval > SCHARS (string))
+ if (! (0 <= XINT (end) && XINT (end) <= SCHARS (string)))
args_out_of_range (string, end);
+ endval = XINT (end);
}
if (NILP (start))
@@ -2019,9 +2005,9 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
else
{
CHECK_NUMBER (start);
- startval = XINT (start);
- if (startval < 0 || startval > endval)
+ if (! (0 <= XINT (start) && XINT (start) <= endval))
args_out_of_range (string, start);
+ startval = XINT (start);
}
read_from_string_index = startval;
read_from_string_index_byte = string_char_to_byte (string, startval);
@@ -2039,7 +2025,7 @@ read_internal_start (Lisp_Object stream, Lisp_Object start, Lisp_Object end)
/* Signal Qinvalid_read_syntax error.
S is error string of length N (if > 0) */
-static void
+static _Noreturn void
invalid_syntax (const char *s)
{
xsignal1 (Qinvalid_read_syntax, build_string (s));
@@ -2047,7 +2033,7 @@ invalid_syntax (const char *s)
/* Use this for recursive reads, in contexts where internal tokens
- are not allowed. */
+ are not allowed. */
static Lisp_Object
read0 (Lisp_Object readcharfun)
@@ -2074,7 +2060,7 @@ 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
- behavior for \u, and change this value in the case that \U is seen. */
+ behavior for \u, and change this value in the case that \U is seen. */
int unicode_hex_count = 4;
switch (c)
@@ -2260,8 +2246,8 @@ read_escape (Lisp_Object readcharfun, int stringp)
while (++count <= unicode_hex_count)
{
c = READCHAR;
- /* isdigit and isalpha may be locale-specific, which we don't
- want. */
+ /* `isdigit' and `isalpha' may be locale-specific, which we don't
+ want. */
if (c >= '0' && c <= '9') i = (i << 4) + (c - '0');
else if (c >= 'a' && c <= 'f') i = (i << 4) + (c - 'a') + 10;
else if (c >= 'A' && c <= 'F') i = (i << 4) + (c - 'A') + 10;
@@ -2378,9 +2364,9 @@ read_integer (Lisp_Object readcharfun, EMACS_INT radix)
static Lisp_Object
read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
{
- register int c;
- unsigned uninterned_symbol = 0;
- int multibyte;
+ int c;
+ bool uninterned_symbol = 0;
+ bool multibyte;
*pch = 0;
load_each_byte = 0;
@@ -2415,13 +2401,13 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
{
/* Accept extended format for hashtables (extensible to
other types), e.g.
- #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
+ #s(hash-table size 2 test equal data (k1 v1 k2 v2)) */
Lisp_Object tmp = read_list (0, readcharfun);
Lisp_Object head = CAR_SAFE (tmp);
Lisp_Object data = Qnil;
Lisp_Object val = Qnil;
/* The size is 2 * number of allowed keywords to
- make-hash-table. */
+ make-hash-table. */
Lisp_Object params[10];
Lisp_Object ht;
Lisp_Object key = Qnil;
@@ -2433,36 +2419,36 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
tmp = CDR_SAFE (tmp);
- /* This is repetitive but fast and simple. */
+ /* This is repetitive but fast and simple. */
params[param_count] = QCsize;
- params[param_count+1] = Fplist_get (tmp, Qsize);
+ params[param_count + 1] = Fplist_get (tmp, Qsize);
if (!NILP (params[param_count + 1]))
param_count += 2;
params[param_count] = QCtest;
- params[param_count+1] = Fplist_get (tmp, Qtest);
+ params[param_count + 1] = Fplist_get (tmp, Qtest);
if (!NILP (params[param_count + 1]))
param_count += 2;
params[param_count] = QCweakness;
- params[param_count+1] = Fplist_get (tmp, Qweakness);
+ params[param_count + 1] = Fplist_get (tmp, Qweakness);
if (!NILP (params[param_count + 1]))
param_count += 2;
params[param_count] = QCrehash_size;
- params[param_count+1] = Fplist_get (tmp, Qrehash_size);
+ params[param_count + 1] = Fplist_get (tmp, Qrehash_size);
if (!NILP (params[param_count + 1]))
param_count += 2;
params[param_count] = QCrehash_threshold;
- params[param_count+1] = Fplist_get (tmp, Qrehash_threshold);
+ params[param_count + 1] = Fplist_get (tmp, Qrehash_threshold);
if (!NILP (params[param_count + 1]))
param_count += 2;
- /* This is the hashtable data. */
+ /* This is the hashtable data. */
data = Fplist_get (tmp, Qdata);
- /* Now use params to make a new hashtable and fill it. */
+ /* Now use params to make a new hashtable and fill it. */
ht = Fmake_hash_table (param_count, params);
while (CONSP (data))
@@ -2499,16 +2485,17 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
if (c == '[')
{
Lisp_Object tmp;
- EMACS_INT depth, size;
+ int depth;
+ ptrdiff_t size;
tmp = read_vector (readcharfun, 0);
- if (!INTEGERP (AREF (tmp, 0)))
+ size = ASIZE (tmp);
+ if (size == 0)
+ error ("Invalid size char-table");
+ if (! RANGED_INTEGERP (1, AREF (tmp, 0), 3))
error ("Invalid depth in char-table");
depth = XINT (AREF (tmp, 0));
- if (depth < 1 || depth > 3)
- error ("Invalid depth in char-table");
- size = ASIZE (tmp) - 2;
- if (chartab_size [depth] != size)
+ if (chartab_size[depth] != size - 2)
error ("Invalid size char-table");
XSETPVECTYPE (XVECTOR (tmp), PVEC_SUB_CHAR_TABLE);
return tmp;
@@ -2557,8 +2544,8 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
build them using function calls. */
Lisp_Object tmp;
tmp = read_vector (readcharfun, 1);
- return Fmake_byte_code (ASIZE (tmp),
- XVECTOR (tmp)->contents);
+ make_byte_code (XVECTOR (tmp));
+ return tmp;
}
if (c == '(')
{
@@ -2641,13 +2628,12 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
if (saved_doc_string_size == 0)
{
- saved_doc_string = (char *) xmalloc (nskip + extra);
+ saved_doc_string = xmalloc (nskip + extra);
saved_doc_string_size = nskip + extra;
}
if (nskip > saved_doc_string_size)
{
- saved_doc_string = (char *) xrealloc (saved_doc_string,
- nskip + extra);
+ saved_doc_string = xrealloc (saved_doc_string, nskip + extra);
saved_doc_string_size = nskip + extra;
}
@@ -2694,13 +2680,13 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
/* No symbol character follows, this is the empty
symbol. */
UNREAD (c);
- return Fmake_symbol (build_string (""));
+ return Fmake_symbol (empty_unibyte_string);
}
goto read_symbol;
}
/* ## is the empty symbol. */
if (c == '#')
- return Fintern (build_string (""), Qnil);
+ return Fintern (empty_unibyte_string, Qnil);
/* Reader forms that can reuse previously read objects. */
if (c >= '0' && c <= '9')
{
@@ -2729,7 +2715,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
n for #n#. */
if (c == '=')
{
- /* Make a placeholder for #n# to use temporarily */
+ /* Make a placeholder for #n# to use temporarily. */
Lisp_Object placeholder;
Lisp_Object cell;
@@ -2737,10 +2723,10 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
cell = Fcons (make_number (n), placeholder);
read_objects = Fcons (cell, read_objects);
- /* Read the object itself. */
+ /* Read the object itself. */
tem = read0 (readcharfun);
- /* Now put it everywhere the placeholder was... */
+ /* Now put it everywhere the placeholder was... */
substitute_object_in_subtree (tem, placeholder);
/* ...and #n# will use the real value from now on. */
@@ -2910,8 +2896,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
ptrdiff_t offset = p - read_buffer;
if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
memory_full (SIZE_MAX);
- read_buffer = (char *) xrealloc (read_buffer,
- read_buffer_size * 2);
+ read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
read_buffer_size *= 2;
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
@@ -2923,7 +2908,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
ch = read_escape (readcharfun, 1);
- /* CH is -1 if \ newline has just been seen */
+ /* CH is -1 if \ newline has just been seen. */
if (ch == -1)
{
if (p == read_buffer)
@@ -2938,7 +2923,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
force_singlebyte = 1;
else if (! ASCII_CHAR_P (ch))
force_multibyte = 1;
- else /* i.e. ASCII_CHAR_P (ch) */
+ else /* I.e. ASCII_CHAR_P (ch). */
{
/* Allow `\C- ' and `\C-?'. */
if (modifiers == CHAR_CTL)
@@ -2988,28 +2973,19 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
/* If purifying, and string starts with \ newline,
return zero instead. This is for doc strings
- that we are really going to find in etc/DOC.nn.nn */
+ that we are really going to find in etc/DOC.nn.nn. */
if (!NILP (Vpurify_flag) && NILP (Vdoc_file_name) && cancel)
return make_number (0);
- if (force_multibyte)
- /* READ_BUFFER already contains valid multibyte forms. */
- ;
- else if (force_singlebyte)
+ if (! force_multibyte && force_singlebyte)
{
+ /* READ_BUFFER contains raw 8-bit bytes and no multibyte
+ forms. Convert it to unibyte. */
nchars = str_as_unibyte ((unsigned char *) read_buffer,
p - read_buffer);
p = read_buffer + nchars;
}
- else
- {
- /* Otherwise, READ_BUFFER contains only ASCII. */
- }
- if (read_pure)
- return make_pure_string (read_buffer, nchars, p - read_buffer,
- (force_multibyte
- || (p - read_buffer != nchars)));
return make_specified_string (read_buffer, nchars, p - read_buffer,
(force_multibyte
|| (p - read_buffer != nchars)));
@@ -3054,8 +3030,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
ptrdiff_t offset = p - read_buffer;
if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
memory_full (SIZE_MAX);
- read_buffer = (char *) xrealloc (read_buffer,
- read_buffer_size * 2);
+ read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
read_buffer_size *= 2;
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
@@ -3085,8 +3060,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
ptrdiff_t offset = p - read_buffer;
if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
memory_full (SIZE_MAX);
- read_buffer = (char *) xrealloc (read_buffer,
- read_buffer_size * 2);
+ read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
read_buffer_size *= 2;
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
@@ -3103,25 +3077,24 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
}
{
Lisp_Object name, result;
- EMACS_INT nbytes = p - read_buffer;
- EMACS_INT nchars
+ ptrdiff_t nbytes = p - read_buffer;
+ ptrdiff_t nchars
= (multibyte
? multibyte_chars_in_text ((unsigned char *) read_buffer,
nbytes)
: nbytes);
- if (uninterned_symbol && ! NILP (Vpurify_flag))
- name = make_pure_string (read_buffer, nchars, nbytes, multibyte);
- else
- name = make_specified_string (read_buffer, nchars, nbytes, multibyte);
+ name = ((uninterned_symbol && ! NILP (Vpurify_flag)
+ ? make_pure_string : make_specified_string)
+ (read_buffer, nchars, nbytes, multibyte));
result = (uninterned_symbol ? Fmake_symbol (name)
: Fintern (name, Qnil));
if (EQ (Vread_with_symbol_positions, Qt)
|| EQ (Vread_with_symbol_positions, readcharfun))
- Vread_symbol_positions_list =
- Fcons (Fcons (result, make_number (start_position)),
- Vread_symbol_positions_list);
+ Vread_symbol_positions_list
+ = Fcons (Fcons (result, make_number (start_position)),
+ Vread_symbol_positions_list);
return result;
}
}
@@ -3129,7 +3102,7 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list)
}
-/* List of nodes we've seen during substitute_object_in_subtree. */
+/* List of nodes we've seen during substitute_object_in_subtree. */
static Lisp_Object seen_list;
static void
@@ -3137,23 +3110,23 @@ substitute_object_in_subtree (Lisp_Object object, Lisp_Object placeholder)
{
Lisp_Object check_object;
- /* We haven't seen any objects when we start. */
+ /* We haven't seen any objects when we start. */
seen_list = Qnil;
- /* Make all the substitutions. */
+ /* Make all the substitutions. */
check_object
= substitute_object_recurse (object, placeholder, object);
- /* Clear seen_list because we're done with it. */
+ /* Clear seen_list because we're done with it. */
seen_list = Qnil;
/* The returned object here is expected to always eq the
- original. */
+ original. */
if (!EQ (check_object, object))
error ("Unexpected mutation error in reader");
}
-/* Feval doesn't get called from here, so no gc protection is needed. */
+/* Feval doesn't get called from here, so no gc protection is needed. */
#define SUBSTITUTE(get_val, set_val) \
do { \
Lisp_Object old_value = get_val; \
@@ -3170,11 +3143,11 @@ substitute_object_in_subtree (Lisp_Object object, Lisp_Object placeholder)
static Lisp_Object
substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Object subtree)
{
- /* If we find the placeholder, return the target object. */
+ /* If we find the placeholder, return the target object. */
if (EQ (placeholder, subtree))
return object;
- /* If we've been to this node before, don't explore it again. */
+ /* If we've been to this node before, don't explore it again. */
if (!EQ (Qnil, Fmemq (subtree, seen_list)))
return subtree;
@@ -3224,10 +3197,10 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
case Lisp_String:
{
/* Check for text properties in each interval.
- substitute_in_interval contains part of the logic. */
+ substitute_in_interval contains part of the logic. */
- INTERVAL root_interval = STRING_INTERVALS (subtree);
- Lisp_Object arg = Fcons (object, placeholder);
+ INTERVAL root_interval = string_intervals (subtree);
+ Lisp_Object arg = Fcons (object, placeholder);
traverse_intervals_noorder (root_interval,
&substitute_in_interval, arg);
@@ -3235,7 +3208,7 @@ substitute_object_recurse (Lisp_Object object, Lisp_Object placeholder, Lisp_Obj
return subtree;
}
- /* Other types don't recurse any further. */
+ /* Other types don't recurse any further. */
default:
return subtree;
}
@@ -3248,7 +3221,7 @@ substitute_in_interval (INTERVAL interval, Lisp_Object arg)
Lisp_Object object = Fcar (arg);
Lisp_Object placeholder = Fcdr (arg);
- SUBSTITUTE (interval->plist, interval->plist = true_value);
+ SUBSTITUTE (interval->plist, set_interval_plist (interval, true_value));
}
@@ -3422,7 +3395,7 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag)
tem = read_list (1, readcharfun);
len = Flength (tem);
- vector = (read_pure ? make_pure_vector (XINT (len)) : Fmake_vector (len, Qnil));
+ vector = Fmake_vector (len, Qnil);
size = ASIZE (vector);
ptr = XVECTOR (vector)->contents;
@@ -3443,7 +3416,7 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag)
/* Delay handling the bytecode slot until we know whether
it is lazily-loaded (we can tell by whether the
constants slot is nil). */
- ptr[COMPILED_CONSTANTS] = item;
+ ASET (vector, COMPILED_CONSTANTS, item);
item = Qnil;
}
else if (i == COMPILED_CONSTANTS)
@@ -3469,7 +3442,7 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag)
}
/* Now handle the bytecode slot. */
- ptr[COMPILED_BYTECODE] = read_pure ? Fpurecopy (bytestr) : bytestr;
+ ASET (vector, COMPILED_BYTECODE, bytestr);
}
else if (i == COMPILED_DOC_STRING
&& STRINGP (item)
@@ -3481,7 +3454,7 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag)
item = Fstring_as_multibyte (item);
}
}
- ptr[i] = read_pure ? Fpurecopy (item) : item;
+ ASET (vector, i, item);
otem = XCONS (tem);
tem = Fcdr (tem);
free_cons (otem);
@@ -3489,17 +3462,11 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag)
return vector;
}
-/* FLAG = 1 means check for ] to terminate rather than ) and .
- FLAG = -1 means check for starting with defun
- and make structure pure. */
+/* FLAG = 1 means check for ] to terminate rather than ) and . */
static Lisp_Object
read_list (int flag, register Lisp_Object readcharfun)
{
- /* -1 means check next element for defun,
- 0 means don't check,
- 1 means already checked and found defun. */
- int defunflag = flag < 0 ? -1 : 0;
Lisp_Object val, tail;
register Lisp_Object elt, tem;
struct gcpro gcpro1, gcpro2;
@@ -3541,7 +3508,7 @@ read_list (int flag, register Lisp_Object readcharfun)
We don't use Fexpand_file_name because that would make
the directory absolute now. */
elt = concat2 (build_string ("../lisp/"),
- Ffile_name_nondirectory (elt));
+ Ffile_name_nondirectory (elt));
}
else if (EQ (elt, Vload_file_name)
&& ! NILP (elt)
@@ -3661,24 +3628,18 @@ read_list (int flag, register Lisp_Object readcharfun)
}
invalid_syntax ("] in a list");
}
- tem = (read_pure && flag <= 0
- ? pure_cons (elt, Qnil)
- : Fcons (elt, Qnil));
+ tem = Fcons (elt, Qnil);
if (!NILP (tail))
XSETCDR (tail, tem);
else
val = tem;
tail = tem;
- if (defunflag < 0)
- defunflag = EQ (elt, Qdefun);
- else if (defunflag > 0)
- read_pure = 1;
}
}
static Lisp_Object initial_obarray;
-/* oblookup stores the bucket number here, for the sake of Funintern. */
+/* `oblookup' stores the bucket number here, for the sake of Funintern. */
static size_t oblookup_last_bucket_number;
@@ -3701,32 +3662,20 @@ check_obarray (Lisp_Object obarray)
interned in the current obarray. */
Lisp_Object
-intern (const char *str)
+intern_1 (const char *str, ptrdiff_t len)
{
- Lisp_Object tem;
- ptrdiff_t len = strlen (str);
- Lisp_Object obarray;
+ Lisp_Object obarray = check_obarray (Vobarray);
+ Lisp_Object tem = oblookup (obarray, str, len, len);
- obarray = Vobarray;
- if (!VECTORP (obarray) || ASIZE (obarray) == 0)
- obarray = check_obarray (obarray);
- tem = oblookup (obarray, str, len, len);
- if (SYMBOLP (tem))
- return tem;
- return Fintern (make_string (str, len), obarray);
+ return SYMBOLP (tem) ? tem : Fintern (make_string (str, len), obarray);
}
Lisp_Object
-intern_c_string (const char *str)
+intern_c_string_1 (const char *str, ptrdiff_t len)
{
- Lisp_Object tem;
- ptrdiff_t len = strlen (str);
- Lisp_Object obarray;
+ Lisp_Object obarray = check_obarray (Vobarray);
+ Lisp_Object tem = oblookup (obarray, str, len, len);
- obarray = Vobarray;
- if (!VECTORP (obarray) || ASIZE (obarray) == 0)
- obarray = check_obarray (obarray);
- tem = oblookup (obarray, str, len, len);
if (SYMBOLP (tem))
return tem;
@@ -3734,9 +3683,9 @@ intern_c_string (const char *str)
/* 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. */
- abort ();
+ emacs_abort ();
- return Fintern (make_pure_c_string (str), obarray);
+ return Fintern (make_pure_c_string (str, len), obarray);
}
DEFUN ("intern", Fintern, Sintern, 1, 2, 0,
@@ -3776,11 +3725,11 @@ it defaults to the value of `obarray'. */)
SET_SYMBOL_VAL (XSYMBOL (sym), sym);
}
- ptr = &XVECTOR (obarray)->contents[XINT (tem)];
+ ptr = aref_addr (obarray, XINT(tem));
if (SYMBOLP (*ptr))
- XSYMBOL (sym)->next = XSYMBOL (*ptr);
+ set_symbol_next (sym, XSYMBOL (*ptr));
else
- XSYMBOL (sym)->next = 0;
+ set_symbol_next (sym, NULL);
*ptr = sym;
return sym;
}
@@ -3855,25 +3804,29 @@ OBARRAY defaults to the value of the variable `obarray'. */)
hash = oblookup_last_bucket_number;
- if (EQ (XVECTOR (obarray)->contents[hash], tem))
+ if (EQ (AREF (obarray, hash), tem))
{
if (XSYMBOL (tem)->next)
- XSETSYMBOL (XVECTOR (obarray)->contents[hash], XSYMBOL (tem)->next);
+ {
+ Lisp_Object sym;
+ XSETSYMBOL (sym, XSYMBOL (tem)->next);
+ ASET (obarray, hash, sym);
+ }
else
- XSETINT (XVECTOR (obarray)->contents[hash], 0);
+ ASET (obarray, hash, make_number (0));
}
else
{
Lisp_Object tail, following;
- for (tail = XVECTOR (obarray)->contents[hash];
+ for (tail = AREF (obarray, hash);
XSYMBOL (tail)->next;
tail = following)
{
XSETSYMBOL (following, XSYMBOL (tail)->next);
if (EQ (following, tem))
{
- XSYMBOL (tail)->next = XSYMBOL (following)->next;
+ set_symbol_next (tail, XSYMBOL (following)->next);
break;
}
}
@@ -3889,28 +3842,25 @@ OBARRAY defaults to the value of the variable `obarray'. */)
Also store the bucket number in oblookup_last_bucket_number. */
Lisp_Object
-oblookup (Lisp_Object obarray, register const char *ptr, EMACS_INT size, EMACS_INT size_byte)
+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;
- if (!VECTORP (obarray)
- || (obsize = ASIZE (obarray)) == 0)
- {
- obarray = check_obarray (obarray);
- obsize = ASIZE (obarray);
- }
+ 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 = XVECTOR (obarray)->contents[hash];
+ 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 */
+ error ("Bad data in guts of obarray"); /* Like CADR error message. */
else
for (tail = bucket; ; XSETSYMBOL (tail, XSYMBOL (tail)->next))
{
@@ -3933,7 +3883,7 @@ map_obarray (Lisp_Object obarray, void (*fn) (Lisp_Object, Lisp_Object), Lisp_Ob
CHECK_VECTOR (obarray);
for (i = ASIZE (obarray) - 1; i >= 0; i--)
{
- tail = XVECTOR (obarray)->contents[i];
+ tail = AREF (obarray, i);
if (SYMBOLP (tail))
while (1)
{
@@ -3977,7 +3927,7 @@ init_obarray (void)
initial_obarray = Vobarray;
staticpro (&initial_obarray);
- Qunbound = Fmake_symbol (make_pure_c_string ("unbound"));
+ 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);
@@ -3986,15 +3936,16 @@ init_obarray (void)
/* 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);
- XSYMBOL (Qunbound)->function = Qunbound;
- XSYMBOL (Qunbound)->plist = Qnil;
- /* XSYMBOL (Qnil)->function = Qunbound; */
+ set_symbol_function (Qunbound, Qunbound);
+ set_symbol_plist (Qunbound, Qnil);
SET_SYMBOL_VAL (XSYMBOL (Qnil), Qnil);
XSYMBOL (Qnil)->constant = 1;
- XSYMBOL (Qnil)->plist = Qnil;
+ XSYMBOL (Qnil)->declared_special = 1;
+ set_symbol_plist (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. */
@@ -4002,20 +3953,21 @@ init_obarray (void)
DEFSYM (Qvariable_documentation, "variable-documentation");
- read_buffer = (char *) xmalloc (size);
+ read_buffer = xmalloc (size);
read_buffer_size = size;
}
void
defsubr (struct Lisp_Subr *sname)
{
- Lisp_Object sym;
+ Lisp_Object sym, tem;
sym = intern_c_string (sname->symbol_name);
XSETTYPED_PVECTYPE (sname, size, PVEC_SUBR);
- XSETSUBR (XSYMBOL (sym)->function, sname);
+ XSETSUBR (tem, sname);
+ set_symbol_function (sym, tem);
}
-#ifdef NOTDEF /* use fset in subr.el now */
+#ifdef NOTDEF /* Use fset in subr.el now! */
void
defalias (struct Lisp_Subr *sname, char *string)
{
@@ -4045,7 +3997,7 @@ defvar_int (struct Lisp_Intfwd *i_fwd,
nil if address contains 0. */
void
defvar_bool (struct Lisp_Boolfwd *b_fwd,
- const char *namestring, int *address)
+ const char *namestring, bool *address)
{
Lisp_Object sym;
sym = intern_c_string (namestring);
@@ -4099,62 +4051,105 @@ defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd,
SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
}
+/* Check that the elements of Vload_path exist. */
+
+static void
+load_path_check (void)
+{
+ 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))
+ {
+ Lisp_Object dirfile;
+ dirfile = Fcar (path_tail);
+ if (STRINGP (dirfile))
+ {
+ dirfile = Fdirectory_file_name (dirfile);
+ if (access (SSDATA (dirfile), 0) < 0)
+ dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
+ XCAR (path_tail));
+ }
+ }
+}
+
/* 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;
+/* 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.
+ 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.
+
+ 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 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.
+ 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).
+*/
+
void
init_lread (void)
{
const char *normal;
- int turn_off_warning = 0;
-
- /* Compute the default Vload-path, with the following logic:
- If CANNOT_DUMP just use PATH_LOADSEARCH.
- Else if purify-flag (ie dumping) start from PATH_DUMPLOADSEARCH;
- otherwise start from 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.)
- Also do nothing if Vinstallation_directory is nil.
- Otherwise:
- Remove site-lisp directories from the front of load-path.
- Add installation-dir/lisp (if exists and not already a member),
- at the front, and turn off warnings about missing directories
- (because we are presumably running uninstalled).
- If it does not exist, add dump_path at the end instead.
- Add installation-dir/leim (if exists and not already a member)
- at the front.
- 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 previously removed site-lisp directories back
- at the front (if !no_site_lisp).
-
- We then warn about any of the load-path elements that do not
- exist. The only ones that might not exist are those from
- PATH_LOADSEARCH, and perhaps dump_path.
-
- Having done all this, we then throw it all away if purify-flag is
- nil (ie, not dumping) and EMACSLOADPATH is set, and just
- unconditionally use the latter value instead.
- So AFAICS the only net results of all the previous steps will be
- possibly to issue some irrelevant warnings.
-
- FIXME? There's a case for saying that if we are running
- uninstalled, the eventual installation directories should not yet
- be included in load-path.
- */
+
#ifdef CANNOT_DUMP
+#ifdef HAVE_NS
+ const char *loadpath = ns_load_path ();
+#endif
+
normal = PATH_LOADSEARCH;
- Vload_path = decode_env_path (0, normal);
+#ifdef HAVE_NS
+ Vload_path = decode_env_path ("EMACSLOADPATH", loadpath ? loadpath : normal);
#else
+ Vload_path = decode_env_path ("EMACSLOADPATH", normal);
+#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;
+ {
+ 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;
@@ -4163,183 +4158,155 @@ init_lread (void)
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. */
+ change it further. Changes can only be due to EMACSLOADPATH, or
+ site-lisp files that were processed during dumping. */
if (initialized)
{
- if (! NILP (Fequal (dump_path, Vload_path)))
+ 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);
+#else
Vload_path = decode_env_path (0, normal);
- if (no_site_lisp || !NILP (Vinstallation_directory))
+#endif
+ if (!NILP (Vinstallation_directory))
{
- Lisp_Object tem, tem1, sitelisp;
-
- /* Remove "site-lisp" dirs from front of path temporarily
- and store them in sitelisp, then conc them on at the
- end so they're always first in path.
- Note that this won't work if you used a
- --enable-locallisppath element that does not happen
- to contain "site-lisp" in its name.
- */
- sitelisp = Qnil;
- while (1)
- {
- tem = Fcar (Vload_path);
- tem1 = Fstring_match (build_string ("site-lisp"),
- tem, Qnil);
- if (!NILP (tem1))
- {
- Vload_path = Fcdr (Vload_path);
- sitelisp = Fcons (tem, sitelisp);
- }
- else
- break;
- }
-
- if (!NILP (Vinstallation_directory))
- {
- /* Add to the path the lisp subdir of the
- installation dir, if it exists. */
- tem = Fexpand_file_name (build_string ("lisp"),
- Vinstallation_directory);
- tem1 = Ffile_exists_p (tem);
- if (!NILP (tem1))
- {
- if (NILP (Fmember (tem, Vload_path)))
- {
- turn_off_warning = 1;
- Vload_path = Fcons (tem, Vload_path);
- }
- }
- else
- /* That dir doesn't exist, so add the build-time
- Lisp dirs instead. */
- Vload_path = nconc2 (Vload_path, dump_path);
-
- /* Add leim under the installation dir, if it exists. */
- tem = Fexpand_file_name (build_string ("leim"),
- Vinstallation_directory);
- tem1 = Ffile_exists_p (tem);
- if (!NILP (tem1))
- {
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
- }
-
- /* 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_exists_p (tem);
- if (!NILP (tem1))
- {
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
- }
- }
-
- /* 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 (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);
-
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
-
- tem = Fexpand_file_name (build_string ("leim"),
- Vsource_directory);
-
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
-
- if (!no_site_lisp)
- {
- tem = Fexpand_file_name (build_string ("site-lisp"),
- Vsource_directory);
-
- if (NILP (Fmember (tem, Vload_path)))
- Vload_path = Fcons (tem, Vload_path);
- }
- }
- } /* Vinstallation_directory != Vsource_directory */
- } /* if Vinstallation_directory */
- if (!NILP (sitelisp) && !no_site_lisp)
- Vload_path = nconc2 (Fnreverse (sitelisp), Vload_path);
- } /* if Vinstallation_directory || no_site_lisp */
- } /* if dump_path == Vload_path */
+ Lisp_Object tem, tem1;
+
+ /* Add to the path the lisp subdir of the installation
+ dir, if it exists. Note: in out-of-tree builds,
+ this directory is empty save for Makefile. */
+ tem = Fexpand_file_name (build_string ("lisp"),
+ Vinstallation_directory);
+ tem1 = Ffile_exists_p (tem);
+ if (!NILP (tem1))
+ {
+ 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 = Fcons (tem, Qnil);
+ }
+ }
+ else
+ /* That dir doesn't exist, so add the build-time
+ Lisp dirs instead. */
+ Vload_path = nconc2 (Vload_path, dump_path);
+
+ /* Add leim under the installation dir, if it exists. */
+ tem = Fexpand_file_name (build_string ("leim"),
+ Vinstallation_directory);
+ tem1 = Ffile_exists_p (tem);
+ if (!NILP (tem1))
+ {
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = Fcons (tem, Vload_path);
+ }
+
+ /* 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_exists_p (tem);
+ if (!NILP (tem1))
+ {
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = Fcons (tem, Vload_path);
+ }
+ }
+
+ /* 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 (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);
+
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = Fcons (tem, Vload_path);
+
+ tem = Fexpand_file_name (build_string ("leim"),
+ Vsource_directory);
+
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = Fcons (tem, Vload_path);
+
+ if (!no_site_lisp)
+ {
+ tem = Fexpand_file_name (build_string ("site-lisp"),
+ Vsource_directory);
+ tem1 = Ffile_exists_p (tem);
+ if (!NILP (tem1))
+ {
+ if (NILP (Fmember (tem, Vload_path)))
+ Vload_path = Fcons (tem, Vload_path);
+ }
+ }
+ }
+ } /* Vinstallation_directory != Vsource_directory */
+
+ } /* if Vinstallation_directory */
+
+ /* 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 ();
+
+ /* Add the site-lisp directories at the front. */
+ if (!no_site_lisp)
+ {
+ Lisp_Object sitelisp;
+ sitelisp = decode_env_path (0, PATH_SITELOADSEARCH);
+ if (! NILP (sitelisp)) Vload_path = nconc2 (sitelisp, Vload_path);
+ }
+ } /* if dump_path == Vload_path */
}
else /* !initialized */
{
- /* NORMAL refers to the lisp dir in the source directory. */
- /* We used to add ../lisp 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 be unnecessary. */
+ /* 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. */
}
-#endif /* CANNOT_DUMP */
-
-#if (!(defined (WINDOWSNT) || (defined (HAVE_NS))))
- /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
- almost never correct, thereby causing a warning to be printed out that
- confuses users. Since PATH_LOADSEARCH is always overridden by the
- EMACSLOADPATH environment variable below, disable the warning on NT. */
-
- /* HAVE_NS also uses EMACSLOADPATH. */
-
- /* Warn if dirs in the *standard* path don't exist. */
- if (!turn_off_warning)
- {
- Lisp_Object path_tail;
-
- for (path_tail = Vload_path;
- !NILP (path_tail);
- path_tail = XCDR (path_tail))
- {
- Lisp_Object dirfile;
- dirfile = Fcar (path_tail);
- if (STRINGP (dirfile))
- {
- dirfile = Fdirectory_file_name (dirfile);
- /* Do we really need to warn about missing site-lisp dirs?
- It's true that the installation should have created
- them and added subdirs.el, but it's harmless if they
- are not there. */
- if (access (SSDATA (dirfile), 0) < 0)
- dir_warning ("Warning: Lisp directory `%s' does not exist.\n",
- XCAR (path_tail));
- }
- }
- }
-#endif /* !(WINDOWSNT || HAVE_NS) */
-
- /* If the EMACSLOADPATH environment variable is set, use its value.
- This doesn't apply if we're dumping. */
-#ifndef CANNOT_DUMP
- if (NILP (Vpurify_flag)
- && egetenv ("EMACSLOADPATH"))
-#endif
- Vload_path = decode_env_path ("EMACSLOADPATH", normal);
+#endif /* !CANNOT_DUMP */
Vvalues = Qnil;
@@ -4360,15 +4327,13 @@ dir_warning (const char *format, Lisp_Object dirname)
{
fprintf (stderr, format, SDATA (dirname));
- /* Don't log the warning before we've initialized!! */
+ /* Don't log the warning before we've initialized!! */
if (initialized)
{
- char *buffer;
- ptrdiff_t message_len;
USE_SAFE_ALLOCA;
- SAFE_ALLOCA (buffer, char *,
- SBYTES (dirname) + strlen (format) - (sizeof "%s" - 1) + 1);
- message_len = esprintf (buffer, format, SDATA (dirname));
+ char *buffer = SAFE_ALLOCA (SBYTES (dirname)
+ + strlen (format) - (sizeof "%s" - 1) + 1);
+ ptrdiff_t message_len = esprintf (buffer, format, SDATA (dirname));
message_dolog (buffer, message_len, 0, STRING_MULTIBYTE (dirname));
SAFE_FREE ();
}
@@ -4401,7 +4366,8 @@ 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. */);
+ Order is reverse chronological. */);
+ XSYMBOL (intern ("values"))->declared_special = 0;
DEFVAR_LISP ("standard-input", Vstandard_input,
doc: /* Stream for read to get input from.
@@ -4419,7 +4385,7 @@ defined, although they may be in the future.
The positions are relative to the last call to `read' or
`read-from-string'. It is probably a bad idea to set this variable at
-the toplevel; bind it instead. */);
+the toplevel; bind it instead. */);
Vread_with_symbol_positions = Qnil;
DEFVAR_LISP ("read-symbol-positions-list", Vread_symbol_positions_list,
@@ -4434,7 +4400,7 @@ symbol from the position where `read' or `read-from-string' started.
Note that a symbol will appear multiple times in this list, if it was
read multiple times. The list is in the same order as the symbols
-were read in. */);
+were read in. */);
Vread_symbol_positions_list = Qnil;
DEFVAR_LISP ("read-circle", Vread_circle,
@@ -4442,7 +4408,7 @@ were read in. */);
Vread_circle = Qt;
DEFVAR_LISP ("load-path", Vload_path,
- doc: /* *List of directories to search for files to load.
+ 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. */);
@@ -4452,8 +4418,8 @@ otherwise to default specified by file `epaths.h' when Emacs was built. */);
This list should not include the empty string.
`load' and related functions try to append these suffixes, in order,
to the specified file name if a Lisp suffix is allowed or required. */);
- Vload_suffixes = Fcons (make_pure_c_string (".elc"),
- Fcons (make_pure_c_string (".el"), Qnil));
+ Vload_suffixes = Fcons (build_pure_c_string (".elc"),
+ Fcons (build_pure_c_string (".el"), Qnil));
DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
doc: /* List of suffixes that indicate representations of \
the same file.
@@ -4586,16 +4552,17 @@ from the file, and matches them against this regular expression.
When the regular expression matches, the file is considered to be safe
to load. See also `load-dangerous-libraries'. */);
Vbytecomp_version_regexp
- = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
+ = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
- Qlexical_binding = intern ("lexical-binding");
- staticpro (&Qlexical_binding);
+ DEFSYM (Qlexical_binding, "lexical-binding");
DEFVAR_LISP ("lexical-binding", Vlexical_binding,
doc: /* Whether to use lexical binding when evaluating code.
Non-nil means that the code in the current buffer should be evaluated
with lexical binding.
This variable is automatically set from the file variables of an
-interpreted Lisp file read using `load'. */);
+interpreted Lisp file read using `load'. Unlike other file local
+variables, this must be set in the first line of a file. */);
+ Vlexical_binding = Qnil;
Fmake_variable_buffer_local (Qlexical_binding);
DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list,