summaryrefslogtreecommitdiff
path: root/src/lread.c
diff options
context:
space:
mode:
Diffstat (limited to 'src/lread.c')
-rw-r--r--src/lread.c263
1 files changed, 218 insertions, 45 deletions
diff --git a/src/lread.c b/src/lread.c
index 010194c34ea..a6c2db5d994 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -1119,7 +1119,7 @@ This uses the variables `load-suffixes' and `load-file-rep-suffixes'. */)
}
/* Return true if STRING ends with SUFFIX. */
-static bool
+bool
suffix_p (Lisp_Object string, const char *suffix)
{
ptrdiff_t suffix_len = strlen (suffix);
@@ -1138,6 +1138,24 @@ close_infile_unwind (void *arg)
infile = prev_infile;
}
+/* Compute the filename we want in `load-history' and `load-file-name'. */
+
+static Lisp_Object
+compute_found_effective (Lisp_Object found)
+{
+ /* Reconstruct the .elc filename. */
+ Lisp_Object src_name =
+ Fgethash (Ffile_name_nondirectory (found), Vcomp_eln_to_el_h, Qnil);
+
+ if (NILP (src_name))
+ /* Manual eln load. */
+ return found;
+
+ if (suffix_p (src_name, "el.gz"))
+ src_name = Fsubstring (src_name, make_fixnum (0), make_fixnum (-3));
+ return concat2 (src_name, build_string ("c"));
+}
+
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', then try
@@ -1222,6 +1240,8 @@ Return t if the file exists and loads successfully. */)
else
file = Fsubstitute_in_file_name (file);
+ bool no_native = suffix_p (file, ".elc");
+
/* Avoid weird lossage with null string as arg,
since it would try to load a directory as a Lisp file. */
if (SCHARS (file) == 0)
@@ -1245,7 +1265,7 @@ Return t if the file exists and loads successfully. */)
|| suffix_p (file, MODULES_SECONDARY_SUFFIX)
#endif
#endif
- )
+ || (NATIVE_COMP_FLAG && suffix_p (file, NATIVE_ELISP_SUFFIX)))
must_suffix = Qnil;
/* Don't insist on adding a suffix
if the argument includes a directory name. */
@@ -1262,7 +1282,9 @@ Return t if the file exists and loads successfully. */)
suffixes = CALLN (Fappend, suffixes, Vload_file_rep_suffixes);
}
- fd = openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer);
+ fd =
+ openp (Vload_path, file, suffixes, &found, Qnil, load_prefer_newer,
+ no_native);
}
if (fd == -1)
@@ -1323,6 +1345,9 @@ Return t if the file exists and loads successfully. */)
bool is_module = false;
#endif
+ bool is_native_elisp =
+ NATIVE_COMP_FLAG && suffix_p (found, NATIVE_ELISP_SUFFIX) ? true : false;
+
/* Check if we're stuck in a recursive load cycle.
2000-09-21: It's not possible to just check for the file loaded
@@ -1349,11 +1374,15 @@ Return t if the file exists and loads successfully. */)
Vload_source_file_function. */
specbind (Qlexical_binding, Qnil);
- /* Get the name for load-history. */
+ Lisp_Object found_eff =
+ is_native_elisp
+ ? compute_found_effective (found)
+ : found;
+
hist_file_name = (! NILP (Vpurify_flag)
? concat2 (Ffile_name_directory (file),
- Ffile_name_nondirectory (found))
- : found) ;
+ Ffile_name_nondirectory (found_eff))
+ : found_eff);
version = -1;
@@ -1417,7 +1446,7 @@ Return t if the file exists and loads successfully. */)
} /* !load_prefer_newer */
}
}
- else if (!is_module)
+ else if (!is_module && !is_native_elisp)
{
/* We are loading a source file (*.el). */
if (!NILP (Vload_source_file_function))
@@ -1444,7 +1473,7 @@ Return t if the file exists and loads successfully. */)
stream = NULL;
errno = EINVAL;
}
- else if (!is_module)
+ else if (!is_module && !is_native_elisp)
{
#ifdef WINDOWSNT
emacs_close (fd);
@@ -1460,7 +1489,7 @@ Return t if the file exists and loads successfully. */)
might be accessed by the unbind_to call below. */
struct infile input;
- if (is_module)
+ if (is_module || is_native_elisp)
{
/* `module-load' uses the file name, so we can close the stream
now. */
@@ -1487,6 +1516,8 @@ Return t if the file exists and loads successfully. */)
{
if (is_module)
message_with_string ("Loading %s (module)...", file, 1);
+ else if (is_native_elisp)
+ message_with_string ("Loading %s (native compiled elisp)...", file, 1);
else if (!compiled)
message_with_string ("Loading %s (source)...", file, 1);
else if (newer)
@@ -1496,7 +1527,8 @@ Return t if the file exists and loads successfully. */)
message_with_string ("Loading %s...", file, 1);
}
- specbind (Qload_file_name, found);
+ specbind (Qload_file_name, found_eff);
+ specbind (Qload_true_file_name, found);
specbind (Qinhibit_file_name_operation, Qnil);
specbind (Qload_in_progress, Qt);
@@ -1512,6 +1544,19 @@ Return t if the file exists and loads successfully. */)
emacs_abort ();
#endif
}
+ else if (is_native_elisp)
+ {
+#ifdef HAVE_NATIVE_COMP
+ specbind (Qcurrent_load_list, Qnil);
+ LOADHIST_ATTACH (hist_file_name);
+ Fnative_elisp_load (found, Qnil);
+ build_load_history (hist_file_name, true);
+#else
+ /* This cannot happen. */
+ emacs_abort ();
+#endif
+
+ }
else
{
if (lisp_file_lexically_bound_p (Qget_file_char))
@@ -1547,6 +1592,8 @@ Return t if the file exists and loads successfully. */)
{
if (is_module)
message_with_string ("Loading %s (module)...done", file, 1);
+ else if (is_native_elisp)
+ message_with_string ("Loading %s (native compiled elisp)...done", file, 1);
else if (!compiled)
message_with_string ("Loading %s (source)...done", file, 1);
else if (newer)
@@ -1592,12 +1639,109 @@ 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, false);
+ int fd = openp (path, filename, suffixes, &file, predicate, false, false);
if (NILP (predicate) && fd >= 0)
emacs_close (fd);
return file;
}
+#ifdef HAVE_NATIVE_COMP
+static bool
+maybe_swap_for_eln1 (Lisp_Object src_name, Lisp_Object eln_name,
+ Lisp_Object *filename, int *fd, struct timespec mtime)
+{
+ struct stat eln_st;
+ int eln_fd = emacs_open (SSDATA (ENCODE_FILE (eln_name)), O_RDONLY, 0);
+
+ if (eln_fd > 0)
+ {
+ if (fstat (eln_fd, &eln_st) || S_ISDIR (eln_st.st_mode))
+ emacs_close (eln_fd);
+ else
+ {
+ struct timespec eln_mtime = get_stat_mtime (&eln_st);
+ if (timespec_cmp (eln_mtime, mtime) >= 0)
+ {
+ emacs_close (*fd);
+ *fd = eln_fd;
+ *filename = eln_name;
+ /* Store the eln -> el relation. */
+ Fputhash (Ffile_name_nondirectory (eln_name),
+ src_name, Vcomp_eln_to_el_h);
+ return true;
+ }
+ else
+ emacs_close (eln_fd);
+ }
+ }
+
+ return false;
+}
+#endif
+
+/* Look for a suitable .eln file to be loaded in place of FILENAME.
+ If found replace the content of FILENAME and FD. */
+
+static void
+maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd,
+ struct timespec mtime)
+{
+#ifdef HAVE_NATIVE_COMP
+
+ if (no_native
+ || load_no_native)
+ Fputhash (*filename, Qt, V_comp_no_native_file_h);
+ else
+ Fremhash (*filename, V_comp_no_native_file_h);
+
+ if (no_native
+ || load_no_native
+ || !suffix_p (*filename, ".elc"))
+ return;
+
+ /* Search eln in the eln-cache directories. */
+ Lisp_Object eln_path_tail = Vnative_comp_eln_load_path;
+ Lisp_Object src_name =
+ Fsubstring (*filename, Qnil, make_fixnum (-1));
+ if (NILP (Ffile_exists_p (src_name)))
+ {
+ src_name = concat2 (src_name, build_string (".gz"));
+ if (NILP (Ffile_exists_p (src_name)))
+ {
+ if (!NILP (find_symbol_value (
+ Qnative_comp_warning_on_missing_source)))
+ call2 (intern_c_string ("display-warning"),
+ Qcomp,
+ CALLN (Fformat,
+ build_string ("Cannot look-up eln file as no source "
+ "file was found for %s"),
+ *filename));
+ return;
+ }
+ }
+ Lisp_Object eln_rel_name = Fcomp_el_to_eln_rel_filename (src_name);
+
+ Lisp_Object dir = Qnil;
+ FOR_EACH_TAIL_SAFE (eln_path_tail)
+ {
+ dir = XCAR (eln_path_tail);
+ Lisp_Object eln_name =
+ Fexpand_file_name (eln_rel_name,
+ Fexpand_file_name (Vcomp_native_version_dir, dir));
+ if (maybe_swap_for_eln1 (src_name, eln_name, filename, fd, mtime))
+ return;
+ }
+
+ /* Look also in preloaded subfolder of the last entry in
+ `comp-eln-load-path'. */
+ dir = Fexpand_file_name (build_string ("preloaded"),
+ Fexpand_file_name (Vcomp_native_version_dir,
+ dir));
+ maybe_swap_for_eln1 (src_name, Fexpand_file_name (eln_rel_name, dir),
+ filename, fd, mtime);
+#endif
+}
+
/* Search for a file whose name is STR, looking in directories
in the Lisp list PATH, and trying suffixes from SUFFIX.
On success, return a file descriptor (or 1 or -2 as described below).
@@ -1622,11 +1766,14 @@ directories, make sure the PREDICATE function returns `dir-ok' for them. */)
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 a non-nil and non-t PREDICATE is specified. */
+ or if a non-nil and non-t PREDICATE is specified.
+
+ if NO_NATIVE is true do not try to load native code. */
int
openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
- Lisp_Object *storeptr, Lisp_Object predicate, bool newer)
+ Lisp_Object *storeptr, Lisp_Object predicate, bool newer,
+ bool no_native)
{
ptrdiff_t fn_size = 100;
char buf[100];
@@ -1798,7 +1945,17 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
}
else
{
- fd = emacs_open (pfn, O_RDONLY, 0);
+ /* In some systems (like Windows) finding out if a
+ file exists is cheaper to do than actually opening
+ it. Only open the file when we are sure that it
+ exists. */
+#ifdef WINDOWSNT
+ if (faccessat (AT_FDCWD, pfn, R_OK, AT_EACCESS))
+ fd = -1;
+ else
+#endif
+ fd = emacs_open (pfn, O_RDONLY, 0);
+
if (fd < 0)
{
if (! (errno == ENOENT || errno == ENOTDIR))
@@ -1836,6 +1993,8 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
}
else
{
+ maybe_swap_for_eln (no_native, &string, &fd,
+ get_stat_mtime (&st));
/* We succeeded; return this descriptor and filename. */
if (storeptr)
*storeptr = string;
@@ -1847,6 +2006,8 @@ openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
/* No more suffixes. Return the newest. */
if (0 <= save_fd && ! CONSP (XCDR (tail)))
{
+ maybe_swap_for_eln (no_native, &save_string, &save_fd,
+ save_mtime);
if (storeptr)
*storeptr = save_string;
SAFE_FREE ();
@@ -1942,8 +2103,8 @@ readevalloop_1 (int old)
static AVOID
end_of_file_error (void)
{
- if (STRINGP (Vload_file_name))
- xsignal1 (Qend_of_file, Vload_file_name);
+ if (STRINGP (Vload_true_file_name))
+ xsignal1 (Qend_of_file, Vload_true_file_name);
xsignal0 (Qend_of_file);
}
@@ -3777,8 +3938,7 @@ string_to_number (char const *string, int base, ptrdiff_t *plen)
bool signedp = negative | positive;
cp += signedp;
- enum { INTOVERFLOW = 1, LEAD_INT = 2, DOT_CHAR = 4, TRAIL_INT = 8,
- E_EXP = 16 };
+ enum { INTOVERFLOW = 1, LEAD_INT = 2, TRAIL_INT = 4, E_EXP = 16 };
int state = 0;
int leading_digit = digit_to_number (*cp, base);
uintmax_t n = leading_digit;
@@ -3798,7 +3958,6 @@ string_to_number (char const *string, int base, ptrdiff_t *plen)
char const *after_digits = cp;
if (*cp == '.')
{
- state |= DOT_CHAR;
cp++;
}
@@ -3847,8 +4006,10 @@ string_to_number (char const *string, int base, ptrdiff_t *plen)
cp = ecp;
}
- float_syntax = ((state & (DOT_CHAR|TRAIL_INT)) == (DOT_CHAR|TRAIL_INT)
- || (state & ~INTOVERFLOW) == (LEAD_INT|E_EXP));
+ /* A float has digits after the dot or an exponent.
+ This excludes numbers like "1." which are lexed as integers. */
+ float_syntax = ((state & TRAIL_INT)
+ || ((state & LEAD_INT) && (state & E_EXP)));
}
if (plen)
@@ -4204,10 +4365,14 @@ intern_c_string_1 (const char *str, ptrdiff_t len)
if (!SYMBOLP (tem))
{
- /* Creating a non-pure string from a string literal not implemented yet.
- We could just use make_string here and live with the extra copy. */
- eassert (!NILP (Vpurify_flag));
- tem = intern_driver (make_pure_c_string (str, len), obarray, tem);
+ Lisp_Object string;
+
+ if (NILP (Vpurify_flag))
+ string = make_string (str, len);
+ else
+ string = make_pure_c_string (str, len);
+
+ tem = intern_driver (string, obarray, tem);
}
return tem;
}
@@ -4467,6 +4632,10 @@ defsubr (union Aligned_Lisp_Subr *aname)
XSETPVECTYPE (sname, PVEC_SUBR);
XSETSUBR (tem, sname);
set_symbol_function (sym, tem);
+#ifdef HAVE_NATIVE_COMP
+ eassert (NILP (Vcomp_abi_hash));
+ Vcomp_subr_list = Fpurecopy (Fcons (tem, Vcomp_subr_list));
+#endif
}
#ifdef NOTDEF /* Use fset in subr.el now! */
@@ -4600,14 +4769,8 @@ load_path_default (void)
return decode_env_path (0, PATH_DUMPLOADSEARCH, 0);
Lisp_Object lpath = Qnil;
- const char *normal = PATH_LOADSEARCH;
- const char *loadpath = NULL;
-#ifdef HAVE_NS
- loadpath = ns_load_path ();
-#endif
-
- lpath = decode_env_path (0, loadpath ? loadpath : normal, 0);
+ lpath = decode_env_path (0, PATH_LOADSEARCH, 0);
if (!NILP (Vinstallation_directory))
{
@@ -4767,6 +4930,7 @@ init_lread (void)
load_in_progress = 0;
Vload_file_name = Qnil;
+ Vload_true_file_name = Qnil;
Vstandard_input = Qt;
Vloads_in_progress = Qnil;
}
@@ -4833,7 +4997,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.
+This variable is obsolete as of Emacs 28.1 and should not be used. */);
XSYMBOL (intern ("values"))->u.s.declared_special = false;
DEFVAR_LISP ("standard-input", Vstandard_input,
@@ -4890,20 +5055,15 @@ 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 suffix is allowed or required. */);
+ Vload_suffixes = list2 (build_pure_c_string (".elc"),
+ build_pure_c_string (".el"));
#ifdef HAVE_MODULES
+ Vload_suffixes = Fcons (build_pure_c_string (MODULES_SUFFIX), Vload_suffixes);
#ifdef MODULES_SECONDARY_SUFFIX
- Vload_suffixes = list4 (build_pure_c_string (".elc"),
- build_pure_c_string (".el"),
- build_pure_c_string (MODULES_SUFFIX),
- build_pure_c_string (MODULES_SECONDARY_SUFFIX));
-#else
- Vload_suffixes = list3 (build_pure_c_string (".elc"),
- build_pure_c_string (".el"),
- build_pure_c_string (MODULES_SUFFIX));
+ Vload_suffixes =
+ Fcons (build_pure_c_string (MODULES_SECONDARY_SUFFIX), Vload_suffixes);
#endif
-#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 if modules are not supported. */);
@@ -4970,9 +5130,17 @@ directory. These file names are converted to absolute at startup. */);
Vload_history = Qnil;
DEFVAR_LISP ("load-file-name", Vload_file_name,
- doc: /* Full name of file being loaded by `load'. */);
+ doc: /* Full name of file being loaded by `load'.
+
+In case of native code being loaded this is indicating the
+corresponding bytecode filename. Use `load-true-file-name' to obtain
+the .eln filename. */);
Vload_file_name = Qnil;
+ DEFVAR_LISP ("load-true-file-name", Vload_true_file_name,
+ doc: /* Full name of file being loaded by `load'. */);
+ Vload_true_file_name = Qnil;
+
DEFVAR_LISP ("user-init-file", Vuser_init_file,
doc: /* File name, including directory, of user's initialization file.
If the file loaded had extension `.elc', and the corresponding source file
@@ -5092,6 +5260,10 @@ Note that if you customize this, obviously it will not affect files
that are loaded before your customizations are read! */);
load_prefer_newer = 0;
+ DEFVAR_BOOL ("load-no-native", load_no_native,
+ doc: /* Non-nil means not to load a .eln file when a .elc was requested. */);
+ load_no_native = false;
+
/* Vsource_directory was initialized in init_lread. */
DEFSYM (Qcurrent_load_list, "current-load-list");
@@ -5114,6 +5286,7 @@ that are loaded before your customizations are read! */);
DEFSYM (Qfunction, "function");
DEFSYM (Qload, "load");
DEFSYM (Qload_file_name, "load-file-name");
+ DEFSYM (Qload_true_file_name, "load-true-file-name");
DEFSYM (Qeval_buffer_list, "eval-buffer-list");
DEFSYM (Qdir_ok, "dir-ok");
DEFSYM (Qdo_after_load_evaluation, "do-after-load-evaluation");
generated by cgit v1.2.3 (git 2.39.1) at 2024-05-04 04:55:17 +0000