diff src/lread.c @ 173:8eaf7971accc r20-3b13

Import from CVS: tag r20-3b13
author cvs
date Mon, 13 Aug 2007 09:49:09 +0200
parents 3bb7ccffb0c0
children bfd6434d15b3
line wrap: on
line diff
--- a/src/lread.c	Mon Aug 13 09:47:55 2007 +0200
+++ b/src/lread.c	Mon Aug 13 09:49:09 2007 +0200
@@ -63,7 +63,7 @@
    this silliness. */
 static int new_backquote_flag, old_backquote_flag;
 Lisp_Object Qbackquote, Qbacktick, Qcomma, Qcomma_at, Qcomma_dot;
-#endif 
+#endif
 Lisp_Object Qvariable_domain;	/* I18N3 */
 Lisp_Object Vvalues, Vstandard_input, Vafter_load_alist;
 Lisp_Object Qcurrent_load_list;
@@ -229,7 +229,7 @@
     {
       Emchar c;
       struct buffer *b = XBUFFER (readcharfun);
- 
+
       if (!BUFFER_LIVE_P (b))
         error ("Reading from killed buffer");
 
@@ -342,7 +342,7 @@
 
 
 
-static void readevalloop (Lisp_Object readcharfun, 
+static void readevalloop (Lisp_Object readcharfun,
                           Lisp_Object sourcefile,
                           Lisp_Object (*evalfun) (Lisp_Object),
                           int printflag);
@@ -392,12 +392,12 @@
 void
 ebolify_bytecode_constants (Lisp_Object vector)
 {
-  int len = vector_length (XVECTOR (vector));
+  int len = XVECTOR_LENGTH (vector);
   int i;
 
   for (i = 0; i < len; i++)
     {
-      Lisp_Object el = vector_data (XVECTOR (vector))[i];
+      Lisp_Object el = XVECTOR_DATA (vector)[i];
 
       /* We don't check for `eq', `equal', and the others that have
 	 bytecode opcodes.  This might lose if someone passes #'eq or
@@ -420,7 +420,7 @@
 	el = Qold_rassq;
       if (EQ (el, Qrassoc))
 	el = Qold_rassoc;
-      vector_data (XVECTOR (vector))[i] = el;
+      XVECTOR_DATA (vector)[i] = el;
     }
 }
 
@@ -605,7 +605,7 @@
       char *foundstr;
       int foundlen;
 
-      fd = locate_file (Vload_path, file, 
+      fd = locate_file (Vload_path, file,
                         ((!NILP (nosuffix)) ? "" :
 			 load_ignore_elc_files ? ".el:" :
 			 ".elc:.el:"),
@@ -760,7 +760,7 @@
       }
     else
       load_byte_code_version = 100; /* no Ebolification needed */
-	    
+
     readevalloop (lispstream, file, Feval, 0);
 #ifdef MULE
     if (!NILP (used_codesys))
@@ -803,7 +803,7 @@
 
   if (!noninteractive)
     PRINT_LOADING_MESSAGE ("done");
-    
+
   UNGCPRO;
   return Qt;
 }
@@ -852,7 +852,7 @@
     }
   if (!(NILP (mode) || (INTP (mode) && XINT (mode) >= 0)))
     mode = wrong_type_argument (Qnatnump, mode);
-  locate_file (path_list, filename, 
+  locate_file (path_list, filename,
                ((NILP (suffixes)) ? "" :
 		(char *) (XSTRING_DATA (suffixes))),
 	       &tp, (NILP (mode) ? R_OK : XINT (mode)));
@@ -925,22 +925,22 @@
   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), 
+      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)
@@ -954,35 +954,35 @@
 #else
 	    fd = open (fn, O_RDONLY, 0);
 #endif
-	  
+
 	  if (fd >= 0)
 	    {
 	      /* We succeeded; return this descriptor and filename.  */
 	      if (storeptr)
 		*storeptr = build_string (fn);
 	      UNGCPRO;
-	      
+
 /* XXX FIX ME
    Not sure about this on NT yet.  Do nothing for now.
    --marcpa */
-#ifndef DOS_NT	      
+#ifndef DOS_NT
 	      /* 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;
 }
@@ -1015,7 +1015,7 @@
       if (absolute)
 	break;
     }
-  
+
   UNGCPRO;
   return -1;
 }
@@ -1031,26 +1031,26 @@
   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)
@@ -1221,7 +1221,7 @@
 
 	  /*  If we're loading, remove it. */
 	  if (loading)
-	    {	  
+	    {
 	      if (NILP (prev))
 		Vload_history = Fcdr (tail);
 	      else
@@ -1275,7 +1275,7 @@
 #endif /* 0 */
 
 static void
-readevalloop (Lisp_Object readcharfun, 
+readevalloop (Lisp_Object readcharfun,
               Lisp_Object sourcename,
               Lisp_Object (*evalfun) (Lisp_Object),
               int printflag)
@@ -1483,9 +1483,9 @@
 #ifndef standalone
   if (EQ (stream, Qread_char))
     {
-      Lisp_Object val = call1 (Qread_from_minibuffer, 
+      Lisp_Object val = call1 (Qread_from_minibuffer,
 			       build_translated_string ("Lisp expression: "));
-      return (Fcar (Fread_from_string (val, Qnil, Qnil)));
+      return Fcar (Fread_from_string (val, Qnil, Qnil));
     }
 #endif
 
@@ -1539,12 +1539,12 @@
 {  /* used as unwind-protect function in read0() */
   int *counter = (int *) get_opaque_ptr (ptr);
   if (--*counter < 0)
-    *counter = 0;  
+    *counter = 0;
   free_opaque_ptr (ptr);
   return Qnil;
 }
 
-#endif 
+#endif
 
 /* Use this for recursive reads, in contexts where internal tokens
    are not allowed.  See also read1(). */
@@ -1600,10 +1600,10 @@
 #define hyper_modifier (0x100000)
 #define shift_modifier (0x200000)
 /* fsf uses a different modifiers for meta and control.  Possibly
-   byte_compiled code will still work fsfmacs, though... --Stig 
+   byte_compiled code will still work fsfmacs, though... --Stig
 
    #define ctl_modifier   (0x400000)
-   #define meta_modifier  (0x800000)	
+   #define meta_modifier  (0x800000)
 */
 #define FSF_LOSSAGE(mask)						\
       if (puke_on_fsf_keys || ((c = readchar (readcharfun)) != '-'))	\
@@ -1637,8 +1637,8 @@
       if (c == '?')
 	return 0177;
       else
-        return (c & (0200 | 037));
-      
+        return c & (0200 | 037);
+
     case '0':
     case '1':
     case '2':
@@ -1733,7 +1733,7 @@
   Lstream_put_emchar (XLSTREAM (Vread_buffer_stream), 0);
   Lstream_flush (XLSTREAM (Vread_buffer_stream));
 
-  return (Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1);
+  return Lstream_byte_count (XLSTREAM (Vread_buffer_stream)) - 1;
 }
 
 static Lisp_Object parse_integer (CONST Bufbyte *buf, Bytecount len, int base);
@@ -1788,10 +1788,10 @@
 		  number = atol (read_buffer);
 		else
 		  abort ();
-		return (make_int (number));
+		return make_int (number);
 	      }
 #else
-              return (parse_integer ((Bufbyte *) read_ptr, len, 10));
+              return parse_integer ((Bufbyte *) read_ptr, len, 10);
 #endif
 	    }
 	}
@@ -1804,7 +1804,7 @@
   {
     Lisp_Object sym;
     if (uninterned_symbol)
-      sym = (Fmake_symbol ((purify_flag) 
+      sym = (Fmake_symbol ((purify_flag)
 			   ? make_pure_pname ((Bufbyte *) read_ptr, len, 0)
 			   : make_string ((Bufbyte *) read_ptr, len)));
     else
@@ -1820,7 +1820,7 @@
 	   have packages and then this will be reworked.  --Stig. */
 	XSYMBOL (sym)->value = sym;
       }
-    return (sym);
+    return sym;
   }
 }
 
@@ -1859,7 +1859,7 @@
 	c = c - 'a' + 10;
       else
 	goto loser;
-    
+
       if (c < 0 || c >= base)
 	goto loser;
 
@@ -1875,16 +1875,16 @@
       goto overflow;
     if (XINT (result) != ((negativland) ? -num : num))
       goto overflow;
-    return (result);
+    return result;
   }
  overflow:
-  return Fsignal (Qinvalid_read_syntax, 
+  return Fsignal (Qinvalid_read_syntax,
                   list3 (build_translated_string
 			 ("Integer constant overflow in reader"),
                          make_string (buf, len),
                          make_int (base)));
  loser:
-  return Fsignal (Qinvalid_read_syntax, 
+  return Fsignal (Qinvalid_read_syntax,
                   list3 (build_translated_string
 			 ("Invalid integer constant in reader"),
                          make_string (buf, len),
@@ -1984,6 +1984,7 @@
   Lisp_Object list = Qnil;
   Lisp_Object orig_list = Qnil;
   Lisp_Object already_seen = Qnil;
+  int keyword_count;
   struct structure_type *st;
   struct gcpro gcpro1, gcpro2;
 
@@ -2002,44 +2003,41 @@
 	(continuable_syntax_error
 	 ("structures must have alternating keyword/value pairs"));
   }
-  
+
   st = recognized_structure_type (XCAR (list));
   if (!st)
-    {
-      RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
-			       list2 (build_translated_string
-				      ("unrecognized structure type"),
-				      XCAR (list))));
-    }
+    RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
+			     list2 (build_translated_string
+				    ("unrecognized structure type"),
+				    XCAR (list))));
 
   list = Fcdr (list);
+  keyword_count = Dynarr_length (st->keywords);
   while (!NILP (list))
     {
       Lisp_Object keyword, value;
       int i;
-      struct structure_keyword_entry *en;
-      
+      struct structure_keyword_entry *en = NULL;
+
       keyword = Fcar (list);
       list = Fcdr (list);
       value = Fcar (list);
       list = Fcdr (list);
-      
+
       if (!NILP (memq_no_quit (keyword, already_seen)))
-	{
-	  RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
-				   list2 (build_translated_string
-					  ("structure keyword already seen"),
-					  keyword)));
-	}
-
-      for (i = 0; i < Dynarr_length (st->keywords); i++)
+	RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
+				 list2 (build_translated_string
+					("structure keyword already seen"),
+					keyword)));
+
+      for (i = 0; i < keyword_count; i++)
 	{
 	  en = Dynarr_atp (st->keywords, i);
 	  if (EQ (keyword, en->keyword))
 	    break;
 	}
 
-      if (i == Dynarr_length (st->keywords))
+      if (i == keyword_count)
 	RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
 				   list2 (build_translated_string
 					  ("unrecognized structure keyword"),
@@ -2056,14 +2054,13 @@
     }
 
   if (st->validate && ! (st->validate) (orig_list, ERROR_ME))
-    RETURN_UNGCPRO
-      (Fsignal (Qinvalid_read_syntax,
-		list2 (build_translated_string
-		       ("invalid structure initializer"),
-		       orig_list)));
+    RETURN_UNGCPRO (Fsignal (Qinvalid_read_syntax,
+			     list2 (build_translated_string
+				    ("invalid structure initializer"),
+				    orig_list)));
 
   RETURN_UNGCPRO ((st->instantiate) (XCDR (orig_list)));
-}  
+}
 
 
 static Lisp_Object read_compiled_function (Lisp_Object readcharfun,
@@ -2097,7 +2094,7 @@
 	/* Ignore whitespace and control characters */
 	if (c <= 040)
 	  goto retry;
-	return (c);
+	return c;
       }
 
     case ';':
@@ -2114,10 +2111,7 @@
 static Lisp_Object
 list2_pure (int pure, Lisp_Object a, Lisp_Object b)
 {
-  if (pure)
-    return (pure_cons (a, pure_cons (b, Qnil)));
-  else
-    return (list2 (a, b));
+  return pure ? pure_cons (a, pure_cons (b, Qnil)) : list2 (a, b);
 }
 #endif
 
@@ -2126,7 +2120,7 @@
    encountered a misplaced token (e.g. a right bracket, right paren,
    or dot followed by a non-number).  To filter this stuff out,
    use read0(). */
-  
+
 static Lisp_Object
 read1 (Lisp_Object readcharfun)
 {
@@ -2213,12 +2207,12 @@
 	return read_list (readcharfun, ')', 1, 1);
       }
     case '[':
-      return (read_vector (readcharfun, ']'));
+      return read_vector (readcharfun, ']');
 
     case ')':
     case ']':
       /* #### - huh? these don't do what they seem... */
-      return (noseeum_cons (Qunbound, make_char (c)));
+      return noseeum_cons (Qunbound, make_char (c));
     case '.':
       {
 #ifdef LISP_FLOAT_TYPE
@@ -2231,17 +2225,17 @@
 
 	/* Can't use isdigit on Emchars */
 	if (c < '0' || c > '9')
-	  return (noseeum_cons (Qunbound, make_char ('.')));
+	  return noseeum_cons (Qunbound, make_char ('.'));
 
 	/* Note that read_atom will loop
 	   at least once, assuring that we will not try to UNREAD
            two characters in a row.
 	   (I think this doesn't matter anymore because there should
 	   be no more danger in unreading multiple characters) */
-        return (read_atom (readcharfun, '.', 0));
+        return read_atom (readcharfun, '.', 0);
 
 #else /* ! LISP_FLOAT_TYPE */
-	return (noseeum_cons (Qunbound, make_char ('.')));
+	return noseeum_cons (Qunbound, make_char ('.'));
 #endif /* ! LISP_FLOAT_TYPE */
       }
 
@@ -2258,18 +2252,18 @@
 #endif
             /* "#["-- byte-code constant syntax */
             /* purecons #[...] syntax */
-	  case '[': return (read_compiled_function (readcharfun, ']'
-                                                    /*, purify_flag */ ));
+	  case '[': return read_compiled_function (readcharfun, ']'
+						   /*, purify_flag */ );
             /* "#:"-- quasi-implemented gensym syntax */
-	  case ':': return (read_atom (readcharfun, -1, 1));
+	  case ':': return read_atom (readcharfun, -1, 1);
             /* #'x => (function x) */
-	  case '\'': return (list2 (Qfunction, read0 (readcharfun)));
+	  case '\'': return list2 (Qfunction, read0 (readcharfun));
 #if 0
 	    /* RMS uses this syntax for fat-strings.
 	       If we use it for vectors, then obscure bugs happen.
 	     */
             /* "#(" -- Scheme/CL vector syntax */
-	  case '(': return (read_vector (readcharfun, ')'));
+	  case '(': return read_vector (readcharfun, ')');
 #endif
 #if 0 /* FSFmacs */
 	  case '(':
@@ -2283,8 +2277,8 @@
 		{
 		  if (CONSP (tmp) && UNBOUNDP (XCAR (tmp)))
 		    free_cons (XCONS (tmp));
-		  return (Fsignal (Qinvalid_read_syntax,
-				   list1 (build_string ("#"))));
+		  return Fsignal (Qinvalid_read_syntax,
+				   list1 (build_string ("#")));
 		}
 	      GCPRO1 (tmp);
 	      /* Read the intervals and their properties.  */
@@ -2293,7 +2287,7 @@
 		  Lisp_Object beg, end, plist;
 		  Emchar ch;
 		  int invalid = 0;
-		  
+
 		  beg = read1 (readcharfun);
 		  if (CONSP (beg) && UNBOUNDP (XCAR (beg)))
 		    {
@@ -2360,15 +2354,15 @@
 	    }
 	  case '$': return Vload_file_name_internal;
             /* bit vectors */
-	  case '*': return (read_bit_vector (readcharfun));
+	  case '*': return read_bit_vector (readcharfun);
             /* #o10 => 8 -- octal constant syntax */
-	  case 'o': return (read_integer (readcharfun, 8));
+	  case 'o': return read_integer (readcharfun, 8);
             /* #xdead => 57005 -- hex constant syntax */
-	  case 'x': return (read_integer (readcharfun, 16));
+	  case 'x': return read_integer (readcharfun, 16);
             /* #b010 => 2 -- binary constant syntax */
-	  case 'b': return (read_integer (readcharfun, 2));
+	  case 'b': return read_integer (readcharfun, 2);
             /* #s(foobar key1 val1 key2 val2) -- structure syntax */
-	  case 's': return (read_structure (readcharfun));
+	  case 's': return read_structure (readcharfun);
 	  case '<':
 	    {
 	      unreadchar (readcharfun, c);
@@ -2449,7 +2443,7 @@
 	       future, then commas should be invalid read syntax
 	       outside of backquotes anywhere they're found (i.e.
 	       they must be quoted in symbols) -- Stig */
-	    return (read_atom (readcharfun, c, 0));
+	    return read_atom (readcharfun, c, 0);
 	  }
       }
 #endif
@@ -2463,7 +2457,7 @@
 
 	if (c == '\\')
 	  c = read_escape (readcharfun);
-	return (make_char (c));
+	return make_char (c);
       }
 
     case '\"':
@@ -2501,7 +2495,7 @@
 	   return zero instead.  This is for doc strings
 	   that we are really going to find in lib-src/DOC.nn.nn  */
 	if (purify_flag && NILP (Vdoc_file_name) && cancel)
-	  return (Qzero);
+	  return Qzero;
 
 	Lstream_flush (XLSTREAM (Vread_buffer_stream));
 #if 0 /* FSFmacs defun hack */
@@ -2523,7 +2517,7 @@
 	/* Ignore whitespace and control characters */
 	if (c <= 040)
 	  goto retry;
-	return (read_atom (readcharfun, c, 0));
+	return read_atom (readcharfun, c, 0);
       }
     }
 }
@@ -2543,7 +2537,7 @@
 {
   int state = 0;
   CONST Bufbyte *ucp = (CONST Bufbyte *) cp;
-  
+
   if (*ucp == '+' || *ucp == '-')
     ucp++;
 
@@ -2605,7 +2599,7 @@
       ch = reader_nextchar (readcharfun);
 
       if (ch == terminator)
-	return (state);
+	return state;
       else
 	unreadchar (readcharfun, ch);
 #ifdef FEATUREP_SYNTAX
@@ -2619,7 +2613,7 @@
 }
 
 
-struct read_list_state 
+struct read_list_state
   {
     Lisp_Object head;
     Lisp_Object tail;
@@ -2640,7 +2634,7 @@
     {
       Lisp_Object tem = elt;
       Emchar ch;
-      
+
       elt = XCDR (elt);
       free_cons (XCONS (tem));
       tem = Qnil;
@@ -2708,7 +2702,7 @@
   s->tail = elt;
  done:
   s->length++;
-  return (s);
+  return s;
 }
 
 
@@ -2809,9 +2803,9 @@
 	    }
 	}
     }
-	  
+
   UNGCPRO;
-  return (s.head);
+  return s.head;
 }
 
 static Lisp_Object
@@ -2831,7 +2825,7 @@
   s.length = 0;
   s.allow_dotted_lists = 0;
   GCPRO2 (s.head, s.tail);
-  
+
   (void) sequence_reader (readcharfun,
                           terminator,
                           &s,
@@ -2847,7 +2841,7 @@
 #endif
     s.head = make_vector (len, Qnil);
 
-  for (i = 0, p = &(vector_data (XVECTOR (s.head))[0]);
+  for (i = 0, p = &(XVECTOR_DATA (s.head)[0]);
        i < len;
        i++, p++)
   {
@@ -2862,13 +2856,13 @@
     tem = otem->cdr;
     free_cons (otem);
   }
-  return (s.head);
+  return s.head;
 }
 
 static Lisp_Object
 read_compiled_function (Lisp_Object readcharfun, Emchar terminator)
 {
-  /* Accept compiled functions at read-time so that we don't 
+  /* Accept compiled functions at read-time so that we don't
      have to build them at load-time. */
   Lisp_Object stuff;
   Lisp_Object make_byte_code_args[COMPILED_DOMAIN + 1];
@@ -2941,7 +2935,7 @@
    handle things. */
 #if 0
 #ifndef WINDOWSNT
-  /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is 
+  /* When Emacs is invoked over network shares on NT, PATH_LOADSEARCH is
      almost never correct, thereby causing a warning to be printed out that 
      confuses users.  Since PATH_LOADSEARCH is always overriden by the
      EMACSLOADPATH environment variable below, disable the warning on NT.  */