Mercurial > hg > xemacs-beta
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); }