diff src/lread.c @ 398:74fd4e045ea6 r21-2-29

Import from CVS: tag r21-2-29
author cvs
date Mon, 13 Aug 2007 11:13:30 +0200
parents 8626e4521993
children a86b2b5e0111
line wrap: on
line diff
--- a/src/lread.c	Mon Aug 13 11:12:06 2007 +0200
+++ b/src/lread.c	Mon Aug 13 11:13:30 2007 +0200
@@ -63,9 +63,13 @@
 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;
@@ -118,7 +122,7 @@
    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 read_objects;
+Lisp_Object Vread_objects;
 
 /* Nonzero means load should forcibly load all dynamic doc strings.  */
 /* Note that this always happens (with some special behavior) when
@@ -214,14 +218,14 @@
 
 
 static DOESNT_RETURN
-syntax_error (CONST char *string)
+syntax_error (const char *string)
 {
   signal_error (Qinvalid_read_syntax,
 		list1 (build_translated_string (string)));
 }
 
 static Lisp_Object
-continuable_syntax_error (CONST char *string)
+continuable_syntax_error (const char *string)
 {
   return Fsignal (Qinvalid_read_syntax,
 		  list1 (build_translated_string (string)));
@@ -439,12 +443,6 @@
   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. */
@@ -475,13 +473,12 @@
 	      ivan = Fread (juan);
 	      if (!CONSP (ivan))
 		signal_simple_error ("invalid lazy-loaded byte code", ivan);
-	      /* Remember to purecopy; see above. */
-	      XCOMPILED_FUNCTION (john)->instructions = Fpurecopy (XCAR (ivan));
+	      XCOMPILED_FUNCTION (john)->instructions = 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 = Fpurecopy (XCDR (ivan));
+	      XCOMPILED_FUNCTION (john)->constants = XCDR (ivan);
 	      NUNGCPRO;
 	    }
 	  doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
@@ -553,7 +550,6 @@
   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);
@@ -565,7 +561,6 @@
     {
       message_p = 1;
       last_file_loaded = file;
-      pure_usage = purespace_usage ();
     }
 /*#endif / * DEBUG_XEMACS */
 
@@ -593,9 +588,9 @@
       int foundlen;
 
       fd = locate_file (Vload_path, file,
-                        ((!NILP (nosuffix)) ? "" :
-			 load_ignore_elc_files ? ".el:" :
-			 ".elc:.el:"),
+                        ((!NILP (nosuffix)) ? Qnil :
+			 build_string (load_ignore_elc_files ? ".el:" :
+				       ".elc:.el:")),
                         &found,
                         -1);
 
@@ -681,7 +676,7 @@
   {
     /* 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);
@@ -786,12 +781,8 @@
 /*#ifdef DEBUG_XEMACS*/
   if (purify_flag && noninteractive)
     {
-      if (EQ (last_file_loaded, file))
-	message_append (" (%ld)",
-			(unsigned long) (purespace_usage() - pure_usage));
-      else
-	message ("Loading %s ...done (%ld)", XSTRING_DATA (file),
-		 (unsigned long) (purespace_usage() - pure_usage));
+      if (!EQ (last_file_loaded, file))
+	message ("Loading %s ...done", XSTRING_DATA (file));
     }
 /*#endif / * DEBUG_XEMACS */
 
@@ -803,26 +794,57 @@
 }
 
 
-#if 0 /* FSFmacs */
-/* not used */
+/* ------------------------------- */
+/*          locate_file            */
+/* ------------------------------- */
+
 static int
-complete_filename_p (Lisp_Object pathname)
+decode_mode_1 (Lisp_Object 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
-	  );
+  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 */
 }
-#endif /* 0 */
+
+static int
+decode_mode (Lisp_Object mode)
+{
+  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);
+}
 
 DEFUN ("locate-file", Flocate_file, 2, 4, 0, /*
-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.
+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'.
 
 `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
@@ -837,61 +859,208 @@
   Lisp_Object tp;
 
   CHECK_STRING (filename);
-  if (!NILP (suffixes))
+
+  if (LISTP (suffixes))
+    {
+      Lisp_Object tail;
+      EXTERNAL_LIST_LOOP (tail, suffixes)
+	CHECK_STRING (XCAR (tail));
+    }
+  else
     CHECK_STRING (suffixes);
-  if (!NILP (mode))
-    CHECK_NATNUM (mode);
-
-  locate_file (path_list,
-	       filename,
-               NILP (suffixes) ? "" : (char *) XSTRING_DATA (suffixes),
-	       &tp,
-	       NILP (mode) ? R_OK : XINT (mode));
+
+  locate_file (path_list, filename, suffixes, &tp, decode_mode (mode));
   return tp;
 }
 
-/* recalculate the hash table for the given string */
+/* Recalculate the hash table for the given string.  DIRECTORY should
+   better have been through Fexpand_file_name() by now.  */
+
+static Lisp_Object
+locate_file_refresh_hashing (Lisp_Object directory)
+{
+  Lisp_Object hash =
+    make_directory_hash_table ((char *) XSTRING_DATA (directory));
+
+  if (!NILP (hash))
+    Fputhash (directory, hash, Vlocate_file_hash_table);
+  return hash;
+}
+
+/* find the hash table for the given directory, recalculating if necessary */
 
 static Lisp_Object
-locate_file_refresh_hashing (Lisp_Object str)
+locate_file_find_directory_hash_table (Lisp_Object directory)
 {
-  Lisp_Object hash = make_directory_hash_table ((char *) XSTRING_DATA (str));
-  Fput (str, Qlocate_file_hash_table, hash);
-  return hash;
+  Lisp_Object hash = Fgethash (directory, Vlocate_file_hash_table, Qnil);
+  if (NILP (hash))
+    return locate_file_refresh_hashing (directory);
+  else
+    return hash;
 }
 
-/* find the hash table for the given string, recalculating if necessary */
-
-static Lisp_Object
-locate_file_find_directory_hash_table (Lisp_Object str)
+/* 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)
 {
-  Lisp_Object hash = Fget (str, Qlocate_file_hash_table, Qnil);
-  if (! HASH_TABLEP (hash))
-    return locate_file_refresh_hashing (str);
-  return hash;
+  /* 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;
+	}
+    }
 }
 
-/* look for STR in PATH, optionally adding suffixes in SUFFIX */
+struct locate_file_in_directory_mapper_closure {
+  int fd;
+  Lisp_Object *storeptr;
+  int mode;
+};
 
 static int
-locate_file_in_directory (Lisp_Object path, Lisp_Object str,
-			  CONST char *suffix, Lisp_Object *storeptr,
+locate_file_in_directory_mapper (char *fn, void *arg)
+{
+  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 (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 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 (closure->mode < 0)
+	    (void) fcntl (closure->fd, F_SETFD, FD_CLOEXEC);
+#endif
+
+	  return 1;
+	}
+    }
+  /* Keep mapping. */
+  return 0;
+}
+
+
+/* look for STR in PATH, optionally adding SUFFIXES.  DIRECTORY need
+   not have been expanded.  */
+
+static int
+locate_file_in_directory (Lisp_Object directory, Lisp_Object str,
+			  Lisp_Object suffixes, Lisp_Object *storeptr,
 			  int mode)
 {
   /* This function can GC */
-  int fd;
-  int fn_size = 100;
-  char buf[100];
-  char *fn = buf;
-  int want_size;
-  struct stat st;
+  struct locate_file_in_directory_mapper_closure closure;
   Lisp_Object filename = Qnil;
   struct gcpro gcpro1, gcpro2, gcpro3;
-  CONST char *nsuffix;
-
-  GCPRO3 (path, str, filename);
-
-  filename = Fexpand_file_name (str, path);
+
+  GCPRO3 (directory, str, filename);
+
+  filename = Fexpand_file_name (str, directory);
   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
@@ -905,142 +1074,73 @@
 				      current_buffer->directory);
       if (NILP (Ffile_name_absolute_p (filename)))
 	{
-	  /* Give up on this path element! */
+	  /* Give up on this directory! */
 	  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);
-
-  nsuffix = suffix;
-
-  /* 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;
-    }
+
+  closure.fd = -1;
+  closure.storeptr = storeptr;
+  closure.mode = mode;
+
+  locate_file_map_suffixes (filename, suffixes, locate_file_in_directory_mapper,
+			    &closure);
 
   UNGCPRO;
-  return -1;
+  return closure.fd;
 }
 
 /* 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,
-			  CONST char *suffix, Lisp_Object *storeptr,
+			  Lisp_Object suffixes, Lisp_Object *storeptr,
 			  int mode)
 {
   /* This function can GC */
-  int absolute;
-  struct gcpro gcpro1;
-
-  /* is this necessary? */
-  GCPRO1 (path);
-
-  absolute = !NILP (Ffile_name_absolute_p (str));
-
-  for (; !NILP (path); path = Fcdr (path))
+  int absolute = !NILP (Ffile_name_absolute_p (str));
+
+  EXTERNAL_LIST_LOOP (path, path)
     {
-      int val = locate_file_in_directory (Fcar (path), str, suffix,
-					  storeptr, mode);
+      int val = locate_file_in_directory (XCAR (path), str, suffixes, storeptr,
+					  mode);
       if (val >= 0)
-	{
-	  UNGCPRO;
-	  return val;
-	}
+	return val;
       if (absolute)
 	break;
     }
-
-  UNGCPRO;
   return -1;
 }
 
-/* Construct a list of all files to search for. */
+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;
+}
+
+/* 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(). */
 
 static Lisp_Object
-locate_file_construct_suffixed_files (Lisp_Object str, CONST char *suffix)
+locate_file_construct_suffixed_files (Lisp_Object filename,
+				      Lisp_Object suffixes)
 {
-  int want_size;
-  int fn_size = 100;
-  char buf[100];
-  char *fn = buf;
-  CONST char *nsuffix;
-  Lisp_Object suffixtab = Qnil;
-
-  /* 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);
-
-  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);
+  Lisp_Object tail = Qnil;
+  struct gcpro gcpro1;
+  GCPRO1 (tail);
+
+  locate_file_map_suffixes (filename, suffixes,
+			    locate_file_construct_suffixed_files_mapper,
+			    &tail);
+
+  UNGCPRO;
+  return Fnreverse (tail);
 }
 
 DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
@@ -1056,23 +1156,31 @@
 `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))
 {
-  Lisp_Object pathtail;
-
-  for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
+  if (EQ (path, Qt))
+    Fclrhash (Vlocate_file_hash_table);
+  else
     {
-      Lisp_Object pathel = Fcar (pathtail);
-      if (!purified (pathel))
-	Fput (pathel, Qlocate_file_hash_table, Qnil);
+      Lisp_Object pathtail;
+      EXTERNAL_LIST_LOOP (pathtail, path)
+	{
+	  Lisp_Object pathel = Fexpand_file_name (XCAR (pathtail), Qnil);
+	  Fremhash (pathel, Vlocate_file_hash_table);
+	}
     }
   return Qnil;
 }
 
 /* Search for a file whose name is STR, looking in directories
-   in the Lisp list PATH, and trying suffixes from SUFFIX.
-   SUFFIX is a string containing possible suffixes separated by colons.
+   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.
    On success, returns a file descriptor.  On failure, returns -1.
 
    MODE nonnegative means don't open the files,
@@ -1086,43 +1194,45 @@
    Called openp() in FSFmacs. */
 
 int
-locate_file (Lisp_Object path, Lisp_Object str, CONST char *suffix,
+locate_file (Lisp_Object path, Lisp_Object str, Lisp_Object suffixes,
 	     Lisp_Object *storeptr, int mode)
 {
   /* This function can GC */
   Lisp_Object suffixtab = Qnil;
-  Lisp_Object pathtail;
+  Lisp_Object pathtail, pathel_expanded;
   int val;
-  struct gcpro gcpro1, gcpro2, gcpro3;
+  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
 
   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)))
-    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, suffix);
-
-  for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
     {
-      Lisp_Object pathel = Fcar (pathtail);
+      val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
+      UNGCPRO;
+      return val;
+    }
+
+  suffixtab = locate_file_construct_suffixed_files (str, suffixes);
+
+  EXTERNAL_LIST_LOOP (pathtail, path)
+    {
+      Lisp_Object pathel = XCAR (pathtail);
       Lisp_Object hash_table;
       Lisp_Object tail;
-      int found;
-
-      /* 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))
+      int found = 0;
+
+      /* If this path element is relative, we have to look by hand. */
+      if (NILP (Ffile_name_absolute_p (pathel)))
 	{
-	  val = locate_file_in_directory (pathel, str, suffix, storeptr,
+	  val = locate_file_in_directory (pathel, str, suffixes, storeptr,
 					  mode);
 	  if (val >= 0)
 	    {
@@ -1132,21 +1242,25 @@
 	  continue;
 	}
 
-      hash_table = locate_file_find_directory_hash_table (pathel);
-
-      /* Loop over suffixes.  */
-      for (tail = suffixtab, found = 0; !found && CONSP (tail);
-	   tail = XCDR (tail))
+      pathel_expanded = Fexpand_file_name (pathel, Qnil);
+      hash_table = locate_file_find_directory_hash_table (pathel_expanded);
+
+      if (!NILP (hash_table))
 	{
-	  if (!NILP (Fgethash (XCAR (tail), hash_table, Qnil)))
-	    found = 1;
+	  /* Loop over suffixes.  */
+	  LIST_LOOP (tail, suffixtab)
+	    if (!NILP (Fgethash (XCAR (tail), hash_table, Qnil)))
+	      {
+		found = 1;
+		break;
+	      }
 	}
 
       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, suffix, storeptr,
+	  val = locate_file_in_directory (pathel, str, suffixes, storeptr,
 					  mode);
 	  if (val >= 0)
 	    {
@@ -1156,13 +1270,12 @@
 
 	  /* Hmm ...  the file isn't actually there. (Or possibly it's
 	     a directory ...)  So refresh our hashing. */
-	  locate_file_refresh_hashing (pathel);
+	  locate_file_refresh_hashing (pathel_expanded);
 	}
     }
 
   /* File is probably not there, but check the hard way just in case. */
-  val = locate_file_without_hash (path, str, suffix, storeptr,
-				  mode);
+  val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
   if (val >= 0)
     {
       /* Sneaky user added a file without telling us. */
@@ -1325,7 +1438,7 @@
 #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
 	{
 	  unreadchar (readcharfun, c);
-	  read_objects = Qnil;
+	  Vread_objects = Qnil;
 	  if (NILP (Vload_read_function))
 	    val = read0 (readcharfun);
 	  else
@@ -1463,7 +1576,7 @@
   if (EQ (stream, Qt))
     stream = Qread_char;
 
-  read_objects = Qnil;
+  Vread_objects = Qnil;
 
 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
   Vcurrent_compiled_function_annotation = Qnil;
@@ -1504,7 +1617,7 @@
   lispstream = make_lisp_string_input_stream (string, startval,
 					      endval - startval);
 
-  read_objects = Qnil;
+  Vread_objects = Qnil;
 
   tem = read0 (lispstream);
   /* Yeah, it's ugly.  Gonna make something of it?
@@ -1539,9 +1652,8 @@
 static Lisp_Object
 read0 (Lisp_Object readcharfun)
 {
-  Lisp_Object val;
-
-  val = read1 (readcharfun);
+  Lisp_Object val = read1 (readcharfun);
+
   if (CONSP (val) && UNBOUNDP (XCAR (val)))
     {
       Emchar c = XCHAR (XCDR (val));
@@ -1681,10 +1793,14 @@
       }
 
     case 'x':
-      /* A hex escape, as in ANSI C.  */
+      /* 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. */
       {
 	REGISTER Emchar i = 0;
-	while (1)
+	REGISTER int count = 0;
+	while (++count <= 2)
 	  {
 	    c = readchar (readcharfun);
 	    /* Remember, can't use isdigit(), isalpha() etc. on Emchars */
@@ -1754,7 +1870,7 @@
   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,
@@ -1822,23 +1938,11 @@
   {
     Lisp_Object sym;
     if (uninterned_symbol)
-      sym = (Fmake_symbol ((purify_flag)
-			   ? make_pure_pname ((Bufbyte *) read_ptr, len, 0)
-			   : make_string ((Bufbyte *) read_ptr, len)));
+      sym = Fmake_symbol ( 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;
   }
@@ -1846,10 +1950,10 @@
 
 
 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;
 
@@ -1932,6 +2036,7 @@
 {
   unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
   Emchar c;
+  Lisp_Object val;
 
   while (1)
     {
@@ -1944,8 +2049,12 @@
   if (c >= 0)
     unreadchar (readcharfun, c);
 
-  return make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
-					   Dynarr_length (dyn));
+  val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
+					  Dynarr_length (dyn));
+
+  Dynarr_free (dyn);
+
+  return val;
 }
 
 
@@ -2421,7 +2530,7 @@
 		  n += c - '0';
 		  c = readchar (readcharfun);
 		}
-	      found = assq_no_quit (make_int (n), read_objects);
+	      found = assq_no_quit (make_int (n), Vread_objects);
 	      if (c == '=')
 		{
 		  /* #n=object returns object, but associates it with
@@ -2433,7 +2542,8 @@
 					   ("Multiply defined symbol label"),
 					   make_int (n)));
 		  obj = read0 (readcharfun);
-		  read_objects = Fcons (Fcons (make_int (n), obj), read_objects);
+		  Vread_objects = Fcons (Fcons (make_int (n), obj),
+					 Vread_objects);
 		  return obj;
 		}
 	      else if (c == '#')
@@ -2559,18 +2669,10 @@
 	  return Qzero;
 
 	Lstream_flush (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)));
+	return
+	  make_string
+	  (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
+	   Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
       }
 
     default:
@@ -2594,10 +2696,10 @@
 #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++;
@@ -2900,13 +3002,8 @@
        i < len;
        i++, p++)
   {
-    struct Lisp_Cons *otem = XCONS (tem);
-#if 0 /* FSFmacs defun hack */
-    if (read_pure)
-      tem = Fpurecopy (Fcar (tem));
-    else
-#endif
-      tem = Fcar (tem);
+    Lisp_Cons *otem = XCONS (tem);
+    tem = Fcar (tem);
     *p = tem;
     tem = otem->cdr;
     free_cons (otem);
@@ -2937,7 +3034,7 @@
 
   for (iii = 0; CONSP (stuff); iii++)
     {
-      struct Lisp_Cons *victim = XCONS (stuff);
+      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])
@@ -3022,7 +3119,6 @@
   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
@@ -3032,6 +3128,11 @@
   defsymbol (&Qcomma_at, ",@");
   defsymbol (&Qcomma_dot, ",.");
 #endif
+
+  defsymbol (&Qexists, "exists");
+  defsymbol (&Qreadable, "readable");
+  defsymbol (&Qwritable, "writable");
+  defsymbol (&Qexecutable, "executable");
 }
 
 void
@@ -3041,8 +3142,17 @@
 }
 
 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.
@@ -3160,9 +3270,6 @@
      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);
 
@@ -3196,6 +3303,15 @@
   Vfile_domain = Qnil;
 #endif
 
-  read_objects = Qnil;
-  staticpro (&read_objects);
+  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
 }