#include <config.h>
-#include <stdio.h>
+#include "sysstdio.h"
#include <sys/types.h>
#include <sys/stat.h>
#include <sys/file.h>
It must be set to nil before all top-level calls to read0. */
static Lisp_Object read_objects;
-/* List of descriptors now open for Fload. */
-static Lisp_Object load_descriptor_list;
-
/* File for get_file_char to read from. Use by load. */
static FILE *instream;
static void readevalloop (Lisp_Object, FILE *, Lisp_Object, bool,
Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object);
-static Lisp_Object load_unwind (Lisp_Object);
-static Lisp_Object load_descriptor_unwind (Lisp_Object);
\f
/* Functions that read one byte from the current source READCHARFUN
or unreads one byte. If the integer argument C is -1, it returns
c = DECODE_CHAR (charset, code);
if (c < 0)
Fsignal (Qinvalid_read_syntax,
- Fcons (build_string ("invalid multibyte form"), Qnil));
+ list1 (build_string ("invalid multibyte form")));
return c;
}
bool error_nonascii, bool input_method, Lisp_Object seconds)
{
Lisp_Object val, delayed_switch_frame;
- EMACS_TIME end_time;
+ struct timespec end_time;
#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
if (NUMBERP (seconds))
{
double duration = extract_float (seconds);
- EMACS_TIME wait_time = EMACS_TIME_FROM_DOUBLE (duration);
- end_time = add_emacs_time (current_emacs_time (), wait_time);
+ struct timespec wait_time = dtotimespec (duration);
+ end_time = timespec_add (current_timespec (), wait_time);
}
/* Read until we get an acceptable event. */
{
if (error_nonascii)
{
- Vunread_command_events = Fcons (val, Qnil);
+ Vunread_command_events = list1 (val);
error ("Non-character input-event");
}
else
{
bool rv = 0;
enum {
- NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX,
+ NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX
} beg_end_state = NOMINAL;
bool in_file_vars = 0;
/* Callback for record_unwind_protect. Restore the old load list OLD,
after loading a file successfully. */
-static Lisp_Object
+static void
record_load_unwind (Lisp_Object old)
{
- return Vloads_in_progress = old;
+ Vloads_in_progress = old;
}
/* This handler function is used via internal_condition_case_1. */
return Qnil;
}
-static Lisp_Object
+static void
load_warn_old_style_backquotes (Lisp_Object file)
{
if (!NILP (Vold_style_backquotes))
args[1] = file;
Fmessage (2, args);
}
- return Qnil;
}
DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0,
is bound to the file's name.
Return t if the file exists and loads successfully. */)
- (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage, Lisp_Object nosuffix, Lisp_Object must_suffix)
+ (Lisp_Object file, Lisp_Object noerror, Lisp_Object nomessage,
+ Lisp_Object nosuffix, Lisp_Object must_suffix)
{
- register FILE *stream;
- register int fd = -1;
+ FILE *stream;
+ int fd;
+ int fd_index;
ptrdiff_t count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
Lisp_Object found, efound, hist_file_name;
Lisp_Object handler;
bool safe_p = 1;
const char *fmode = "r";
- Lisp_Object tmp[2];
int version;
#ifdef DOS_NT
else
file = Fsubstitute_in_file_name (file);
-
/* Avoid weird lossage with null string as arg,
since it would try to load a directory as a Lisp file. */
- if (SBYTES (file) > 0)
+ if (SCHARS (file) == 0)
{
- ptrdiff_t size = SBYTES (file);
-
+ fd = -1;
+ errno = ENOENT;
+ }
+ else
+ {
+ 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;
must_suffix = Qnil;
}
- fd = openp (Vload_path, file,
- (!NILP (nosuffix) ? Qnil
- : !NILP (must_suffix) ? Fget_load_suffixes ()
- : Fappend (2, (tmp[0] = Fget_load_suffixes (),
- tmp[1] = Vload_file_rep_suffixes,
- tmp))),
- &found, Qnil);
+ if (!NILP (nosuffix))
+ suffixes = Qnil;
+ else
+ {
+ suffixes = Fget_load_suffixes ();
+ if (NILP (must_suffix))
+ {
+ Lisp_Object arg[2];
+ arg[0] = suffixes;
+ arg[1] = Vload_file_rep_suffixes;
+ suffixes = Fappend (2, arg);
+ }
+ }
+
+ fd = openp (Vload_path, file, suffixes, &found, Qnil);
UNGCPRO;
}
if (fd == -1)
{
if (NILP (noerror))
- xsignal2 (Qfile_error, build_string ("Cannot open load file"), file);
+ report_file_error ("Cannot open load file", file);
return Qnil;
}
#endif
}
+ if (fd < 0)
+ {
+ /* Pacify older GCC with --enable-gcc-warnings. */
+ IF_LINT (fd_index = 0);
+ }
+ else
+ {
+ fd_index = SPECPDL_INDEX ();
+ record_unwind_protect_int (close_file_unwind, fd);
+ }
+
/* Check if we're stuck in a recursive load cycle.
2000-09-21: It's not possible to just check for the file loaded
Lisp_Object tem;
for (tem = Vloads_in_progress; CONSP (tem); tem = XCDR (tem))
if (!NILP (Fequal (found, XCAR (tem))) && (++load_count > 3))
- {
- if (fd >= 0)
- emacs_close (fd);
- signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
- }
+ signal_error ("Recursive load", Fcons (found, Vloads_in_progress));
record_unwind_protect (record_load_unwind, Vloads_in_progress);
Vloads_in_progress = Fcons (found, Vloads_in_progress);
}
/* 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),
- tmp))
+ ? concat2 (Ffile_name_directory (file),
+ Ffile_name_nondirectory (found))
: found) ;
version = -1;
{
safe_p = 0;
if (!load_dangerous_libraries)
- {
- if (fd >= 0)
- emacs_close (fd);
- error ("File `%s' was not compiled in Emacs",
- SDATA (found));
- }
+ error ("File `%s' was not compiled in Emacs", SDATA (found));
else if (!NILP (nomessage) && !force_load_messages)
message_with_string ("File `%s' not compiled in Emacs", found, 1);
}
}
if (result == 0
- && EMACS_TIME_LT (get_stat_mtime (&s1), get_stat_mtime (&s2)))
+ && timespec_cmp (get_stat_mtime (&s1), get_stat_mtime (&s2)) < 0)
{
/* Make the progress messages mention that source is newer. */
newer = 1;
Lisp_Object val;
if (fd >= 0)
- emacs_close (fd);
+ {
+ emacs_close (fd);
+ clear_unwind_protect (fd_index);
+ }
val = call4 (Vload_source_file_function, found, hist_file_name,
NILP (noerror) ? Qnil : Qt,
(NILP (nomessage) || force_load_messages) ? Qnil : Qt);
GCPRO3 (file, found, hist_file_name);
-#ifdef WINDOWSNT
- efound = ENCODE_FILE (found);
- /* If we somehow got here with fd == -2, meaning the file is deemed
- to be remote, don't even try to reopen the file locally; just
- force a failure instead. */
- if (fd >= 0)
+ if (fd < 0)
{
- emacs_close (fd);
- stream = fopen (SSDATA (efound), fmode);
+ /* We somehow got here with fd == -2, meaning the file is deemed
+ to be remote. Don't even try to reopen the file locally;
+ just force a failure. */
+ stream = NULL;
+ errno = EINVAL;
}
else
- stream = NULL;
-#else /* not WINDOWSNT */
- stream = fdopen (fd, fmode);
-#endif /* not WINDOWSNT */
- if (stream == 0)
{
+#ifdef WINDOWSNT
emacs_close (fd);
- error ("Failure to create stdio stream for %s", SDATA (file));
+ clear_unwind_protect (fd_index);
+ efound = ENCODE_FILE (found);
+ stream = emacs_fopen (SSDATA (efound), fmode);
+#else
+ stream = fdopen (fd, fmode);
+#endif
}
+ if (! stream)
+ report_file_error ("Opening stdio stream", file);
+ set_unwind_protect_ptr (fd_index, fclose_unwind, stream);
if (! NILP (Vpurify_flag))
Vpreloaded_file_list = Fcons (Fpurecopy (file), Vpreloaded_file_list);
message_with_string ("Loading %s...", file, 1);
}
- record_unwind_protect (load_unwind, make_save_pointer (stream));
- record_unwind_protect (load_descriptor_unwind, load_descriptor_list);
specbind (Qload_file_name, found);
specbind (Qinhibit_file_name_operation, Qnil);
- load_descriptor_list
- = Fcons (make_number (fileno (stream)), load_descriptor_list);
specbind (Qload_in_progress, Qt);
instream = stream;
return Qt;
}
-
-static Lisp_Object
-load_unwind (Lisp_Object arg) /* Used as unwind-protect function in load. */
-{
- FILE *stream = XSAVE_POINTER (arg, 0);
- if (stream != NULL)
- {
- block_input ();
- fclose (stream);
- unblock_input ();
- }
- return Qnil;
-}
-
-static Lisp_Object
-load_descriptor_unwind (Lisp_Object oldlist)
-{
- load_descriptor_list = oldlist;
- return Qnil;
-}
-
-/* Close all descriptors in use for Floads.
- This is used when starting a subprocess. */
-
-void
-close_load_descs (void)
-{
-#ifndef WINDOWSNT
- Lisp_Object tail;
- for (tail = load_descriptor_list; CONSP (tail); tail = XCDR (tail))
- emacs_close (XFASTINT (XCAR (tail)));
-#endif
-}
\f
static bool
complete_filename_p (Lisp_Object pathname)
{
Lisp_Object file;
int fd = openp (path, filename, suffixes, &file, predicate);
- if (NILP (predicate) && fd > 0)
- close (fd);
+ if (NILP (predicate) && fd >= 0)
+ emacs_close (fd);
return file;
}
/* Search for a file whose name is STR, looking in directories
in the Lisp list PATH, and trying suffixes from SUFFIX.
- On success, returns a file descriptor. On failure, returns -1.
+ On success, return a file descriptor (or 1 or -2 as described below).
+ On failure, return -1 and set errno.
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,
just look for one that satisfies the predicate. In this case,
- returns 1 on success. The predicate can be a lisp function or
+ return 1 on success. The predicate can be a lisp function or
an integer to pass to `access' (in which case file-name-handlers
are ignored).
but store the found remote file name in *STOREPTR. */
int
-openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes, Lisp_Object *storeptr, Lisp_Object predicate)
+openp (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
+ Lisp_Object *storeptr, Lisp_Object predicate)
{
ptrdiff_t fn_size = 100;
char buf[100];
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5, gcpro6;
Lisp_Object string, tail, encoded_fn;
ptrdiff_t max_suffix_len = 0;
+ int last_errno = ENOENT;
CHECK_STRING (str);
fn = alloca (fn_size = 100 + want_length);
/* Loop over suffixes. */
- for (tail = NILP (suffixes) ? Fcons (empty_unibyte_string, Qnil) : suffixes;
+ for (tail = NILP (suffixes) ? list1 (empty_unibyte_string) : suffixes;
CONSP (tail); tail = XCDR (tail))
{
- ptrdiff_t fnlen, lsuffix = SBYTES (XCAR (tail));
+ Lisp_Object suffix = XCAR (tail);
+ ptrdiff_t fnlen, lsuffix = SBYTES (suffix);
Lisp_Object handler;
/* Concatenate path element/specified name with the suffix.
? 2 : 0);
fnlen = SBYTES (filename) - prefixlen;
memcpy (fn, SDATA (filename) + prefixlen, fnlen);
- memcpy (fn + fnlen, SDATA (XCAR (tail)), lsuffix + 1);
+ memcpy (fn + fnlen, SDATA (suffix), lsuffix + 1);
fnlen += lsuffix;
/* Check that the file exists and is not a directory. */
/* We used to only check for handlers on non-absolute file names:
handler = Ffind_file_name_handler (filename, Qfile_exists_p);
It's not clear why that was the case and it breaks things like
(load "/bar.el") where the file is actually "/bar.el.gz". */
- string = make_string (fn, fnlen);
+ /* make_string has its own ideas on when to return a unibyte
+ string and when a multibyte string, but we know better.
+ We must have a unibyte string when dumping, since
+ file-name encoding is shaky at best at that time, and in
+ particular default-file-name-coding-system is reset
+ several times during loadup. We therefore don't want to
+ encode the file before passing it to file I/O library
+ functions. */
+ if (!STRING_MULTIBYTE (filename) && !STRING_MULTIBYTE (suffix))
+ string = make_unibyte_string (fn, fnlen);
+ else
+ string = make_string (fn, fnlen);
handler = Ffind_file_name_handler (string, Qfile_exists_p);
if ((!NILP (handler) || !NILP (predicate)) && !NATNUMP (predicate))
{
else
{
Lisp_Object tmp = call1 (predicate, string);
- exists = !NILP (tmp)
- && (EQ (tmp, Qdir_ok)
- || NILP (Ffile_directory_p (string)));
+ if (NILP (tmp))
+ exists = 0;
+ else if (EQ (tmp, Qdir_ok)
+ || NILP (Ffile_directory_p (string)))
+ exists = 1;
+ else
+ {
+ exists = 0;
+ last_errno = EISDIR;
+ }
}
if (exists)
/* Check that we can access or open it. */
if (NATNUMP (predicate))
- fd = (((XFASTINT (predicate) & ~INT_MAX) == 0
- && (faccessat (AT_FDCWD, pfn, XFASTINT (predicate),
+ {
+ fd = -1;
+ if (INT_MAX < XFASTINT (predicate))
+ last_errno = EINVAL;
+ else if (faccessat (AT_FDCWD, pfn, XFASTINT (predicate),
AT_EACCESS)
== 0)
- && ! file_directory_p (pfn))
- ? 1 : -1);
+ {
+ if (file_directory_p (pfn))
+ last_errno = EISDIR;
+ else
+ fd = 1;
+ }
+ }
else
{
- struct stat st;
fd = emacs_open (pfn, O_RDONLY, 0);
- if (fd >= 0
- && (fstat (fd, &st) != 0 || S_ISDIR (st.st_mode)))
+ if (fd < 0)
+ {
+ if (errno != ENOENT)
+ last_errno = errno;
+ }
+ else
{
- emacs_close (fd);
- fd = -1;
+ struct stat st;
+ int err = (fstat (fd, &st) != 0 ? errno
+ : S_ISDIR (st.st_mode) ? EISDIR : 0);
+ if (err)
+ {
+ last_errno = err;
+ emacs_close (fd);
+ fd = -1;
+ }
}
}
}
UNGCPRO;
+ errno = last_errno;
return -1;
}
Vload_history);
}
-static Lisp_Object
-readevalloop_1 (Lisp_Object old)
+static void
+readevalloop_1 (int old)
{
- load_convert_to_unibyte = ! NILP (old);
- return Qnil;
+ load_convert_to_unibyte = old;
}
/* Signal an `end-of-file' error, if possible with file name
specbind (Qstandard_input, readcharfun); /* GCPROs readcharfun. */
specbind (Qcurrent_load_list, Qnil);
- record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
+ record_unwind_protect_int (readevalloop_1, load_convert_to_unibyte);
load_convert_to_unibyte = !NILP (unibyte);
/* If lexical binding is active (either because it was specified in
lexical environment, otherwise, turn off lexical binding. */
lex_bound = find_symbol_value (Qlexical_binding);
specbind (Qinternal_interpreter_environment,
- NILP (lex_bound) || EQ (lex_bound, Qunbound)
- ? Qnil : Fcons (Qt, Qnil));
+ (NILP (lex_bound) || EQ (lex_bound, Qunbound)
+ ? Qnil : list1 (Qt)));
GCPRO4 (sourcename, readfun, start, end);
if (c == '"')
{
Lisp_Object tmp, val;
- EMACS_INT size_in_chars
- = ((XFASTINT (length) + BOOL_VECTOR_BITS_PER_CHAR - 1)
- / BOOL_VECTOR_BITS_PER_CHAR);
+ EMACS_INT size_in_chars = bool_vector_bytes (XFASTINT (length));
+ unsigned char *data;
UNREAD (c);
tmp = read1 (readcharfun, pch, first_in_list);
== (SCHARS (tmp) - 1) * BOOL_VECTOR_BITS_PER_CHAR)))
invalid_syntax ("#&...");
- val = Fmake_bool_vector (length, Qnil);
- memcpy (XBOOL_VECTOR (val)->data, SDATA (tmp), size_in_chars);
+ val = make_uninit_bool_vector (XFASTINT (length));
+ data = bool_vector_uchar_data (val);
+ memcpy (data, SDATA (tmp), size_in_chars);
/* Clear the extraneous bits in the last byte. */
if (XINT (length) != size_in_chars * BOOL_VECTOR_BITS_PER_CHAR)
- XBOOL_VECTOR (val)->data[size_in_chars - 1]
+ data[size_in_chars - 1]
&= (1 << (XINT (length) % BOOL_VECTOR_BITS_PER_CHAR)) - 1;
return val;
}
build them using function calls. */
Lisp_Object tmp;
tmp = read_vector (readcharfun, 1);
- make_byte_code (XVECTOR (tmp));
+ struct Lisp_Vector* vec = XVECTOR (tmp);
+ if (vec->header.size==0)
+ invalid_syntax ("Empty byte-code object");
+ make_byte_code (vec);
return tmp;
}
if (c == '(')
if (c == '$')
return Vload_file_name;
if (c == '\'')
- return Fcons (Qfunction, Fcons (read0 (readcharfun), Qnil));
+ return list2 (Qfunction, read0 (readcharfun));
/* #:foo is the uninterned symbol named foo. */
if (c == ':')
{
goto retry;
case '\'':
- {
- return Fcons (Qquote, Fcons (read0 (readcharfun), Qnil));
- }
+ return list2 (Qquote, read0 (readcharfun));
case '`':
{
value = read0 (readcharfun);
new_backquote_flag = saved_new_backquote_flag;
- return Fcons (Qbackquote, Fcons (value, Qnil));
+ return list2 (Qbackquote, value);
}
}
case ',':
}
value = read0 (readcharfun);
- return Fcons (comma_type, Fcons (value, Qnil));
+ return list2 (comma_type, value);
}
else
{
if (BOOL_VECTOR_P (subtree))
return subtree; /* No sub-objects anyway. */
else if (CHAR_TABLE_P (subtree) || SUB_CHAR_TABLE_P (subtree)
- || COMPILEDP (subtree))
+ || COMPILEDP (subtree) || HASH_TABLE_P (subtree))
length = ASIZE (subtree) & PSEUDOVECTOR_SIZE_MASK;
else if (VECTORP (subtree))
length = ASIZE (subtree);
}
invalid_syntax ("] in a list");
}
- tem = Fcons (elt, Qnil);
+ tem = list1 (elt);
if (!NILP (tail))
XSETCDR (tail, tem);
else
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);
+ Vload_path = list1 (tem);
}
}
else
load_in_progress = 0;
Vload_file_name = Qnil;
-
- load_descriptor_list = Qnil;
-
Vstandard_input = Qt;
Vloads_in_progress = Qnil;
}
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 (build_pure_c_string (".elc"),
- Fcons (build_pure_c_string (".el"), Qnil));
+ Vload_suffixes = list2 (build_pure_c_string (".elc"),
+ build_pure_c_string (".el"));
DEFVAR_LISP ("load-file-rep-suffixes", Vload_file_rep_suffixes,
doc: /* List of suffixes that indicate representations of \
the same file.
in order to do so. However, if you want to customize which suffixes
the loading functions recognize as compression suffixes, you should
customize `jka-compr-load-suffixes' rather than the present variable. */);
- Vload_file_rep_suffixes = Fcons (empty_unibyte_string, Qnil);
+ Vload_file_rep_suffixes = list1 (empty_unibyte_string);
DEFVAR_BOOL ("load-in-progress", load_in_progress,
doc: /* Non-nil if inside of `load'. */);
/* Vsource_directory was initialized in init_lread. */
- load_descriptor_list = Qnil;
- staticpro (&load_descriptor_list);
-
DEFSYM (Qcurrent_load_list, "current-load-list");
DEFSYM (Qstandard_input, "standard-input");
DEFSYM (Qread_char, "read-char");