xemacs-beta: src/lread.c comparison

comparison src/lread.c @ 771:943eaba38521

[xemacs-hg @ 2002-03-13 08:51:24 by ben] The big ben-mule-21-5 check-in! Various files were added and deleted. See CHANGES-ben-mule. There are still some test suite failures. No crashes, though. Many of the failures have to do with problems in the test suite itself rather than in the actual code. I'll be addressing these in the next day or so -- none of the test suite failures are at all critical. Meanwhile I'll be trying to address the biggest issues -- i.e. build or run failures, which will almost certainly happen on various platforms. All comments should be sent to ben@xemacs.org -- use a Cc: if necessary when sending to mailing lists. There will be pre- and post- tags, something like pre-ben-mule-21-5-merge-in, and post-ben-mule-21-5-merge-in.

author	ben
date	Wed, 13 Mar 2002 08:54:06 +0000
parents	fdefd0186b75
children	578cb2932d72

comparison

equal deleted inserted replaced

-:336a418893b5
+:943eaba38521
 /* Lisp parsing and input streams.
 Copyright (C) 1985-1989, 1992-1995 Free Software Foundation, Inc.
 Copyright (C) 1995 Tinker Systems.
-Copyright (C) 1996 Ben Wing.
+Copyright (C) 1996, 2001 Ben Wing.
 This file is part of XEmacs.
 XEmacs is free software; you can redistribute it and/or modify it
 under the terms of the GNU General Public License as published by the
 #include "buffer.h"
 #include "bytecode.h"
 #include "elhash.h"
 #include "lstream.h"
 #include "opaque.h"
-#ifdef FILE_CODING
 #include "file-coding.h"
-#endif
 #include "sysfile.h"
-#ifdef LISP_FLOAT_TYPE
-#define THIS_FILENAME lread
 #include "sysfloat.h"
-#endif /* LISP_FLOAT_TYPE */
+#ifdef WIN32_NATIVE
+#include "syswindows.h"
+#endif
 Lisp_Object Qread_char, Qstandard_input;
 Lisp_Object Qvariable_documentation;
 #define LISP_BACKQUOTES
 #ifdef LISP_BACKQUOTES
 /* When errors are signaled, the actual readcharfun should not be used
 as an argument if it is an lstream, so that lstreams don't escape
 to the Lisp level.  */
 #define READCHARFUN_MAYBE(x) (LSTREAMP (x)					\
-			      ? (build_string ("internal input stream"))	\
+			      ? (build_msg_string ("internal input stream"))	\
 			      : (x))
 static DOESNT_RETURN
 read_syntax_error (const char *string)
 void
 close_load_descs (void)
 {
 Lisp_Object tail;
 LIST_LOOP (tail, Vload_descriptor_list)
-close (XINT (XCAR (tail)));
+retry_close (XINT (XCAR (tail)));
 }
 #ifdef I18N3
 Lisp_Object Vfile_domain;
 /* Do this after the handler to avoid
 the need to gcpro noerror, nomessage and nosuffix.
 (Below here, we care only whether they are nil or not.)  */
 file = Fsubstitute_in_file_name (file);
-#ifdef FILE_CODING
 if (!NILP (used_codesys))
 CHECK_SYMBOL (used_codesys);
-#endif
 /* Avoid weird lossage with null string as arg,
 since it would try to load a directory as a Lisp file.
 Unix truly sucks. */
 if (XSTRING_LENGTH (file) > 0)
 {
-char *foundstr;
+Intbyte *foundstr;
 int foundlen;
 fd = locate_file (Vload_path, file,
 ((!NILP (nosuffix)) ? Qnil :
 			 build_string (load_ignore_elc_files ? ".el:" :
 	      UNGCPRO;
 	      return Qnil;
 	    }
 	}
-foundstr = (char *) alloca (XSTRING_LENGTH (found) + 1);
+foundstr = (Intbyte *) alloca (XSTRING_LENGTH (found) + 1);
-strcpy (foundstr, (char *) XSTRING_DATA (found));
+qxestrcpy (foundstr, XSTRING_DATA (found));
-foundlen = strlen (foundstr);
+foundlen = qxestrlen (foundstr);
 /* The omniscient JWZ thinks this is worthless, but I beg to
 	 differ. --ben */
 if (load_ignore_elc_files)
 	{
 	  newer = Ffile_name_nondirectory (found);
 	}
 else if (load_warn_when_source_newer &&
 	       !memcmp (".elc", foundstr + foundlen - 4, 4))
 	{
-	  if (! fstat (fd, &s1))	/* can't fail, right? */
+	  if (! qxe_fstat (fd, &s1))	/* can't fail, right? */
 	    {
 	      int result;
 	      /* temporarily hack the 'c' off the end of the filename */
 	      foundstr[foundlen - 1] = '\0';
-	      result = xemacs_stat (foundstr, &s2);
+	      result = qxe_stat (foundstr, &s2);
 	      if (result >= 0 &&
 		  (unsigned) s1.st_mtime < (unsigned) s2.st_mtime)
 {
-		Lisp_Object newer_name = make_string ((Intbyte *) foundstr,
+		Lisp_Object newer_name = make_string (foundstr,
 						      foundlen - 1);
 struct gcpro nngcpro1;
 NNGCPRO1 (newer_name);
 		newer = Ffile_name_nondirectory (newer_name);
 NNUNGCPRO;
 lispstream = make_filedesc_input_stream (fd, 0, -1, LSTR_CLOSING);
 /* 64K is used for normal files; 8K should be OK here because Lisp
 files aren't really all that big. */
 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
 			   block_size);
-#ifdef FILE_CODING
+lispstream = make_coding_input_stream
-lispstream = make_decoding_input_stream
+(XLSTREAM (lispstream), get_coding_system_for_text_file (codesys, 1),
-(XLSTREAM (lispstream), Fget_coding_system (codesys));
+CODING_DECODE);
 Lstream_set_buffering (XLSTREAM (lispstream), LSTREAM_BLOCKN_BUFFERED,
 			   block_size);
-#endif
 /* NOTE: Order of these is very important.  Don't rearrange them. */
 record_unwind_protect (load_unwind, lispstream);
 record_unwind_protect (load_descriptor_unwind, Vload_descriptor_list);
 record_unwind_protect (load_file_name_internal_unwind,
 			   Vload_file_name_internal);
 }
 else
 load_byte_code_version = 100; /* no Ebolification needed */
 readevalloop (lispstream, file, Feval, 0);
-#ifdef FILE_CODING
 if (!NILP (used_codesys))
 Fset (used_codesys,
 	    XCODING_SYSTEM_NAME
-	    (decoding_stream_coding_system (XLSTREAM (lispstream))));
+	    (coding_stream_detected_coding_system (XLSTREAM (lispstream))));
-#endif
+unbind_to (speccount);
-unbind_to (speccount, Qnil);
 NUNGCPRO;
 }
 {
 static Lisp_Object
 locate_file_refresh_hashing (Lisp_Object directory)
 {
 Lisp_Object hash =
-make_directory_hash_table ((char *) XSTRING_DATA (directory));
+make_directory_hash_table (XSTRING_DATA (directory));
 if (!NILP (hash))
 Fputhash (directory, hash, Vlocate_file_hash_table);
 return hash;
 }
 /* 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 *),
+			  int (*fun) (Intbyte *, void *),
 			  void *arg)
 {
 /* This function can GC */
-char *fn;
+Intbyte *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))
 else
 /* Just take the easy way out */
 max = XSTRING_LENGTH (suffixes);
 fn_len = XSTRING_LENGTH (filename);
-fn = (char *) alloca (max + fn_len + 1);
+fn = (Intbyte *) alloca (max + fn_len + 1);
-memcpy (fn, (char *) XSTRING_DATA (filename), fn_len);
+memcpy (fn, XSTRING_DATA (filename), fn_len);
 /* Loop over suffixes.  */
 if (!STRINGP (suffixes))
 {
 if (NILP (suffixes))
 	}
 }
 else
 {
 /* Case c) */
-const char *nsuffix = (const char *) XSTRING_DATA (suffixes);
+const Intbyte *nsuffix = XSTRING_DATA (suffixes);
 while (1)
 	{
-	  char *esuffix = (char *) strchr (nsuffix, ':');
+	  Intbyte *esuffix = qxestrchr (nsuffix, ':');
-	  int lsuffix = esuffix ? esuffix - nsuffix : (int) strlen (nsuffix);
+	  Bytecount lsuffix = esuffix ? esuffix - nsuffix :
+	    qxestrlen (nsuffix);
 	  /* Concatenate path element/specified name with the suffix.  */
-	  strncpy (fn + fn_len, nsuffix, lsuffix);
+	  qxestrncpy (fn + fn_len, nsuffix, lsuffix);
 	  fn[fn_len + lsuffix] = 0;
 	  if ((*fun) (fn, arg))
 	    return;
 	  nsuffix += lsuffix + 1;
 	}
 }
 }
-struct locate_file_in_directory_mapper_closure {
+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_in_directory_mapper (Intbyte *fn, void *arg)
 {
 struct locate_file_in_directory_mapper_closure *closure =
-(struct locate_file_in_directory_mapper_closure *)arg;
+(struct locate_file_in_directory_mapper_closure *) arg;
 struct stat st;
 /* Ignore file if it's a directory.  */
-if (xemacs_stat (fn, &st) >= 0
+if (qxe_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);
+	closure->fd = qxe_access (fn, closure->mode);
 else
-	closure->fd = open (fn, O_RDONLY | OPEN_BINARY, 0);
+	closure->fd = qxe_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);
+	    *closure->storeptr = build_intstring (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.  */
 closure.fd = -1;
 closure.storeptr = storeptr;
 closure.mode = mode;
-locate_file_map_suffixes (filename, suffixes, locate_file_in_directory_mapper,
+locate_file_map_suffixes (filename, suffixes,
+			    locate_file_in_directory_mapper,
 			    &closure);
 UNGCPRO;
 return closure.fd;
 }
 }
 return -1;
 }
 static int
-locate_file_construct_suffixed_files_mapper (char *fn, void *arg)
+locate_file_construct_suffixed_files_mapper (Intbyte *fn, void *arg)
 {
-Lisp_Object *tail = (Lisp_Object *)arg;
+Lisp_Object *tail = (Lisp_Object *) arg;
-*tail = Fcons (build_string (fn), *tail);
+*tail = Fcons (build_intstring (fn), *tail);
 return 0;
 }
 /* Construct a list of all files to search for.
 It makes sense to have this despite locate_file_map_suffixes()
 if (purify_flag && c == '(')
 	{
 	  int count1 = specpdl_depth ();
 	  record_unwind_protect (unreadpure, Qnil);
 	  val = read_list (readcharfun, ')', -1, 1);
-	  unbind_to (count1, Qnil);
+	  unbind_to (count1);
 	}
 else
 #else /* No "defun hack" -- Emacs 19 uses read-time syntax for bytecodes */
 	{
 	  unreadchar (readcharfun, c);
 		      /* This looks weird, but it's what's in FSFmacs */
 		      (b ? BUF_NARROWED (b) : BUF_NARROWED (current_buffer)),
 sourcename);
 UNGCPRO;
-unbind_to (speccount, Qnil);
+unbind_to (speccount);
 }
 DEFUN ("eval-buffer", Feval_buffer, 0, 2, "bBuffer: ", /*
 Execute BUFFER as Lisp code.
 Programs can pass two arguments, BUFFER and PRINTFLAG.
 record_unwind_protect (save_excursion_restore, save_excursion_save ());
 BUF_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
 readevalloop (buf, XBUFFER (buf)->filename, Feval,
 		!NILP (printflag));
-return unbind_to (speccount, Qnil);
+return unbind_to (speccount);
 }
 #if 0
 xxDEFUN ("eval-current-buffer", Feval_current_buffer, 0, 1, "", /*
 Execute the current buffer as Lisp code.
 Fgoto_char (start, cbuf);
 Fnarrow_to_region (make_int (BUF_BEGV (current_buffer)), end, cbuf);
 readevalloop (cbuf, XBUFFER (cbuf)->filename, Feval,
 		!NILP (stream));
-return unbind_to (speccount, Qnil);
+return unbind_to (speccount);
 }
 DEFUN ("read", Fread, 0, 1, 0, /*
 Read one Lisp expression as text from STREAM, return as Lisp object.
 If STREAM is nil, use the value of `standard-input' (which see).
 Vcurrent_compiled_function_annotation = Qnil;
 #endif
 if (EQ (stream, Qread_char))
 {
 Lisp_Object val = call1 (Qread_from_minibuffer,
-			       build_translated_string ("Lisp expression: "));
+			       build_msg_string ("Lisp expression: "));
 return Fcar (Fread_from_string (val, Qnil, Qnil));
 }
 if (STRINGP (stream))
 return Fcar (Fread_from_string (stream, Qnil, Qnil));
 tem = read0 (lispstream);
 /* Yeah, it's ugly.  Gonna make something of it?
 At least our reader is reentrant ... */
 tem =
 (Fcons (tem, make_int
-	    (bytecount_to_charcount
+	    (XSTRING_INDEX_BYTE_TO_CHAR
-	     (XSTRING_DATA (string),
+	     (string,
 	      startval + Lstream_byte_count (XLSTREAM (lispstream))))));
 Lstream_delete (XLSTREAM (lispstream));
 UNGCPRO;
 return tem;
 }
 goto overflow;
 return result;
 }
 overflow:
 return Fsignal (Qinvalid_read_syntax,
-list3 (build_translated_string
+list3 (build_msg_string
 			 ("Integer constant overflow in reader"),
 make_string (buf, len),
 make_int (base)));
 loser:
 return Fsignal (Qinvalid_read_syntax,
-list3 (build_translated_string
+list3 (build_msg_string
 			 ("Invalid integer constant in reader"),
 make_string (buf, len),
 make_int (base)));
 }
 }
 st = recognized_structure_type (XCAR (list));
 if (!st)
 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
-			     list2 (build_translated_string
+			     list2 (build_msg_string
 				    ("unrecognized structure type"),
 				    XCAR (list))));
 list = Fcdr (list);
 keyword_count = Dynarr_length (st->keywords);
 value = Fcar (list);
 list = Fcdr (list);
 if (!NILP (memq_no_quit (keyword, already_seen)))
 	RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
-				 list2 (build_translated_string
+				 list2 (build_msg_string
 					("structure keyword already seen"),
 					keyword)));
 for (i = 0; i < keyword_count; i++)
 	{
 	    break;
 	}
 if (i == keyword_count)
 	RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
-				   list2 (build_translated_string
+				   list2 (build_msg_string
 					  ("unrecognized structure keyword"),
 					  keyword)));
 if (en->validate && ! (en->validate) (keyword, value, ERROR_ME))
 	RETURN_UNGCPRO
 	  (Fsignal (Qinvalid_read_syntax,
-		    list3 (build_translated_string
+		    list3 (build_msg_string
 			   ("invalid value for structure keyword"),
 			   keyword, value)));
 already_seen = Fcons (keyword, already_seen);
 }
 if (st->validate && ! (st->validate) (orig_list, ERROR_ME))
 RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
-			     list2 (build_translated_string
+			     list2 (build_msg_string
 				    ("invalid structure initializer"),
 				    orig_list)));
 RETURN_UNGCPRO ((st->instantiate) (XCDR (orig_list)));
 }
 	      int speccount = specpdl_depth ();
 	      ++old_backquote_flag;
 	      record_unwind_protect (backquote_unwind,
 				     make_opaque_ptr (&old_backquote_flag));
 	      tem = read0 (readcharfun);
-	      unbind_to (speccount, Qnil);
+	      unbind_to (speccount);
 	      ch = reader_nextchar (readcharfun);
 	      if (ch != ')')
 		{
 		  unreadchar (readcharfun, ch);
 		  return Fsignal (Qinvalid_read_syntax,
-				  list1 (build_string
+				  list1 (build_msg_string
 					 ("Weird old-backquote syntax")));
 		}
 	      return list2 (Qbacktick, tem);
 	    }
 	  case ',':
 		  ch = reader_nextchar (readcharfun);
 		  if (ch != ')')
 		    {
 		      unreadchar (readcharfun, ch);
 		      return Fsignal (Qinvalid_read_syntax,
-				      list1 (build_string
+				      list1 (build_msg_string
 					     ("Weird old-backquote syntax")));
 		    }
 		  return list2 (comma_type, tem);
 		}
 	      else
 		{
 		  unreadchar (readcharfun, ch);
 #if 0
 		  return Fsignal (Qinvalid_read_syntax,
-		       list1 (build_string ("Comma outside of backquote")));
+		       list1 (build_msg_string ("Comma outside of backquote")));
 #else
 		  /* #### - yuck....but this is reverse compatible. */
 		  /* mostly this is required by edebug, which does its own
 		     annotated reading.  We need to have an annotated_read
 		     function that records (with markers) the buffer
 		    }
 		  if (invalid)
 		    RETURN_UNGCPRO
 		      (Fsignal (Qinvalid_read_syntax,
 				list2
-				(build_string ("invalid string property list"),
+				(build_msg_string ("invalid string property list"),
 				 XCDR (plist))));
 		  Fset_text_properties (beg, end, plist, tmp);
 		}
 	      UNGCPRO;
 	      return tmp;
 	  case 's': return read_structure (readcharfun);
 	  case '<':
 	    {
 	      unreadchar (readcharfun, c);
 	      return Fsignal (Qinvalid_read_syntax,
-		    list1 (build_string ("Cannot read unreadable object")));
+		    list1 (build_msg_string ("Cannot read unreadable object")));
 	    }
 #ifdef FEATUREP_SYNTAX
 	  case '+':
 	  case '-':
 	    {
 		  /* #n=object returns object, but associates it with
 		     n for #n#.  */
 		  Lisp_Object obj;
 		  if (CONSP (found))
 		    return Fsignal (Qinvalid_read_syntax,
-				    list2 (build_translated_string
+				    list2 (build_msg_string
 					   ("Multiply defined symbol label"),
 					   make_int (n)));
 		  obj = read0 (readcharfun);
 		  Vread_objects = Fcons (Fcons (make_int (n), obj),
 					 Vread_objects);
 		  /* #n# returns a previously read object.  */
 		  if (CONSP (found))
 		    return XCDR (found);
 		  else
 		    return Fsignal (Qinvalid_read_syntax,
-				    list2 (build_translated_string
+				    list2 (build_msg_string
 					   ("Undefined symbol label"),
 					   make_int (n)));
 		}
 	      return Fsignal (Qinvalid_read_syntax,
 			      list1 (build_string ("#")));
 	int speccount = specpdl_depth ();
 	++new_backquote_flag;
 	record_unwind_protect (backquote_unwind,
 			       make_opaque_ptr (&new_backquote_flag));
 	tem = read0 (readcharfun);
-	unbind_to (speccount, Qnil);
+	unbind_to (speccount);
 	return list2 (Qbackquote, tem);
 }
 case ',':
 {
 /* So that early-early stuff will work */
 Ffset (Qload, intern ("load-internal"));
 #ifdef FEATUREP_SYNTAX
 DEFSYMBOL (Qfeaturep);
-Fprovide(intern("xemacs"));
+Fprovide (intern ("xemacs"));
 #ifdef INFODOCK
-Fprovide(intern("infodock"));
+Fprovide (intern ("infodock"));
 #endif /* INFODOCK */
 #endif /* FEATUREP_SYNTAX */
 #ifdef LISP_BACKQUOTES
 old_backquote_flag = new_backquote_flag = 0;

Mercurial > hg > xemacs-beta

comparison src/lread.c @ 771:943eaba38521