#include "buffer.h"
#include "bytecode.h"
-#include "elhash.h"
+#include "commands.h"
+#include "insdel.h"
#include "lstream.h"
#include "opaque.h"
+#include <paths.h>
#ifdef FILE_CODING
#include "file-coding.h"
#endif
Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
Lisp_Object Qcurrent_load_list;
Lisp_Object Qload, Qload_file_name;
+Lisp_Object Qlocate_file_hash_table;
Lisp_Object Qfset;
-/* Hash-table that maps directory names to hashes of their contents. */
-static Lisp_Object Vlocate_file_hash_table;
-
-Lisp_Object Qexists, Qreadable, Qwritable, Qexecutable;
-
/* See read_escape() for an explanation of this. */
#if 0
int fail_on_bucky_bit_character_escapes;
/* Whether Fload_internal() should ignore .elc files when no suffix is given */
int load_ignore_elc_files;
+/* Directory in which the sources were found. */
+Lisp_Object Vsource_directory;
+
/* Search path for files to be loaded. */
Lisp_Object Vload_path;
Each member of the list has the form (n . object), and is used to
look up the object for the corresponding #n# construct.
It must be set to nil before all top-level calls to read0. */
-Lisp_Object Vread_objects;
+Lisp_Object read_objects;
/* Nonzero means load should forcibly load all dynamic doc strings. */
/* Note that this always happens (with some special behavior) when
\f
static DOESNT_RETURN
-read_syntax_error (const char *string)
+syntax_error (CONST char *string)
{
signal_error (Qinvalid_read_syntax,
list1 (build_translated_string (string)));
}
static Lisp_Object
-continuable_read_syntax_error (const char *string)
+continuable_syntax_error (CONST char *string)
{
return Fsignal (Qinvalid_read_syntax,
list1 (build_translated_string (string)));
#ifdef DEBUG_XEMACS /* testing Mule */
static int testing_mule = 0; /* Change via debugger */
if (testing_mule) {
- if (c >= 0x20 && c <= 0x7E) stderr_out ("%c", c);
- else if (c == '\n') stderr_out ("\\n\n");
- else stderr_out ("\\%o ", c);
+ if (c >= 0x20 && c <= 0x7E) fprintf (stderr, "%c", c);
+ else if (c == '\n') fprintf (stderr, "\\n\n");
+ else fprintf (stderr, "\\%o ", c);
}
#endif
return c;
something to `funcall', but who would really do that? As
they say in law, we've made a "good-faith effort" to
unfuckify ourselves. And doing it this way avoids screwing
- up args to `make-hash-table' and such. As it is, we have to
+ up args to `make-hashtable' and such. As it is, we have to
add an extra Ebola check in decode_weak_list_type(). --ben */
- if (EQ (el, Qassoc)) el = Qold_assoc;
- else if (EQ (el, Qdelq)) el = Qold_delq;
+ if (EQ (el, Qassoc))
+ el = Qold_assoc;
+ if (EQ (el, Qdelq))
+ el = Qold_delq;
#if 0
/* I think this is a bad idea because it will probably mess
with keymap code. */
- else if (EQ (el, Qdelete)) el = Qold_delete;
+ if (EQ (el, Qdelete))
+ el = Qold_delete;
#endif
- else if (EQ (el, Qrassq)) el = Qold_rassq;
- else if (EQ (el, Qrassoc)) el = Qold_rassoc;
-
+ if (EQ (el, Qrassq))
+ el = Qold_rassq;
+ if (EQ (el, Qrassoc))
+ el = Qold_rassoc;
XVECTOR_DATA (vector)[i] = el;
}
}
Lisp_Object list = Vload_force_doc_string_list;
Lisp_Object tail;
int fd = XINT (XCAR (Vload_descriptor_list));
+ /* NOTE: If purify_flag is true, we're in-place modifying objects that
+ may be in purespace (and if not, they will be). Therefore, we have
+ to be VERY careful to make sure that all objects that we create
+ are purecopied -- objects in purespace are not marked for GC, and
+ if we leave any impure objects inside of pure ones, we're really
+ screwed. */
GCPRO1 (list);
/* restore the old value first just in case an error occurs. */
Lisp_Object doc;
assert (COMPILED_FUNCTIONP (john));
- if (CONSP (XCOMPILED_FUNCTION (john)->instructions))
+ if (CONSP (XCOMPILED_FUNCTION (john)->bytecodes))
{
struct gcpro ngcpro1;
Lisp_Object juan = (pas_de_lache_ici
- (fd, XCOMPILED_FUNCTION (john)->instructions));
+ (fd, XCOMPILED_FUNCTION (john)->bytecodes));
Lisp_Object ivan;
NGCPRO1 (juan);
ivan = Fread (juan);
if (!CONSP (ivan))
signal_simple_error ("invalid lazy-loaded byte code", ivan);
- XCOMPILED_FUNCTION (john)->instructions = XCAR (ivan);
+ /* Remember to purecopy; see above. */
+ XCOMPILED_FUNCTION (john)->bytecodes = Fpurecopy (XCAR (ivan));
/* v18 or v19 bytecode file. Need to Ebolify. */
if (XCOMPILED_FUNCTION (john)->flags.ebolified
&& VECTORP (XCDR (ivan)))
ebolify_bytecode_constants (XCDR (ivan));
- XCOMPILED_FUNCTION (john)->constants = XCDR (ivan);
+ XCOMPILED_FUNCTION (john)->constants = Fpurecopy (XCDR (ivan));
NUNGCPRO;
}
doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
int message_p = NILP (nomessage);
/*#ifdef DEBUG_XEMACS*/
static Lisp_Object last_file_loaded;
+ size_t pure_usage = 0;
/*#endif*/
struct stat s1, s2;
GCPRO3 (file, newer, found);
{
message_p = 1;
last_file_loaded = file;
+ pure_usage = purespace_usage ();
}
/*#endif / * DEBUG_XEMACS */
int foundlen;
fd = locate_file (Vload_path, file,
- ((!NILP (nosuffix)) ? Qnil :
- build_string (load_ignore_elc_files ? ".el:" :
- ".elc:.el:")),
+ ((!NILP (nosuffix)) ? "" :
+ load_ignore_elc_files ? ".el:" :
+ ".elc:.el:"),
&found,
-1);
int result;
/* temporarily hack the 'c' off the end of the filename */
foundstr[foundlen - 1] = '\0';
- result = xemacs_stat (foundstr, &s2);
+ result = stat (foundstr, &s2);
if (result >= 0 &&
(unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
{
{
/* Lisp_Object's must be malloc'ed, not stack-allocated */
Lisp_Object lispstream = Qnil;
- const int block_size = 8192;
+ CONST int block_size = 8192;
struct gcpro ngcpro1;
NGCPRO1 (lispstream);
/*#ifdef DEBUG_XEMACS*/
if (purify_flag && noninteractive)
{
- if (!EQ (last_file_loaded, file))
- message ("Loading %s ...done", XSTRING_DATA (file));
+ if (EQ (last_file_loaded, file))
+ message_append (" (%d)", purespace_usage() - pure_usage);
+ else
+ message ("Loading %s ...done (%d)", XSTRING_DATA (file),
+ purespace_usage() - pure_usage);
}
/*#endif / * DEBUG_XEMACS */
}
\f
-/* ------------------------------- */
-/* locate_file */
-/* ------------------------------- */
-
-static int
-decode_mode_1 (Lisp_Object mode)
-{
- if (EQ (mode, Qexists))
- return F_OK;
- else if (EQ (mode, Qexecutable))
- return X_OK;
- else if (EQ (mode, Qwritable))
- return W_OK;
- else if (EQ (mode, Qreadable))
- return R_OK;
- else if (INTP (mode))
- {
- check_int_range (XINT (mode), 0, 7);
- return XINT (mode);
- }
- else
- signal_simple_error ("Invalid value", mode);
- return 0; /* unreached */
-}
-
+#if 0 /* FSFmacs */
+/* not used */
static int
-decode_mode (Lisp_Object mode)
+complete_filename_p (Lisp_Object pathname)
{
- if (NILP (mode))
- return R_OK;
- else if (CONSP (mode))
- {
- Lisp_Object tail;
- int mask = 0;
- EXTERNAL_LIST_LOOP (tail, mode)
- mask |= decode_mode_1 (XCAR (tail));
- return mask;
- }
- else
- return decode_mode_1 (mode);
+ REGISTER unsigned char *s = XSTRING_DATA (pathname);
+ return (IS_DIRECTORY_SEP (s[0])
+ || (XSTRING_LENGTH (pathname) > 2
+ && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))
+#ifdef ALTOS
+ || *s == '@'
+#endif
+ );
}
+#endif /* 0 */
DEFUN ("locate-file", Flocate_file, 2, 4, 0, /*
-Search for FILENAME through PATH-LIST.
-
-If SUFFIXES is non-nil, it should be a list of suffixes to append to
-file name when searching.
-
-If MODE is non-nil, it should be a symbol or a list of symbol representing
-requirements. Allowed symbols are `exists', `executable', `writable', and
-`readable'. If MODE is nil, it defaults to `readable'.
+Search for FILENAME through PATH-LIST, expanded by one of the optional
+SUFFIXES (string of suffixes separated by ":"s), checking for access
+MODE (0|1|2|4 = exists|executable|writeable|readable), default readable.
`locate-file' keeps hash tables of the directories it searches through,
in order to speed things up. It tries valiantly to not get confused in
Lisp_Object tp;
CHECK_STRING (filename);
-
- if (LISTP (suffixes))
- {
- Lisp_Object tail;
- EXTERNAL_LIST_LOOP (tail, suffixes)
- CHECK_STRING (XCAR (tail));
- }
- else
+ if (!NILP (suffixes))
CHECK_STRING (suffixes);
+ if (!NILP (mode))
+ CHECK_NATNUM (mode);
- locate_file (path_list, filename, suffixes, &tp, decode_mode (mode));
+ locate_file (path_list, filename,
+ ((NILP (suffixes)) ? "" :
+ (char *) (XSTRING_DATA (suffixes))),
+ &tp, (NILP (mode) ? R_OK : XINT (mode)));
return tp;
}
-/* Recalculate the hash table for the given string. DIRECTORY should
- better have been through Fexpand_file_name() by now. */
+/* recalculate the hash table for the given string */
static Lisp_Object
-locate_file_refresh_hashing (Lisp_Object directory)
+locate_file_refresh_hashing (Lisp_Object str)
{
Lisp_Object hash =
- make_directory_hash_table ((char *) XSTRING_DATA (directory));
-
- if (!NILP (hash))
- Fputhash (directory, hash, Vlocate_file_hash_table);
+ make_directory_hash_table ((char *) XSTRING_DATA (str));
+ Fput (str, Qlocate_file_hash_table, hash);
return hash;
}
-/* find the hash table for the given directory, recalculating if necessary */
+/* find the hash table for the given string, recalculating if necessary */
static Lisp_Object
-locate_file_find_directory_hash_table (Lisp_Object directory)
-{
- Lisp_Object hash = Fgethash (directory, Vlocate_file_hash_table, Qnil);
- if (NILP (hash))
- return locate_file_refresh_hashing (directory);
- else
- return hash;
-}
-
-/* The SUFFIXES argument in any of the locate_file* functions can be
- nil, a list, or a string (for backward compatibility), with the
- following semantics:
-
- a) nil - no suffix, just search for file name intact
- (semantically different from "empty suffix list", which
- would be meaningless.)
- b) list - list of suffixes to append to file name. Each of these
- must be a string.
- c) string - colon-separated suffixes to append to file name (backward
- compatibility).
-
- All of this got hairy, so I decided to use a mapper. Calling a
- function for each suffix shouldn't slow things down, since
- locate_file is rarely called with enough suffixes for funcalls to
- make any difference. */
-
-/* Map FUN over SUFFIXES, as described above. FUN will be called with a
- char * containing the current file name, and ARG. Mapping stops when
- FUN returns non-zero. */
-static void
-locate_file_map_suffixes (Lisp_Object filename, Lisp_Object suffixes,
- int (*fun) (char *, void *),
- void *arg)
-{
- /* This function can GC */
- char *fn;
- int fn_len, max;
-
- /* Calculate maximum size of any filename made from
- this path element/specified file name and any possible suffix. */
- if (CONSP (suffixes))
- {
- /* We must traverse the list, so why not do it right. */
- Lisp_Object tail;
- max = 0;
- LIST_LOOP (tail, suffixes)
- {
- if (XSTRING_LENGTH (XCAR (tail)) > max)
- max = XSTRING_LENGTH (XCAR (tail));
- }
- }
- else if (NILP (suffixes))
- max = 0;
- else
- /* Just take the easy way out */
- max = XSTRING_LENGTH (suffixes);
-
- fn_len = XSTRING_LENGTH (filename);
- fn = (char *) alloca (max + fn_len + 1);
- memcpy (fn, (char *) XSTRING_DATA (filename), fn_len);
-
- /* Loop over suffixes. */
- if (!STRINGP (suffixes))
- {
- if (NILP (suffixes))
- {
- /* Case a) discussed in the comment above. */
- fn[fn_len] = 0;
- if ((*fun) (fn, arg))
- return;
- }
- else
- {
- /* Case b) */
- Lisp_Object tail;
- LIST_LOOP (tail, suffixes)
- {
- memcpy (fn + fn_len, XSTRING_DATA (XCAR (tail)),
- XSTRING_LENGTH (XCAR (tail)));
- fn[fn_len + XSTRING_LENGTH (XCAR (tail))] = 0;
- if ((*fun) (fn, arg))
- return;
- }
- }
- }
- else
- {
- /* Case c) */
- const char *nsuffix = (const char *) XSTRING_DATA (suffixes);
-
- while (1)
- {
- char *esuffix = (char *) strchr (nsuffix, ':');
- int lsuffix = esuffix ? esuffix - nsuffix : strlen (nsuffix);
-
- /* Concatenate path element/specified name with the suffix. */
- strncpy (fn + fn_len, nsuffix, lsuffix);
- fn[fn_len + lsuffix] = 0;
-
- if ((*fun) (fn, arg))
- return;
-
- /* Advance to next suffix. */
- if (esuffix == 0)
- break;
- nsuffix += lsuffix + 1;
- }
- }
-}
-
-struct locate_file_in_directory_mapper_closure {
- int fd;
- Lisp_Object *storeptr;
- int mode;
-};
-
-static int
-locate_file_in_directory_mapper (char *fn, void *arg)
+locate_file_find_directory_hash_table (Lisp_Object str)
{
- struct locate_file_in_directory_mapper_closure *closure =
- (struct locate_file_in_directory_mapper_closure *)arg;
- struct stat st;
-
- /* Ignore file if it's a directory. */
- if (xemacs_stat (fn, &st) >= 0
- && (st.st_mode & S_IFMT) != S_IFDIR)
- {
- /* Check that we can access or open it. */
- if (closure->mode >= 0)
- closure->fd = access (fn, closure->mode);
- else
- closure->fd = open (fn, O_RDONLY | OPEN_BINARY, 0);
-
- if (closure->fd >= 0)
- {
- /* We succeeded; return this descriptor and filename. */
- if (closure->storeptr)
- *closure->storeptr = build_string (fn);
-
-#ifndef WIN32_NATIVE
- /* If we actually opened the file, set close-on-exec flag
- on the new descriptor so that subprocesses can't whack
- at it. */
- if (closure->mode < 0)
- (void) fcntl (closure->fd, F_SETFD, FD_CLOEXEC);
-#endif
-
- return 1;
- }
- }
- /* Keep mapping. */
- return 0;
+ Lisp_Object hash = Fget (str, Qlocate_file_hash_table, Qnil);
+ if (NILP (Fhashtablep (hash)))
+ return locate_file_refresh_hashing (str);
+ return hash;
}
-
-/* look for STR in PATH, optionally adding SUFFIXES. DIRECTORY need
- not have been expanded. */
+/* look for STR in PATH, optionally adding suffixes in SUFFIX */
static int
-locate_file_in_directory (Lisp_Object directory, Lisp_Object str,
- Lisp_Object suffixes, Lisp_Object *storeptr,
+locate_file_in_directory (Lisp_Object path, Lisp_Object str,
+ CONST char *suffix, Lisp_Object *storeptr,
int mode)
{
/* This function can GC */
- struct locate_file_in_directory_mapper_closure closure;
+ int fd;
+ int fn_size = 100;
+ char buf[100];
+ char *fn = buf;
+ int want_size;
+ struct stat st;
Lisp_Object filename = Qnil;
struct gcpro gcpro1, gcpro2, gcpro3;
+ CONST char *nsuffix;
- GCPRO3 (directory, str, filename);
+ GCPRO3 (path, str, filename);
- filename = Fexpand_file_name (str, directory);
+ filename = Fexpand_file_name (str, path);
if (NILP (filename) || NILP (Ffile_name_absolute_p (filename)))
/* 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 ... */
{
if (NILP (filename))
- /* NIL means current directory */
+ /* NIL means current dirctory */
filename = current_buffer->directory;
else
filename = Fexpand_file_name (filename,
current_buffer->directory);
if (NILP (Ffile_name_absolute_p (filename)))
{
- /* Give up on this directory! */
+ /* Give up on this path element! */
UNGCPRO;
return -1;
}
}
+ /* Calculate maximum size of any filename made from
+ this path element/specified file name and any possible suffix. */
+ want_size = strlen (suffix) + XSTRING_LENGTH (filename) + 1;
+ if (fn_size < want_size)
+ fn = (char *) alloca (fn_size = 100 + want_size);
- closure.fd = -1;
- closure.storeptr = storeptr;
- closure.mode = mode;
+ nsuffix = suffix;
- locate_file_map_suffixes (filename, suffixes, locate_file_in_directory_mapper,
- &closure);
+ /* Loop over suffixes. */
+ while (1)
+ {
+ char *esuffix = (char *) strchr (nsuffix, ':');
+ int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
+
+ /* Concatenate path element/specified name with the suffix. */
+ strncpy (fn, (char *) XSTRING_DATA (filename),
+ XSTRING_LENGTH (filename));
+ fn[XSTRING_LENGTH (filename)] = 0;
+ if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
+ strncat (fn, nsuffix, lsuffix);
+
+ /* Ignore file if it's a directory. */
+ if (stat (fn, &st) >= 0
+ && (st.st_mode & S_IFMT) != S_IFDIR)
+ {
+ /* Check that we can access or open it. */
+ if (mode >= 0)
+ fd = access (fn, mode);
+ else
+ fd = open (fn, O_RDONLY | OPEN_BINARY, 0);
+
+ if (fd >= 0)
+ {
+ /* We succeeded; return this descriptor and filename. */
+ if (storeptr)
+ *storeptr = build_string (fn);
+ UNGCPRO;
+
+#ifndef WINDOWSNT
+ /* If we actually opened the file, set close-on-exec flag
+ on the new descriptor so that subprocesses can't whack
+ at it. */
+ if (mode < 0)
+ (void) fcntl (fd, F_SETFD, FD_CLOEXEC);
+#endif
+
+ return fd;
+ }
+ }
+
+ /* Advance to next suffix. */
+ if (esuffix == 0)
+ break;
+ nsuffix += lsuffix + 1;
+ }
UNGCPRO;
- return closure.fd;
+ return -1;
}
/* do the same as locate_file() but don't use any hash tables. */
static int
locate_file_without_hash (Lisp_Object path, Lisp_Object str,
- Lisp_Object suffixes, Lisp_Object *storeptr,
+ CONST char *suffix, Lisp_Object *storeptr,
int mode)
{
/* This function can GC */
- int absolute = !NILP (Ffile_name_absolute_p (str));
+ int absolute;
+ struct gcpro gcpro1;
+
+ /* is this necessary? */
+ GCPRO1 (path);
+
+ absolute = !NILP (Ffile_name_absolute_p (str));
- EXTERNAL_LIST_LOOP (path, path)
+ for (; !NILP (path); path = Fcdr (path))
{
- int val = locate_file_in_directory (XCAR (path), str, suffixes, storeptr,
- mode);
+ int val = locate_file_in_directory (Fcar (path), str, suffix,
+ storeptr, mode);
if (val >= 0)
- return val;
+ {
+ UNGCPRO;
+ return val;
+ }
if (absolute)
break;
}
- return -1;
-}
-static int
-locate_file_construct_suffixed_files_mapper (char *fn, void *arg)
-{
- Lisp_Object *tail = (Lisp_Object *)arg;
- *tail = Fcons (build_string (fn), *tail);
- return 0;
+ UNGCPRO;
+ return -1;
}
-/* Construct a list of all files to search for.
- It makes sense to have this despite locate_file_map_suffixes()
- because we need Lisp strings to access the hash-table, and it would
- be inefficient to create them on the fly, again and again for each
- path component. See locate_file(). */
+/* Construct a list of all files to search for. */
static Lisp_Object
-locate_file_construct_suffixed_files (Lisp_Object filename,
- Lisp_Object suffixes)
+locate_file_construct_suffixed_files (Lisp_Object str, CONST char *suffix)
{
- Lisp_Object tail = Qnil;
- struct gcpro gcpro1;
- GCPRO1 (tail);
+ int want_size;
+ int fn_size = 100;
+ char buf[100];
+ char *fn = buf;
+ CONST char *nsuffix;
+ Lisp_Object suffixtab = Qnil;
- locate_file_map_suffixes (filename, suffixes,
- locate_file_construct_suffixed_files_mapper,
- &tail);
+ /* Calculate maximum size of any filename made from
+ this path element/specified file name and any possible suffix. */
+ want_size = strlen (suffix) + XSTRING_LENGTH (str) + 1;
+ if (fn_size < want_size)
+ fn = (char *) alloca (fn_size = 100 + want_size);
- UNGCPRO;
- return Fnreverse (tail);
+ nsuffix = suffix;
+
+ while (1)
+ {
+ char *esuffix = (char *) strchr (nsuffix, ':');
+ int lsuffix = ((esuffix) ? (esuffix - nsuffix) : strlen (nsuffix));
+
+ /* Concatenate path element/specified name with the suffix. */
+ strncpy (fn, (char *) XSTRING_DATA (str), XSTRING_LENGTH (str));
+ fn[XSTRING_LENGTH (str)] = 0;
+ if (lsuffix != 0) /* Bug happens on CCI if lsuffix is 0. */
+ strncat (fn, nsuffix, lsuffix);
+
+ suffixtab = Fcons (build_string (fn), suffixtab);
+ /* Advance to next suffix. */
+ if (esuffix == 0)
+ break;
+ nsuffix += lsuffix + 1;
+ }
+ return Fnreverse (suffixtab);
}
DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
`locate-file' will primarily get confused if you add a file that shadows
\(i.e. has the same name as) another file further down in the directory list.
In this case, you must call `locate-file-clear-hashing'.
-
-If PATH is t, it means to fully clear all the accumulated hashes. This
-can be used if the internal tables grow too large, or when dumping.
*/
(path))
{
- if (EQ (path, Qt))
- Fclrhash (Vlocate_file_hash_table);
- else
+ Lisp_Object pathtail;
+
+ for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
{
- Lisp_Object pathtail;
- EXTERNAL_LIST_LOOP (pathtail, path)
- {
- Lisp_Object pathel = Fexpand_file_name (XCAR (pathtail), Qnil);
- Fremhash (pathel, Vlocate_file_hash_table);
- }
+ Lisp_Object pathel = Fcar (pathtail);
+ if (!purified (pathel))
+ Fput (pathel, Qlocate_file_hash_table, Qnil);
}
return Qnil;
}
/* Search for a file whose name is STR, looking in directories
- in the Lisp list PATH, and trying suffixes from SUFFIXES.
- SUFFIXES is a list of possible suffixes, or (for backward
- compatibility) a string containing possible suffixes separated by
- colons.
+ in the Lisp list PATH, and trying suffixes from SUFFIX.
+ SUFFIX is a string containing possible suffixes separated by colons.
On success, returns a file descriptor. On failure, returns -1.
MODE nonnegative means don't open the files,
Called openp() in FSFmacs. */
int
-locate_file (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
+locate_file (Lisp_Object path, Lisp_Object str, CONST char *suffix,
Lisp_Object *storeptr, int mode)
{
/* This function can GC */
Lisp_Object suffixtab = Qnil;
- Lisp_Object pathtail, pathel_expanded;
+ Lisp_Object pathtail;
int val;
- struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+ struct gcpro gcpro1, gcpro2, gcpro3;
if (storeptr)
*storeptr = Qnil;
- /* Is it really necessary to gcpro path and str? It shouldn't be
- unless some caller has fucked up. There are known instances that
- call us with build_string("foo:bar") as SUFFIXES, though. */
- GCPRO4 (path, str, suffixes, suffixtab);
-
/* if this filename has directory components, it's too complicated
to try and use the hash tables. */
if (!NILP (Ffile_name_directory (str)))
- {
- val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
- UNGCPRO;
- return val;
- }
+ return locate_file_without_hash (path, str, suffix, storeptr,
+ mode);
+
+ /* Is it really necessary to gcpro path and str? It shouldn't be
+ unless some caller has fucked up. */
+ GCPRO3 (path, str, suffixtab);
- suffixtab = locate_file_construct_suffixed_files (str, suffixes);
+ suffixtab = locate_file_construct_suffixed_files (str, suffix);
- EXTERNAL_LIST_LOOP (pathtail, path)
+ for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
{
- Lisp_Object pathel = XCAR (pathtail);
- Lisp_Object hash_table;
+ Lisp_Object pathel = Fcar (pathtail);
+ Lisp_Object hashtab;
Lisp_Object tail;
- int found = 0;
+ int found;
- /* If this path element is relative, we have to look by hand. */
- if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)))
+ /* If this path element is relative, we have to look by hand.
+ Can't set string property in a pure string. */
+ if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)) ||
+ purified (pathel))
{
- val = locate_file_in_directory (pathel, str, suffixes, storeptr,
+ val = locate_file_in_directory (pathel, str, suffix, storeptr,
mode);
if (val >= 0)
{
continue;
}
- pathel_expanded = Fexpand_file_name (pathel, Qnil);
- hash_table = locate_file_find_directory_hash_table (pathel_expanded);
+ hashtab = locate_file_find_directory_hash_table (pathel);
- if (!NILP (hash_table))
+ /* Loop over suffixes. */
+ for (tail = suffixtab, found = 0; !found && CONSP (tail);
+ tail = XCDR (tail))
{
- /* Loop over suffixes. */
- LIST_LOOP (tail, suffixtab)
- if (!NILP (Fgethash (XCAR (tail), hash_table, Qnil)))
- {
- found = 1;
- break;
- }
+ if (!NILP (Fgethash (XCAR (tail), hashtab, Qnil)))
+ found = 1;
}
if (found)
{
/* This is a likely candidate. Look by hand in this directory
so we don't get thrown off if someone byte-compiles a file. */
- val = locate_file_in_directory (pathel, str, suffixes, storeptr,
+ val = locate_file_in_directory (pathel, str, suffix, storeptr,
mode);
if (val >= 0)
{
/* Hmm ... the file isn't actually there. (Or possibly it's
a directory ...) So refresh our hashing. */
- locate_file_refresh_hashing (pathel_expanded);
+ locate_file_refresh_hashing (pathel);
}
}
/* File is probably not there, but check the hard way just in case. */
- val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
+ val = locate_file_without_hash (path, str, suffix, storeptr,
+ mode);
if (val >= 0)
{
/* Sneaky user added a file without telling us. */
{
/* This function can GC */
REGISTER Emchar c;
- REGISTER Lisp_Object val = Qnil;
+ REGISTER Lisp_Object val;
int speccount = specpdl_depth ();
- struct gcpro gcpro1, gcpro2;
+ struct gcpro gcpro1;
struct buffer *b = 0;
if (BUFFERP (readcharfun))
#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
Vcurrent_compiled_function_annotation = Qnil;
#endif
- GCPRO2 (val, sourcename);
+ GCPRO1 (sourcename);
LOADHIST_ATTACH (sourcename);
#else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
{
unreadchar (readcharfun, c);
- Vread_objects = Qnil;
+ read_objects = Qnil;
if (NILP (Vload_read_function))
val = read0 (readcharfun);
else
if (EQ (stream, Qt))
stream = Qread_char;
- Vread_objects = Qnil;
+ read_objects = Qnil;
#ifdef COMPILED_FUNCTION_ANNOTATION_HACK
Vcurrent_compiled_function_annotation = Qnil;
lispstream = make_lisp_string_input_stream (string, startval,
endval - startval);
- Vread_objects = Qnil;
+ read_objects = Qnil;
tem = read0 (lispstream);
/* Yeah, it's ugly. Gonna make something of it?
static Lisp_Object
read0 (Lisp_Object readcharfun)
{
- Lisp_Object val = read1 (readcharfun);
+ Lisp_Object val;
+ val = read1 (readcharfun);
if (CONSP (val) && UNBOUNDP (XCAR (val)))
{
Emchar c = XCHAR (XCDR (val));
}
case 'x':
- /* A hex escape, as in ANSI C, except that we only allow latin-1
- characters to be read this way. What is "\x4e03" supposed to
- mean, anyways, if the internal representation is hidden?
- This is also consistent with the treatment of octal escapes. */
+ /* A hex escape, as in ANSI C. */
{
REGISTER Emchar i = 0;
- REGISTER int count = 0;
- while (++count <= 2)
+ while (1)
{
c = readchar (readcharfun);
/* Remember, can't use isdigit(), isalpha() etc. on Emchars */
return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
}
-static Lisp_Object parse_integer (const Bufbyte *buf, Bytecount len, int base);
+static Lisp_Object parse_integer (CONST Bufbyte *buf, Bytecount len, int base);
static Lisp_Object
read_atom (Lisp_Object readcharfun,
{
Lisp_Object sym;
if (uninterned_symbol)
- sym = Fmake_symbol ( make_string ((Bufbyte *) read_ptr, len));
+ sym = (Fmake_symbol ((purify_flag)
+ ? make_pure_pname ((Bufbyte *) read_ptr, len, 0)
+ : make_string ((Bufbyte *) read_ptr, len)));
else
{
+ /* intern will purecopy pname if necessary */
Lisp_Object name = make_string ((Bufbyte *) read_ptr, len);
sym = Fintern (name, Qnil);
+
+ if (SYMBOL_IS_KEYWORD (sym))
+ {
+ /* the LISP way is to put keywords in their own package,
+ but we don't have packages, so we do something simpler.
+ Someday, maybe we'll have packages and then this will
+ be reworked. --Stig. */
+ XSYMBOL (sym)->value = sym;
+ }
}
return sym;
}
static Lisp_Object
-parse_integer (const Bufbyte *buf, Bytecount len, int base)
+parse_integer (CONST Bufbyte *buf, Bytecount len, int base)
{
- const Bufbyte *lim = buf + len;
- const Bufbyte *p = buf;
+ CONST Bufbyte *lim = buf + len;
+ CONST Bufbyte *p = buf;
EMACS_UINT num = 0;
int negativland = 0;
{
unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
Emchar c;
- Lisp_Object val;
while (1)
{
if (c >= 0)
unreadchar (readcharfun, c);
- val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
- Dynarr_length (dyn));
-
- Dynarr_free (dyn);
-
- return val;
+ return make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
+ Dynarr_length (dyn));
}
\f
GCPRO2 (orig_list, already_seen);
if (c != '(')
- RETURN_UNGCPRO (continuable_read_syntax_error ("#s not followed by paren"));
+ RETURN_UNGCPRO (continuable_syntax_error ("#s not followed by paren"));
list = read_list (readcharfun, ')', 0, 0);
orig_list = list;
{
int len = XINT (Flength (list));
if (len == 0)
- RETURN_UNGCPRO (continuable_read_syntax_error
+ RETURN_UNGCPRO (continuable_syntax_error
("structure type not specified"));
if (!(len & 1))
RETURN_UNGCPRO
- (continuable_read_syntax_error
+ (continuable_syntax_error
("structures must have alternating keyword/value pairs"));
}
obj = read0(readcharfun);
/* the call to `featurep' may GC. */
- GCPRO2 (fexp, obj);
- tem = call1 (Qfeaturep, fexp);
+ GCPRO2(fexp, obj);
+ tem = call1(Qfeaturep, fexp);
UNGCPRO;
- if (c == '+' && NILP(tem)) goto retry;
+ if (c == '+' && NILP(tem)) goto retry;
if (c == '-' && !NILP(tem)) goto retry;
return obj;
}
n += c - '0';
c = readchar (readcharfun);
}
- found = assq_no_quit (make_int (n), Vread_objects);
+ found = assq_no_quit (make_int (n), read_objects);
if (c == '=')
{
/* #n=object returns object, but associates it with
("Multiply defined symbol label"),
make_int (n)));
obj = read0 (readcharfun);
- Vread_objects = Fcons (Fcons (make_int (n), obj),
- Vread_objects);
+ read_objects = Fcons (Fcons (make_int (n), obj), read_objects);
return obj;
}
else if (c == '#')
return Qzero;
Lstream_flush (XLSTREAM (Vread_buffer_stream));
- return
- make_string
- (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
- Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
+#if 0 /* FSFmacs defun hack */
+ if (read_pure)
+ return
+ make_pure_string
+ (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
+ Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
+ else
+#endif
+ return
+ make_string
+ (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
+ Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
}
default:
#define EXP_INT 16
int
-isfloat_string (const char *cp)
+isfloat_string (CONST char *cp)
{
int state = 0;
- const Bufbyte *ucp = (const Bufbyte *) cp;
+ CONST Bufbyte *ucp = (CONST Bufbyte *) cp;
if (*ucp == '+' || *ucp == '-')
ucp++;
unreadchar (readcharfun, ch);
#ifdef FEATUREP_SYNTAX
if (ch == ']')
- read_syntax_error ("\"]\" in a list");
+ syntax_error ("\"]\" in a list");
else if (ch == ')')
- read_syntax_error ("\")\" in a vector");
+ syntax_error ("\")\" in a vector");
#endif
state = ((conser) (readcharfun, state, len));
}
goto done;
}
else if (ch == ']')
- read_syntax_error ("']' in a list");
+ syntax_error ("']' in a list");
else if (ch == ')')
- read_syntax_error ("')' in a vector");
+ syntax_error ("')' in a vector");
else
#endif
if (ch != '.')
signal_simple_error ("BUG! Internal reader error", elt);
else if (!s->allow_dotted_lists)
- read_syntax_error ("\".\" in a vector");
+ syntax_error ("\".\" in a vector");
else
{
if (!NILP (s->tail))
goto done;
}
}
- read_syntax_error (". in wrong context");
+ syntax_error (". in wrong context");
}
}
i < len;
i++, p++)
{
- Lisp_Cons *otem = XCONS (tem);
- tem = Fcar (tem);
+ struct Lisp_Cons *otem = XCONS (tem);
+#if 0 /* FSFmacs defun hack */
+ if (read_pure)
+ tem = Fpurecopy (Fcar (tem));
+ else
+#endif
+ tem = Fcar (tem);
*p = tem;
tem = otem->cdr;
free_cons (otem);
len = XINT (Flength (stuff));
if (len < COMPILED_STACK_DEPTH + 1 || len > COMPILED_DOMAIN + 1)
return
- continuable_read_syntax_error ("#[...] used with wrong number of elements");
+ continuable_syntax_error ("#[...] used with wrong number of elements");
for (iii = 0; CONSP (stuff); iii++)
{
- Lisp_Cons *victim = XCONS (stuff);
+ struct Lisp_Cons *victim = XCONS (stuff);
make_byte_code_args[iii] = Fcar (stuff);
if ((purify_flag || load_force_doc_strings)
&& CONSP (make_byte_code_args[iii])
Vvalues = Qnil;
load_in_progress = 0;
-
+
Vload_descriptor_list = Qnil;
/* kludge: locate-file does not work for a null load-path, even if
defsymbol (&Qcurrent_load_list, "current-load-list");
defsymbol (&Qload, "load");
defsymbol (&Qload_file_name, "load-file-name");
+ defsymbol (&Qlocate_file_hash_table, "locate-file-hash-table");
defsymbol (&Qfset, "fset");
#ifdef LISP_BACKQUOTES
defsymbol (&Qcomma_at, ",@");
defsymbol (&Qcomma_dot, ",.");
#endif
-
- defsymbol (&Qexists, "exists");
- defsymbol (&Qreadable, "readable");
- defsymbol (&Qwritable, "writable");
- defsymbol (&Qexecutable, "executable");
}
void
}
void
-reinit_vars_of_lread (void)
-{
- Vread_buffer_stream = Qnil;
- staticpro_nodump (&Vread_buffer_stream);
-}
-
-void
vars_of_lread (void)
{
- reinit_vars_of_lread ();
-
DEFVAR_LISP ("values", &Vvalues /*
List of values of all expressions which were read, evaluated and printed.
Order is reverse chronological.
*/ );
load_force_doc_strings = 0;
+ DEFVAR_LISP ("source-directory", &Vsource_directory /*
+Directory in which XEmacs sources were found when XEmacs was built.
+You cannot count on them to still be there!
+*/ );
+ Vsource_directory = Qnil;
+
/* See read_escape(). */
#if 0
/* Used to be named `puke-on-fsf-keys' */
with values saved when the image is dumped. */
staticpro (&Vload_descriptor_list);
+ Vread_buffer_stream = Qnil;
+ staticpro (&Vread_buffer_stream);
+
/* Initialized in init_lread. */
staticpro (&Vload_force_doc_string_list);
Vfile_domain = Qnil;
#endif
- Vread_objects = Qnil;
- staticpro (&Vread_objects);
-
- Vlocate_file_hash_table = make_lisp_hash_table (200,
- HASH_TABLE_NON_WEAK,
- HASH_TABLE_EQUAL);
- staticpro (&Vlocate_file_hash_table);
-#ifdef DEBUG_XEMACS
- symbol_value (XSYMBOL (intern ("Vlocate-file-hash-table")))
- = Vlocate_file_hash_table;
-#endif
+ read_objects = Qnil;
+ staticpro (&read_objects);
}
projects / chise / xemacs-chise.git.1 / blobdiff