diff src/symbols.c @ 16:0293115a14e9 r19-15b91

Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents ac2d302a0011
children 859a2309aef8
line wrap: on
line diff
--- a/src/symbols.c	Mon Aug 13 08:48:43 2007 +0200
+++ b/src/symbols.c	Mon Aug 13 08:49:20 2007 +0200
@@ -181,8 +181,8 @@
 
   CHECK_STRING (str);
 
-  len = string_length (XSTRING (str));
-  sym = oblookup (obarray, string_data (XSTRING (str)), len);
+  len = XSTRING_LENGTH (str);
+  sym = oblookup (obarray, XSTRING_DATA (str), len);
   if (!INTP (sym))
     /* Found it */
     return sym;
@@ -190,7 +190,7 @@
   ptr = &vector_data (XVECTOR (obarray))[XINT (sym)];
 
   if (purify_flag && ! purified (str))
-    str = make_pure_pname (string_data (XSTRING (str)), len, 0);
+    str = make_pure_pname (XSTRING_DATA (str), len, 0);
   sym = Fmake_symbol (str);
 
   if (SYMBOLP (*ptr))
@@ -216,8 +216,7 @@
 
   CHECK_STRING (str);
 
-  tem = oblookup (obarray, string_data (XSTRING (str)),
-		  string_length (XSTRING (str)));
+  tem = oblookup (obarray, XSTRING_DATA (str), XSTRING_LENGTH (str));
   if (!INTP (tem))
     return tem;
   return Qnil;
@@ -247,8 +246,7 @@
       string = name;
     }
 
-  tem = oblookup (obarray, string_data (XSTRING (string)),
-		  string_length (XSTRING (string)));
+  tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string));
   if (INTP (tem))
     return Qnil;
   /* If arg was a symbol, don't delete anything but that symbol itself.  */
@@ -443,7 +441,9 @@
 
 static void set_up_buffer_local_cache (Lisp_Object sym, 
 				       struct symbol_value_buffer_local *bfwd,
-				       struct buffer *buf);
+				       struct buffer *buf,
+				       Lisp_Object new_alist_el,
+				       int set_it_p);
 
 DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0 /*
 T if SYMBOL's value is not void.
@@ -486,26 +486,22 @@
      type and make nil, t, and all keywords have that same magic
      constant_symbol value.  This test is awfully specific about what is
      constant and what isn't.  --Stig */
-  return (NILP (sym) || EQ (sym, Qt)
-	  || (SYMBOL_VALUE_MAGIC_P (val)
-	      && (XSYMBOL_VALUE_MAGIC_TYPE (val) ==
-		  SYMVAL_CONST_OBJECT_FORWARD ||
-		  XSYMBOL_VALUE_MAGIC_TYPE (val) ==
-		  SYMVAL_CONST_SPECIFIER_FORWARD ||
-		  XSYMBOL_VALUE_MAGIC_TYPE (val) ==
-		  SYMVAL_CONST_FIXNUM_FORWARD ||
-		  XSYMBOL_VALUE_MAGIC_TYPE (val) ==
-		  SYMVAL_CONST_BOOLEAN_FORWARD ||
-		  XSYMBOL_VALUE_MAGIC_TYPE (val) ==
-		  SYMVAL_CONST_CURRENT_BUFFER_FORWARD ||
-		  XSYMBOL_VALUE_MAGIC_TYPE (val) ==
-		  SYMVAL_CONST_SELECTED_CONSOLE_FORWARD))
+  return
+    NILP (sym) ||
+    EQ (sym, Qt) ||
+    (SYMBOL_VALUE_MAGIC_P (val) &&
+     (XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_OBJECT_FORWARD ||
+      XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD ||
+      XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_FIXNUM_FORWARD ||
+      XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_BOOLEAN_FORWARD ||
+      XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_CURRENT_BUFFER_FORWARD ||
+      XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SELECTED_CONSOLE_FORWARD))
 #if 0
-	      /* #### - This is disabled until a new magic symbol_value for
-		 constants is added */
-	      || SYMBOL_IS_KEYWORD (sym)
+    /* #### - This is disabled until a new magic symbol_value for
+       constants is added */
+    || SYMBOL_IS_KEYWORD (sym)
 #endif
-	      );
+    ;
 }
 
 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is
@@ -523,18 +519,13 @@
      : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic));
 
   if (SYMBOL_VALUE_MAGIC_P (val) &&
-      XSYMBOL_VALUE_MAGIC_TYPE (val) ==
-      SYMVAL_CONST_SPECIFIER_FORWARD)
+      XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD)
     signal_simple_error ("Use `set-specifier' to change a specifier's value",
 			 sym);
 
   if (symbol_is_constant (sym, val))
-    {
-      signal_error (Qsetting_constant,
-		    ((UNBOUNDP (newval))
-		     ? list1 (sym)
-		     : list2 (sym, newval)));
-    }
+    signal_error (Qsetting_constant,
+		  UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval));
 }
 
 /* Verify that it's ok to make SYM buffer-local.  This rejects
@@ -1302,9 +1293,11 @@
 static void
 set_up_buffer_local_cache (Lisp_Object sym, 
 			   struct symbol_value_buffer_local *bfwd,
-			   struct buffer *buf)
+			   struct buffer *buf,
+			   Lisp_Object new_alist_el,
+			   int set_it_p)
 {
-  Lisp_Object new_alist_el, new_val;
+  Lisp_Object new_val;
 
   if (!NILP (bfwd->current_buffer)
       && buf == XBUFFER (bfwd->current_buffer))
@@ -1315,7 +1308,10 @@
   write_out_buffer_local_cache (sym, bfwd);
 
   /* Retrieve the new alist element and new value. */
+  if (NILP (new_alist_el)
+      && set_it_p)
   new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
+
   if (NILP (new_alist_el))
     new_val = bfwd->default_value;
   else
@@ -1387,14 +1383,15 @@
 	     will do this.  It doesn't hurt to do it whenever
 	     BUF == current_buffer, so just go ahead and do that. */
 	  if (buf == current_buffer)
-	    set_up_buffer_local_cache (sym, bfwd, buf);
+	    set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0);
 	}
     }
 }
 
 static Lisp_Object
 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
-		     struct console *con, int swap_it_in)
+		     struct console *con, int swap_it_in,
+		     Lisp_Object symcons, int set_it_p)
 {
   Lisp_Object valcontents;
 
@@ -1415,6 +1412,7 @@
 
     case SYMVAL_VARALIAS:
       sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
+      symcons = Qnil;
       /* presto change-o! */
       goto retry;
 
@@ -1426,7 +1424,7 @@
 
 	if (swap_it_in)
 	  {
-	    set_up_buffer_local_cache (sym, bfwd, buf);
+	    set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
 	    valcontents = bfwd->current_value;
 	  }
 	else
@@ -1434,14 +1432,17 @@
 	    if (!NILP (bfwd->current_buffer) &&
 		buf == XBUFFER (bfwd->current_buffer))
 	      valcontents = bfwd->current_value;
-	    else
+	    else if (NILP (symcons))
 	      {
+		if (set_it_p)
 		valcontents = assq_no_quit (sym, buf->local_var_alist);
 		if (NILP (valcontents))
 		  valcontents = bfwd->default_value;
 		else
-		  valcontents = Fcdr (valcontents);
+		  valcontents = XCDR (valcontents);
 	      }
+	    else
+	      valcontents = XCDR (symcons);
 	  }
 	break;
       }
@@ -1476,7 +1477,7 @@
 			      /* If it bombs out at startup due to a
 				 Lisp error, this may be nil. */
 			      CONSOLEP (Vselected_console)
-			      ?	XCONSOLE (Vselected_console) : 0, 0);
+			      ?	XCONSOLE (Vselected_console) : 0, 0, Qnil, 1);
 }
 
 static Lisp_Object
@@ -1489,7 +1490,8 @@
   else
     console = Vselected_console;
 
-  return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0);
+  return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
+			      Qnil, 1);
 }
 
 /* Return the current value of SYM.  The difference between this function
@@ -1516,7 +1518,45 @@
       dev = 0;
     }
 
-  return find_symbol_value_1 (sym, current_buffer, dev, 1);
+  return find_symbol_value_1 (sym, current_buffer, dev, 1, Qnil, 1);
+}
+
+/* This is an optimized function for quick lookup of buffer local symbols
+   by avoiding O(n) search.  This will work when either:
+     a) We have already found the symbol e.g. by traversing local_var_alist.
+   or
+     b) We know that the symbol will not be found in the current buffer's
+        list of local variables.
+   In the former case, find_it_p is 1 and symbol_cons is the element from
+   local_var_alist.  In the latter case, find_it_p is 0 and symbol_cons
+   is the symbol.
+
+   This function is called from set_buffer_internal which does both of these
+   things. */
+
+Lisp_Object
+find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
+{
+  /* WARNING: This function can be called when current_buffer is 0
+     and Vselected_console is Qnil, early in initialization. */
+  struct console *dev;
+  Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
+  
+  CHECK_SYMBOL (sym);
+  if (CONSOLEP (Vselected_console))
+    dev = XCONSOLE (Vselected_console);
+  else
+    {
+      /* This can also get called while we're preparing to shutdown.
+         #### What should really happen in that case?  Should we
+         actually fix things so we can't get here in that case? */
+      assert (!initialized || preparing_for_armageddon);
+      dev = 0;
+    }
+
+  return find_symbol_value_1 (sym, current_buffer, dev, 1,
+			      find_it_p ? symbol_cons : Qnil,
+			      find_it_p);
 }
 
 DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0 /*
@@ -2156,7 +2196,7 @@
 	case SYMVAL_BOOLEAN_FORWARD:
 	case SYMVAL_OBJECT_FORWARD:
 	case SYMVAL_DEFAULT_BUFFER_FORWARD:
-	  set_up_buffer_local_cache (variable, bfwd, current_buffer);
+	  set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
 	  break;
 
 	case SYMVAL_UNBOUND_MARKER:
@@ -2254,7 +2294,7 @@
 	   value of the C variable.  set_up_buffer_local_cache()
 	   will do this.  It doesn't hurt to do it always,
 	   so just go ahead and do that. */
-	set_up_buffer_local_cache (variable, bfwd, current_buffer);
+	set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
       }
       return (variable);
 
@@ -3166,17 +3206,20 @@
 {
   Lisp_Object sym = intern (subr_name (subr));
 
-  /* Check that nobody spazzed */
+#ifdef DEBUG_XEMACS
+  /* Check that nobody spazzed writing a DEFUN. */
+  assert (subr->min_args >= 0);
+  assert (subr->min_args <= SUBR_MAX_ARGS);
+
   if (subr->max_args != MANY && subr->max_args != UNEVALLED)
     {
-      if (subr->max_args > SUBR_MAX_ARGS /* Need to fix eval.c if so */
-	  || subr->max_args < subr->min_args)
-	abort ();
+      /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
+      assert (subr->max_args <= SUBR_MAX_ARGS);
+      assert (subr->min_args <= subr->max_args);
     }
-  if (subr->min_args < 0 || subr->min_args > SUBR_MAX_ARGS)
-    abort ();
-
-  if (!UNBOUNDP (XSYMBOL (sym)->function)) abort ();
+  
+  assert (UNBOUNDP (XSYMBOL (sym)->function));
+#endif /* DEBUG_XEMACS */
 
   XSETSUBR (XSYMBOL (sym)->function, subr);
 }