#include <sys/file.h>
#include <errno.h>
#include <limits.h> /* For CHAR_BIT. */
+#include <math.h>
#include <stat-time.h>
#include "lisp.h"
+#include "dispextern.h"
#include "intervals.h"
#include "character.h"
#include "buffer.h"
#include <epaths.h>
#include "commands.h"
#include "keyboard.h"
-#include "frame.h"
+#include "systime.h"
#include "termhooks.h"
#include "blockinput.h"
return Fnreverse (lst);
}
+/* Returns true if STRING ends with SUFFIX */
+static bool
+suffix_p (Lisp_Object string, const char *suffix)
+{
+ ptrdiff_t suffix_len = strlen (suffix);
+ ptrdiff_t string_len = SBYTES (string);
+
+ return string_len >= suffix_len && !strcmp (SSDATA (string) + string_len - suffix_len, suffix);
+}
+
DEFUN ("load", Fload, Sload, 1, 5, 0,
doc: /* Execute a file of Lisp code named FILE.
-First try FILE with `.elc' appended, then try with `.el',
+First try FILE with `.elc' appended, then try with `.el', then try
+with a system-dependent suffix of dynamic modules (see `load-suffixes'),
then try FILE unmodified (the exact suffixes in the exact order are
determined by `load-suffixes'). Environment variable references in
FILE are replaced with their values by calling `substitute-in-file-name'.
optional third arg NOMESSAGE is non-nil (but `force-load-messages'
overrides that).
If optional fourth arg NOSUFFIX is non-nil, don't try adding
-suffixes `.elc' or `.el' to the specified name FILE.
+suffixes to the specified name FILE.
If optional fifth arg MUST-SUFFIX is non-nil, insist on
-the suffix `.elc' or `.el'; don't accept just FILE unless
-it ends in one of those suffixes or includes a directory name.
+the suffix `.elc' or `.el' or the module suffix; don't accept just
+FILE unless it ends in one of those suffixes or includes a directory name.
If NOSUFFIX is nil, then if a file could not be found, try looking for
a different representation of the file by adding non-empty suffixes to
int fd;
int fd_index;
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object found, efound, hist_file_name;
/* True means we printed the ".el is newer" message. */
bool newer = 0;
bool compiled = 0;
Lisp_Object handler;
bool safe_p = 1;
- const char *fmode = "r";
+ const char *fmode = "r" FOPEN_TEXT;
int version;
-#ifdef DOS_NT
- fmode = "rt";
-#endif /* DOS_NT */
-
CHECK_STRING (file);
/* If file name is magic, call the handler. */
if (!NILP (handler))
return call5 (handler, Qload, file, noerror, nomessage, nosuffix); */
- /* Do this after the handler to avoid
- the need to gcpro noerror, nomessage and nosuffix.
- (Below here, we care only whether they are nil or not.)
- The presence of this call is the result of a historical accident:
+ /* The presence of this call is the result of a historical accident:
it used to be in every file-operation and when it got removed
everywhere, it accidentally stayed here. Since then, enough people
supposedly have things like (load "$PROJECT/foo.el") in their .emacs
{
Lisp_Object suffixes;
found = Qnil;
- GCPRO2 (file, found);
if (! NILP (must_suffix))
{
/* Don't insist on adding a suffix if FILE already ends with one. */
- ptrdiff_t size = SBYTES (file);
- if (size > 3
- && !strcmp (SSDATA (file) + size - 3, ".el"))
- must_suffix = Qnil;
- else if (size > 4
- && !strcmp (SSDATA (file) + size - 4, ".elc"))
+ if (suffix_p (file, ".el")
+ || suffix_p (file, ".elc")
+#ifdef HAVE_MODULES
+ || suffix_p (file, MODULES_SUFFIX)
+#endif
+ )
must_suffix = Qnil;
/* Don't insist on adding a suffix
if the argument includes a directory name. */
}
fd = openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer);
- UNGCPRO;
}
if (fd == -1)
record_unwind_protect_int (close_file_unwind, fd);
}
+#ifdef HAVE_MODULES
+ if (suffix_p (found, MODULES_SUFFIX))
+ return unbind_to (count, Fmodule_load (found));
+#endif
+
/* Check if we're stuck in a recursive load cycle.
2000-09-21: It's not possible to just check for the file loaded
specbind (Qold_style_backquotes, Qnil);
record_unwind_protect (load_warn_old_style_backquotes, file);
- if (!memcmp (SDATA (found) + SBYTES (found) - 4, ".elc", 4)
- || (fd >= 0 && (version = safe_to_load_version (fd)) > 0))
+ if (suffix_p (found, ".elc") || (fd >= 0 && (version = safe_to_load_version (fd)) > 0))
/* Load .elc files directly, but not when they are
remote and have no handler! */
{
struct stat s1, s2;
int result;
- GCPRO3 (file, found, hist_file_name);
-
if (version < 0
&& ! (version = safe_to_load_version (fd)))
{
compiled = 1;
efound = ENCODE_FILE (found);
-
-#ifdef DOS_NT
- fmode = "rb";
-#endif /* DOS_NT */
+ fmode = "r" FOPEN_BINARY;
/* openp already checked for newness, no point doing it again.
FIXME would be nice to get a message when openp
}
}
} /* !load_prefer_newer */
- UNGCPRO;
}
}
else
}
}
- GCPRO3 (file, found, hist_file_name);
-
if (fd < 0)
{
/* We somehow got here with fd == -2, meaning the file is deemed
if (!NILP (Ffboundp (Qdo_after_load_evaluation)))
call1 (Qdo_after_load_evaluation, hist_file_name) ;
- UNGCPRO;
-
xfree (saved_doc_string);
saved_doc_string = 0;
saved_doc_string_size = 0;
SUFFIXES is a list of strings containing possible suffixes.
The empty suffix is automatically added if the list is empty.
- PREDICATE non-nil means don't open the files,
+ PREDICATE t means the files are binary.
+ PREDICATE non-nil and non-t means don't open the files,
just look for one that satisfies the predicate. In this case,
return 1 on success. The predicate can be a lisp function or
an integer to pass to `access' (in which case file-name-handlers
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. */
+ or if a non-nil and non-t PREDICATE is specified. */
int
openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
bool absolute;
ptrdiff_t want_length;
Lisp_Object filename;
- 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;
}
string = filename = encoded_fn = save_string = Qnil;
- GCPRO7 (str, string, save_string, filename, path, suffixes, encoded_fn);
if (storeptr)
*storeptr = Qnil;
else
string = make_string (fn, fnlen);
handler = Ffind_file_name_handler (string, Qfile_exists_p);
- if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
+ if ((!NILP (handler) || (!NILP (predicate) && !EQ (predicate, Qt)))
+ && !NATNUMP (predicate))
{
bool exists;
- if (NILP (predicate))
+ if (NILP (predicate) || EQ (predicate, Qt))
exists = !NILP (Ffile_readable_p (string));
else
{
if (storeptr)
*storeptr = string;
SAFE_FREE ();
- UNGCPRO;
return -2;
}
}
}
else
{
- fd = emacs_open (pfn, O_RDONLY, 0);
+ int oflags = O_RDONLY + (NILP (predicate) ? 0 : O_BINARY);
+ fd = emacs_open (pfn, oflags, 0);
if (fd < 0)
{
if (errno != ENOENT)
if (storeptr)
*storeptr = string;
SAFE_FREE ();
- UNGCPRO;
return fd;
}
}
if (storeptr)
*storeptr = save_string;
SAFE_FREE ();
- UNGCPRO;
return save_fd;
}
}
}
SAFE_FREE ();
- UNGCPRO;
errno = last_errno;
return -1;
}
val = call2 (macroexpand, val, Qnil);
if (EQ (CAR_SAFE (val), Qprogn))
{
- struct gcpro gcpro1;
Lisp_Object subforms = XCDR (val);
- GCPRO1 (subforms);
for (val = Qnil; CONSP (subforms); subforms = XCDR (subforms))
val = readevalloop_eager_expand_eval (XCAR (subforms),
macroexpand);
- UNGCPRO;
}
else
val = eval_sub (call2 (macroexpand, val, Qt));
Lisp_Object unibyte, Lisp_Object readfun,
Lisp_Object start, Lisp_Object end)
{
- register int c;
- register Lisp_Object val;
+ int c;
+ Lisp_Object val;
ptrdiff_t count = SPECPDL_INDEX ();
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
struct buffer *b = 0;
bool continue_reading_p;
Lisp_Object lex_bound;
if (! NILP (start) && !b)
emacs_abort ();
- specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */
+ specbind (Qstandard_input, readcharfun);
specbind (Qcurrent_load_list, Qnil);
record_unwind_protect_int (readevalloop_1, load_convert_to_unibyte);
load_convert_to_unibyte = !NILP (unibyte);
(NILP (lex_bound) || EQ (lex_bound, Qunbound)
? Qnil : list1 (Qt)));
- GCPRO4 (sourcename, readfun, start, end);
-
/* Try to ensure sourcename is a truename, except whilst preloading. */
if (NILP (Vpurify_flag)
&& !NILP (sourcename) && !NILP (Ffile_name_absolute_p (sourcename))
/* Ignore whitespace here, so we can detect eof. */
if (c == ' ' || c == '\t' || c == '\n' || c == '\f' || c == '\r'
- || c == 0xa0) /* NBSP */
+ || c == NO_BREAK_SPACE)
goto read_next;
if (!NILP (Vpurify_flag) && c == '(')
build_load_history (sourcename,
stream || whole_buffer);
- UNGCPRO;
-
unbind_to (count, Qnil);
}
DEFUN ("eval-buffer", Feval_buffer, Seval_buffer, 0, 5, "",
- doc: /* Execute the current buffer as Lisp code.
+ doc: /* Execute the accessible portion of current buffer as Lisp code.
+You can use \\[narrow-to-region] to limit the part of buffer to be evaluated.
When called from a Lisp program (i.e., not interactively), this
function accepts up to five optional arguments:
-BUFFER is the buffer to evaluate (nil means use current buffer).
-PRINTFLAG controls printing of output:
- A value of nil means discard it; anything else is stream for print.
+BUFFER is the buffer to evaluate (nil means use current buffer),
+ or a name of a buffer (a string).
+PRINTFLAG controls printing of output by any output functions in the
+ evaluated code, such as `print', `princ', and `prin1':
+ a value of nil means discard it; anything else is the stream to print to.
+ See Info node `(elisp)Output Streams' for details on streams.
FILENAME specifies the file name to use for `load-history'.
UNIBYTE, if non-nil, specifies `load-convert-to-unibyte' for this
invocation.
-DO-ALLOW-PRINT, if non-nil, specifies that `print' and related
- functions should work normally even if PRINTFLAG is nil.
+DO-ALLOW-PRINT, if non-nil, specifies that output functions in the
+ evaluated code should work normally even if PRINTFLAG is nil, in
+ which case the output is displayed in the echo area.
This function preserves the position of point. */)
(Lisp_Object buffer, Lisp_Object printflag, Lisp_Object filename, Lisp_Object unibyte, Lisp_Object do_allow_print)
giving starting and ending indices in the current buffer
of the text to be executed.
Programs can pass third argument PRINTFLAG which controls output:
-A value of nil means discard it; anything else is stream for printing it.
+ a value of nil means discard it; anything else is stream for printing it.
+ See Info node `(elisp)Output Streams' for details on streams.
Also the fourth argument READ-FUNCTION, if non-nil, is used
instead of `read' to read each expression. It gets one argument
which is the input stream for reading characters.
static ptrdiff_t read_buffer_size;
static char *read_buffer;
+/* Grow the read buffer by at least MAX_MULTIBYTE_LENGTH bytes. */
+
+static void
+grow_read_buffer (void)
+{
+ read_buffer = xpalloc (read_buffer, &read_buffer_size,
+ MAX_MULTIBYTE_LENGTH, -1, 1);
+}
+
/* Read a \-escape sequence, assuming we already read the `\'.
If the escape sequence forces unibyte, return eight-bit char. */
if (c == '(')
{
Lisp_Object tmp;
- struct gcpro gcpro1;
int ch;
/* Read the string itself. */
tmp = read1 (readcharfun, &ch, 0);
if (ch != 0 || !STRINGP (tmp))
invalid_syntax ("#");
- GCPRO1 (tmp);
/* Read the intervals and their properties. */
while (1)
{
invalid_syntax ("Invalid string property list");
Fset_text_properties (beg, end, plist, tmp);
}
- UNGCPRO;
+
return tmp;
}
uninterned_symbol = 1;
c = READCHAR;
if (!(c > 040
- && c != 0xa0 /* NBSP */
+ && c != NO_BREAK_SPACE
&& (c >= 0200
|| strchr ("\"';()[]#`,", c) == NULL)))
{
if (end - p < MAX_MULTIBYTE_LENGTH)
{
ptrdiff_t offset = p - read_buffer;
- if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
- memory_full (SIZE_MAX);
- read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
- read_buffer_size *= 2;
+ grow_read_buffer ();
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
ch = read_escape (readcharfun, 1);
- /* CH is -1 if \ newline has just been seen. */
+ /* CH is -1 if \ newline or \ space has just been seen. */
if (ch == -1)
{
if (p == read_buffer)
default:
default_label:
if (c <= 040) goto retry;
- if (c == 0xa0) /* NBSP */
+ if (c == NO_BREAK_SPACE)
goto retry;
read_symbol:
if (end - p < MAX_MULTIBYTE_LENGTH)
{
ptrdiff_t offset = p - read_buffer;
- if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
- memory_full (SIZE_MAX);
- read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
- read_buffer_size *= 2;
+ grow_read_buffer ();
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
c = READCHAR;
}
while (c > 040
- && c != 0xa0 /* NBSP */
+ && c != NO_BREAK_SPACE
&& (c >= 0200
|| strchr ("\"';()[]#`,", c) == NULL));
if (p == end)
{
ptrdiff_t offset = p - read_buffer;
- if (min (PTRDIFF_MAX, SIZE_MAX) / 2 < read_buffer_size)
- memory_full (SIZE_MAX);
- read_buffer = xrealloc (read_buffer, read_buffer_size * 2);
- read_buffer_size *= 2;
+ grow_read_buffer ();
p = read_buffer + offset;
end = read_buffer + read_buffer_size;
}
{
case Lisp_Vectorlike:
{
- ptrdiff_t i, length = 0;
+ ptrdiff_t i = 0, length = 0;
if (BOOL_VECTOR_P (subtree))
return subtree; /* No sub-objects anyway. */
else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
behavior. */
wrong_type_argument (Qsequencep, subtree);
- for (i = 0; i < length; i++)
+ if (SUB_CHAR_TABLE_P (subtree))
+ i = 2;
+ for ( ; i < length; i++)
SUBSTITUTE (AREF (subtree, i),
ASET (subtree, i, true_value));
return subtree;
bool float_syntax = 0;
double value = 0;
- /* Compute NaN and infinities using a variable, to cope with compilers that
- think they are smarter than we are. */
- double zero = 0;
-
/* Negate the value ourselves. This treats 0, NaNs, and infinity properly on
IEEE floating point hosts, and works around a formerly-common bug where
atof ("-0.0") drops the sign. */
{
state |= E_EXP;
cp += 3;
- value = 1.0 / zero;
+ value = INFINITY;
}
else if (cp[-1] == '+'
&& cp[0] == 'N' && cp[1] == 'a' && cp[2] == 'N')
{
state |= E_EXP;
cp += 3;
- value = zero / zero;
-
- /* If that made a "negative" NaN, negate it. */
- {
- int i;
- union { double d; char c[sizeof (double)]; }
- u_data, u_minus_zero;
- u_data.d = value;
- u_minus_zero.d = -0.0;
- for (i = 0; i < sizeof (double); i++)
- if (u_data.c[i] & u_minus_zero.c[i])
- {
- value = -value;
- break;
- }
- }
- /* Now VALUE is a positive NaN. */
+ /* NAN is a "positive" NaN on all known Emacs hosts. */
+ value = NAN;
}
else
cp = ecp;
{
Lisp_Object val, tail;
Lisp_Object elt, tem;
- struct gcpro gcpro1, gcpro2;
/* 0 is the normal case.
1 means this list is a doc reference; replace it with the number 0.
2 means this list is a doc reference; replace it with the doc string. */
while (1)
{
int ch;
- GCPRO2 (val, tail);
elt = read1 (readcharfun, &ch, first_in_list);
- UNGCPRO;
first_in_list = 0;
return val;
if (ch == '.')
{
- GCPRO2 (val, tail);
if (!NILP (tail))
XSETCDR (tail, read0 (readcharfun));
else
val = read0 (readcharfun);
read1 (readcharfun, &ch, 0);
- UNGCPRO;
+
if (ch == ')')
{
if (doc_reference == 1)
Lisp_Object obarray = check_obarray (Vobarray);
Lisp_Object tem = oblookup (obarray, str, len, len);
- return SYMBOLP (tem) ? tem : intern_driver (make_string (str, len),
- obarray, tem);
+ return (SYMBOLP (tem) ? tem
+ /* The above `oblookup' was done on the basis of nchars==nbytes, so
+ the string has to be unibyte. */
+ : intern_driver (make_unibyte_string (str, len),
+ obarray, tem));
}
Lisp_Object
Lisp_Object bucket, tem;
obarray = check_obarray (obarray);
- obsize = ASIZE (obarray);
-
/* This is sometimes needed in the middle of GC. */
- obsize &= ~ARRAY_MARK_FLAG;
+ obsize = gc_asize (obarray);
hash = hash_string (ptr, size_byte) % obsize;
bucket = AREF (obarray, hash);
oblookup_last_bucket_number = hash;
load_path_check (default_lpath);
/* Add the site-lisp directories to the front of the default. */
- if (!no_site_lisp)
+ if (!no_site_lisp && PATH_SITELOADSEARCH[0] != '\0')
{
Lisp_Object sitelisp;
sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0);
load_path_check (Vload_path);
/* Add the site-lisp directories at the front. */
- if (initialized && !no_site_lisp)
+ if (initialized && !no_site_lisp && PATH_SITELOADSEARCH[0] != '\0')
{
Lisp_Object sitelisp;
sitelisp = decode_env_path (0, PATH_SITELOADSEARCH, 0);
void
dir_warning (char const *use, Lisp_Object dirname)
{
- static char const format[] = "Warning: %s `%s': %s\n";
+ static char const format[] = "Warning: %s '%s': %s\n";
int access_errno = errno;
- fprintf (stderr, format, use, SSDATA (dirname), strerror (access_errno));
+ fprintf (stderr, format, use, SSDATA (ENCODE_SYSTEM (dirname)),
+ strerror (access_errno));
/* Don't log the warning before we've initialized!! */
if (initialized)
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,
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 (meaning `default-directory').
-Initialized during startup as described in Info node `(elisp)Library Search'. */);
+Each element is a string (directory file name) or nil (meaning
+`default-directory').
+Initialized during startup as described in Info node `(elisp)Library Search'.
+Use `directory-file-name' when adding items to this path. However, Lisp
+programs that process this list should tolerate directories both with
+and without trailing slashes. */);
DEFVAR_LISP ("load-suffixes", Vload_suffixes,
- doc: /* List of suffixes for (compiled or source) Emacs Lisp files.
+ doc: /* List of suffixes for Emacs Lisp files and dynamic modules.
+This list includes suffixes for both compiled and source Emacs Lisp files.
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. */);
+to the specified file name if a suffix is allowed or required. */);
+#ifdef HAVE_MODULES
+ Vload_suffixes = list3 (build_pure_c_string (".elc"),
+ build_pure_c_string (".el"),
+ build_pure_c_string (MODULES_SUFFIX));
+#else
Vload_suffixes = list2 (build_pure_c_string (".elc"),
build_pure_c_string (".el"));
+#endif
+ DEFVAR_LISP ("module-file-suffix", Vmodule_file_suffix,
+ doc: /* Suffix of loadable module file, or nil of modules are not supported. */);
+#ifdef HAVE_MODULES
+ Vmodule_file_suffix = build_pure_c_string (MODULES_SUFFIX);
+#else
+ Vmodule_file_suffix = Qnil;
+#endif
DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
doc: /* List of suffixes that indicate representations of \
the same file.
Each element looks like (REGEXP-OR-FEATURE FUNCS...).
REGEXP-OR-FEATURE is either a regular expression to match file names, or
-a symbol \(a feature name).
+a symbol (a feature name).
When `load' is run and the file-name argument matches an element's
REGEXP-OR-FEATURE, or when `provide' is run and provides the symbol
DEFVAR_LISP ("load-read-function", Vload_read_function,
doc: /* Function used by `load' and `eval-region' for reading expressions.
-The default is nil, which means use the function `read'. */);
- Vload_read_function = Qnil;
+Called with a single argument (the stream from which to read).
+The default is to use the function `read'. */);
+ DEFSYM (Qread, "read");
+ Vload_read_function = Qread;
DEFVAR_LISP ("load-source-file-function", Vload_source_file_function,
doc: /* Function called in `load' to load an Emacs Lisp source file.