xemacs-beta: src/lread.c comparison

comparison 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

comparison

equal deleted inserted replaced

-:f4aeb21a5bad
+:74fd4e045ea6
 #endif
 Lisp_Object Qvariable_domain;	/* I18N3 */
 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;
 #endif
 /* The association list of objects read with the #n=object form.
 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
 purify_flag is set. */
 static int load_force_doc_strings;
 			      ? (build_string ("internal input stream"))	\
 			      : (x))
 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)));
 }
 {
 struct gcpro gcpro1;
 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. */
 Vload_force_doc_string_list = oldlist;
 	      NGCPRO1 (juan);
 	      ivan = Fread (juan);
 	      if (!CONSP (ivan))
 		signal_simple_error ("invalid lazy-loaded byte code", ivan);
-	      /* Remember to purecopy; see above. */
+	      XCOMPILED_FUNCTION (john)->instructions = XCAR (ivan);
-	      XCOMPILED_FUNCTION (john)->instructions = 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 = Fpurecopy (XCDR (ivan));
+	      XCOMPILED_FUNCTION (john)->constants = XCDR (ivan);
 	      NUNGCPRO;
 	    }
 	  doc = compiled_function_documentation (XCOMPILED_FUNCTION (john));
 	  if (CONSP (doc))
 	    {
 struct gcpro gcpro1, gcpro2, gcpro3;
 int reading_elc = 0;
 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);
 CHECK_STRING (file);
 /*#ifdef DEBUG_XEMACS*/
 if (purify_flag && noninteractive)
 {
 message_p = 1;
 last_file_loaded = file;
-pure_usage = purespace_usage ();
 }
 /*#endif / * DEBUG_XEMACS */
 /* If file name is magic, call the handler.  */
 handler = Ffind_file_name_handler (file, Qload);
 {
 char *foundstr;
 int foundlen;
 fd = locate_file (Vload_path, file,
-((!NILP (nosuffix)) ? "" :
+((!NILP (nosuffix)) ? Qnil :
-			 load_ignore_elc_files ? ".el:" :
+			 build_string (load_ignore_elc_files ? ".el:" :
-			 ".elc:.el:"),
+				       ".elc:.el:")),
 &found,
 -1);
 if (fd < 0)
 	{
 PRINT_LOADING_MESSAGE ("");
 {
 /* 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);
 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
 /* 64K is used for normal files; 8K should be OK here because Lisp
 }
 /*#ifdef DEBUG_XEMACS*/
 if (purify_flag && noninteractive)
 {
-if (EQ (last_file_loaded, file))
+if (!EQ (last_file_loaded, file))
-	message_append (" (%ld)",
+	message ("Loading %s ...done", XSTRING_DATA (file));
-			(unsigned long) (purespace_usage() - pure_usage));
-else
-	message ("Loading %s ...done (%ld)", XSTRING_DATA (file),
-		 (unsigned long) (purespace_usage() - pure_usage));
 }
 /*#endif / * DEBUG_XEMACS */
 if (!noninteractive)
 PRINT_LOADING_MESSAGE ("done");
 UNGCPRO;
 return Qt;
 }
-#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);
+if (EQ (mode, Qexists))
-return (IS_DIRECTORY_SEP (s[0])
+return F_OK;
-	  || (XSTRING_LENGTH (pathname) > 2
+else if (EQ (mode, Qexecutable))
-	      && IS_DEVICE_SEP (s[1]) && IS_DIRECTORY_SEP (s[2]))
+return X_OK;
-#ifdef ALTOS
+else if (EQ (mode, Qwritable))
-	  || *s == '@'
+return W_OK;
-#endif
+else if (EQ (mode, Qreadable))
-	  );
+return R_OK;
-}
+else if (INTP (mode))
-#endif /* 0 */
+{
+check_int_range (XINT (mode), 0, 7);
+return XINT (mode);
+}
+else
+signal_simple_error ("Invalid value", mode);
+return 0;			/* unreached */
+}
+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
+Search for FILENAME through PATH-LIST.
-SUFFIXES (string of suffixes separated by ":"s), checking for access
-MODE (0|1|2|4 = exists|executable|writeable|readable), default readable.
+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
 the face of a changing and unpredictable environment, but can occasionally
 get tripped up.  In this case, you will have to call
 {
 /* This function can GC */
 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, 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 */
+/* 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 str)
+locate_file_refresh_hashing (Lisp_Object directory)
 {
-Lisp_Object hash = make_directory_hash_table ((char *) XSTRING_DATA (str));
+Lisp_Object hash =
-Fput (str, Qlocate_file_hash_table, 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 string, recalculating if necessary */
+/* find the hash table for the given directory, recalculating if necessary */
 static Lisp_Object
-locate_file_find_directory_hash_table (Lisp_Object str)
+locate_file_find_directory_hash_table (Lisp_Object directory)
 {
-Lisp_Object hash = Fget (str, Qlocate_file_hash_table, Qnil);
+Lisp_Object hash = Fgethash (directory, Vlocate_file_hash_table, Qnil);
-if (! HASH_TABLEP (hash))
+if (NILP (hash))
-return locate_file_refresh_hashing (str);
+return locate_file_refresh_hashing (directory);
-return hash;
+else
-}
+return hash;
+}
-/* look for STR in PATH, optionally adding suffixes in SUFFIX */
+/* 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 (Lisp_Object path, Lisp_Object str,
+locate_file_in_directory_mapper (char *fn, void *arg)
-			  CONST char *suffix, Lisp_Object *storeptr,
+{
+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;
+struct locate_file_in_directory_mapper_closure closure;
-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 ... */
 {
 else
 	filename = Fexpand_file_name (filename,
 				      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.  */
+closure.fd = -1;
-want_size = strlen (suffix) + XSTRING_LENGTH (filename) + 1;
+closure.storeptr = storeptr;
-if (fn_size < want_size)
+closure.mode = mode;
-fn = (char *) alloca (fn_size = 100 + want_size);
+locate_file_map_suffixes (filename, suffixes, locate_file_in_directory_mapper,
-nsuffix = suffix;
+			    &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 -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;
+int absolute = !NILP (Ffile_name_absolute_p (str));
-struct gcpro gcpro1;
+EXTERNAL_LIST_LOOP (path, path)
-/* is this necessary? */
+{
-GCPRO1 (path);
+int val = locate_file_in_directory (XCAR (path), str, suffixes, storeptr,
+					  mode);
-absolute = !NILP (Ffile_name_absolute_p (str));
-for (; !NILP (path); path = Fcdr (path))
-{
-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;
+}
+/* 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 filename,
+				      Lisp_Object suffixes)
+{
+Lisp_Object tail = Qnil;
+struct gcpro gcpro1;
+GCPRO1 (tail);
+locate_file_map_suffixes (filename, suffixes,
+			    locate_file_construct_suffixed_files_mapper,
+			    &tail);
 UNGCPRO;
-return -1;
+return Fnreverse (tail);
-}
-/* Construct a list of all files to search for. */
-static Lisp_Object
-locate_file_construct_suffixed_files (Lisp_Object str, CONST char *suffix)
-{
-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);
 }
 DEFUN ("locate-file-clear-hashing", Flocate_file_clear_hashing, 1, 1, 0, /*
 Clear the hash records for the specified list of directories.
 `locate-file' uses a hashing scheme to speed lookup, and will correctly
 -- byte-compilation of a .el file into a .elc file.
 `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;
+if (EQ (path, Qt))
+Fclrhash (Vlocate_file_hash_table);
-for (pathtail = path; !NILP (pathtail); pathtail = Fcdr (pathtail))
+else
 {
-Lisp_Object pathel = Fcar (pathtail);
+Lisp_Object pathtail;
-if (!purified (pathel))
+EXTERNAL_LIST_LOOP (pathtail, path)
-	Fput (pathel, Qlocate_file_hash_table, Qnil);
+	{
+	  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.
+in the Lisp list PATH, and trying suffixes from SUFFIXES.
-SUFFIX is a string containing possible suffixes separated by colons.
+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,
 just look for one for which access(file,MODE) succeeds.  In this case,
 returns 1 on success.
 Nil is stored there on failure.
 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);
+val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
+UNGCPRO;
-/* Is it really necessary to gcpro path and str?  It shouldn't be
+return val;
-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 pathel = Fcar (pathtail);
 Lisp_Object hash_table;
 Lisp_Object tail;
-int found;
+int found = 0;
-/* If this path element is relative, we have to look by hand.
+/* If this path element is relative, we have to look by hand. */
-Can't set string property in a pure string. */
+if (NILP (Ffile_name_absolute_p (pathel)))
-if (NILP (pathel) || NILP (Ffile_name_absolute_p (pathel)) ||
-	  purified (pathel))
 	{
-	  val = locate_file_in_directory (pathel, str, suffix, storeptr,
+	  val = locate_file_in_directory (pathel, str, suffixes, storeptr,
 					  mode);
 	  if (val >= 0)
 	    {
 	      UNGCPRO;
 	      return val;
 	    }
 	  continue;
 	}
-hash_table = locate_file_find_directory_hash_table (pathel);
+pathel_expanded = Fexpand_file_name (pathel, Qnil);
+hash_table = locate_file_find_directory_hash_table (pathel_expanded);
-/* Loop over suffixes.  */
-for (tail = suffixtab, found = 0; !found && CONSP (tail);
+if (!NILP (hash_table))
-	   tail = XCDR (tail))
 	{
-	  if (!NILP (Fgethash (XCAR (tail), hash_table, Qnil)))
+	  /* Loop over suffixes.  */
-	    found = 1;
+	  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)
 	    {
 	      UNGCPRO;
 	      return val;
 	    }
 	  /* 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,
+val = locate_file_without_hash (path, str, suffixes, storeptr, mode);
-				  mode);
 if (val >= 0)
 {
 /* Sneaky user added a file without telling us. */
 Flocate_file_clear_hashing (path);
 }
 	}
 else
 #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
 	    val = call1 (Vload_read_function, readcharfun);
 	}
 if (NILP (stream))
 stream = Vstandard_input;
 if (EQ (stream, Qt))
 stream = Qread_char;
-read_objects = Qnil;
+Vread_objects = Qnil;
 #ifdef COMPILED_FUNCTION_ANNOTATION_HACK
 Vcurrent_compiled_function_annotation = Qnil;
 #endif
 if (EQ (stream, Qread_char))
 get_string_range_byte (string, start, end, &startval, &endval,
 			 GB_HISTORICAL_STRING_BEHAVIOR);
 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?
 At least our reader is reentrant ... */
 tem =
 /* Use this for recursive reads, in contexts where internal tokens
 are not allowed.  See also read1(). */
 static Lisp_Object
 read0 (Lisp_Object readcharfun)
 {
-Lisp_Object val;
+Lisp_Object val = read1 (readcharfun);
-val = read1 (readcharfun);
 if (CONSP (val) && UNBOUNDP (XCAR (val)))
 {
 Emchar c = XCHAR (XCDR (val));
 free_cons (XCONS (val));
 return Fsignal (Qinvalid_read_syntax,
 	  }
 	return i;
 }
 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 */
 	    if      (c >= '0' && c <= '9')  i = (i << 4) + (c - '0');
 	    else if (c >= 'a' && c <= 'f')  i = (i << 4) + (c - 'a') + 10;
 Lstream_flush (XLSTREAM (Vread_buffer_stream));
 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,
 Emchar firstchar,
 int uninterned_symbol)
 }
 {
 Lisp_Object sym;
 if (uninterned_symbol)
-sym = (Fmake_symbol ((purify_flag)
+sym = Fmake_symbol ( make_string ((Bufbyte *) read_ptr, len));
-			   ? 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 *lim = buf + len;
-CONST Bufbyte *p = buf;
+const Bufbyte *p = buf;
 EMACS_UINT num = 0;
 int negativland = 0;
 if (*p == '-')
 {
 static Lisp_Object
 read_bit_vector (Lisp_Object readcharfun)
 {
 unsigned_char_dynarr *dyn = Dynarr_new (unsigned_char);
 Emchar c;
+Lisp_Object val;
 while (1)
 {
 c = readchar (readcharfun);
 if (c != '0' && c != '1')
 }
 if (c >= 0)
 unreadchar (readcharfun, c);
-return make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
+val = make_bit_vector_from_byte_vector (Dynarr_atp (dyn, 0),
-					   Dynarr_length (dyn));
+					  Dynarr_length (dyn));
+Dynarr_free (dyn);
+return val;
 }
 /* structures */
 		{
 		  n *= 10;
 		  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
 		     n for #n#.  */
 		  Lisp_Object obj;
 		    return Fsignal (Qinvalid_read_syntax,
 				    list2 (build_translated_string
 					   ("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 == '#')
 		{
 		  /* #n# returns a previously read object.  */
 	   that we are really going to find in lib-src/DOC.nn.nn  */
 	if (purify_flag && NILP (Vinternal_doc_file_name) && cancel)
 	  return Qzero;
 	Lstream_flush (XLSTREAM (Vread_buffer_stream));
-#if 0 /* FSFmacs defun hack */
+	return
-	if (read_pure)
+	  make_string
-	  return
+	  (resizing_buffer_stream_ptr (XLSTREAM (Vread_buffer_stream)),
-	    make_pure_string
+	   Lstream_byte_count (XLSTREAM (Vread_buffer_stream)));
-	      (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:
 {
 	/* Ignore whitespace and control characters */
 #define TRAIL_INT 4
 #define E_CHAR 8
 #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++;
 if (*ucp >= '0' && *ucp <= '9')
 for (i = 0, p = &(XVECTOR_DATA (s.head)[0]);
 i < len;
 i++, p++)
 {
-struct Lisp_Cons *otem = XCONS (tem);
+Lisp_Cons *otem = XCONS (tem);
-#if 0 /* FSFmacs defun hack */
+tem = Fcar (tem);
-if (read_pure)
-tem = Fpurecopy (Fcar (tem));
-else
-#endif
-tem = Fcar (tem);
 *p = tem;
 tem = otem->cdr;
 free_cons (otem);
 }
 return s.head;
 return
 continuable_syntax_error ("#[...] used with wrong number of elements");
 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])
 	  && EQ (XCAR (make_byte_code_args[iii]), Vload_file_name_internal))
 	{
 defsymbol (&Qstandard_input, "standard-input");
 defsymbol (&Qread_char, "read-char");
 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 (&Qbackquote, "backquote");
 defsymbol (&Qbacktick, "`");
 defsymbol (&Qcomma, ",");
 defsymbol (&Qcomma_at, ",@");
 defsymbol (&Qcomma_dot, ",.");
 #endif
+defsymbol (&Qexists, "exists");
+defsymbol (&Qreadable, "readable");
+defsymbol (&Qwritable, "writable");
+defsymbol (&Qexecutable, "executable");
 }
 void
 structure_type_create (void)
 {
 the_structure_type_dynarr = Dynarr_new (structure_type);
 }
 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.
 */ );
 /* This must be initialized in init_lread otherwise it may start out
 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);
 Vload_file_name_internal = Qnil;
 staticpro (&Vload_file_name_internal);
 #ifdef I18N3
 Vfile_domain = Qnil;
 #endif
-read_objects = Qnil;
+Vread_objects = Qnil;
-staticpro (&read_objects);
+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
+}

Mercurial > hg > xemacs-beta

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