Mercurial > hg > xemacs-beta
diff src/symbols.c @ 272:c5d627a313b1 r21-0b34
Import from CVS: tag r21-0b34
author | cvs |
---|---|
date | Mon, 13 Aug 2007 10:28:48 +0200 |
parents | 966663fcf606 |
children | 7df0dd720c89 |
line wrap: on
line diff
--- a/src/symbols.c Mon Aug 13 10:27:41 2007 +0200 +++ b/src/symbols.c Mon Aug 13 10:28:48 2007 +0200 @@ -90,12 +90,6 @@ #ifdef LRECORD_SYMBOL -static Lisp_Object mark_symbol (Lisp_Object, void (*) (Lisp_Object)); -extern void print_symbol (Lisp_Object, Lisp_Object, int); -DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol, - mark_symbol, print_symbol, 0, 0, 0, - struct Lisp_Symbol); - static Lisp_Object mark_symbol (Lisp_Object obj, void (*markobj) (Lisp_Object)) { @@ -120,6 +114,9 @@ } } +DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol, + mark_symbol, print_symbol, 0, 0, 0, + struct Lisp_Symbol); #endif /* LRECORD_SYMBOL */ @@ -366,17 +363,15 @@ int hash_string (CONST Bufbyte *ptr, Bytecount len) { - CONST Bufbyte *p = ptr; - int hash = 0, g; - Bytecount count = len; - - while (count-- > 0) + int hash = 0; + + while (len-- > 0) { - hash = (hash << 4) + *p++; - if ((g = (hash & 0xf0000000))) { - hash = hash ^ (g >> 24); - hash = hash ^ g; - } + int g; + hash = (hash << 4) + *ptr++; + g = hash & 0xf0000000; + if (g) + hash = (hash ^ (g >> 24)) ^ g; } return hash & 07777777777; } @@ -388,12 +383,11 @@ int (*fn) (Lisp_Object, void *), void *arg) { REGISTER int i; - Lisp_Object tail; CHECK_VECTOR (obarray); for (i = XVECTOR_LENGTH (obarray) - 1; i >= 0; i--) { - tail = XVECTOR_DATA (obarray)[i]; + Lisp_Object tail = XVECTOR_DATA (obarray)[i]; if (SYMBOLP (tail)) while (1) { @@ -434,7 +428,8 @@ /* Apropos */ /**********************************************************************/ -struct appropos_mapper_closure { +struct appropos_mapper_closure +{ Lisp_Object regexp; Lisp_Object predicate; Lisp_Object accumulation; @@ -444,17 +439,15 @@ apropos_mapper (Lisp_Object symbol, void *arg) { struct appropos_mapper_closure *closure = - (struct appropos_mapper_closure *)arg; - Lisp_Object acceptp = Qt; + (struct appropos_mapper_closure *) arg; Bytecount match = fast_lisp_string_match (closure->regexp, Fsymbol_name (symbol)); - if (match < 0) - acceptp = Qnil; - else if (!NILP (closure->predicate)) - acceptp = call1 (closure->predicate, symbol); - - if (!NILP (acceptp)) + + if (match >= 0 && + (NILP (closure->predicate) || + !NILP (call1 (closure->predicate, symbol)))) closure->accumulation = Fcons (symbol, closure->accumulation); + return 0; } @@ -489,7 +482,7 @@ int set_it_p); DEFUN ("boundp", Fboundp, 1, 1, 0, /* -T if SYMBOL's value is not void. +Return t if SYMBOL's value is not void. */ (sym)) { @@ -498,7 +491,7 @@ } DEFUN ("globally-boundp", Fglobally_boundp, 1, 1, 0, /* -T if SYMBOL has a global (non-bound) value. +Return t if SYMBOL has a global (non-bound) value. This is for the byte-compiler; you really shouldn't be using this. */ (sym)) @@ -508,12 +501,12 @@ } DEFUN ("fboundp", Ffboundp, 1, 1, 0, /* -T if SYMBOL's function definition is not void. +Return t if SYMBOL's function definition is not void. */ (sym)) { CHECK_SYMBOL (sym); - return (UNBOUNDP (XSYMBOL (sym)->function)) ? Qnil : Qt; + return UNBOUNDP (XSYMBOL (sym)->function) ? Qnil : Qt; } /* Return non-zero if SYM's value or function (the current contents of @@ -526,19 +519,25 @@ 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)) - /* We don't return true for keywords here because they are handled + if (EQ (sym, Qnil) || + EQ (sym, Qt)) + return 1; + + if (SYMBOL_VALUE_MAGIC_P (val)) + switch (XSYMBOL_VALUE_MAGIC_TYPE (val)) + { + case SYMVAL_CONST_OBJECT_FORWARD: + case SYMVAL_CONST_SPECIFIER_FORWARD: + case SYMVAL_CONST_FIXNUM_FORWARD: + case SYMVAL_CONST_BOOLEAN_FORWARD: + case SYMVAL_CONST_CURRENT_BUFFER_FORWARD: + case SYMVAL_CONST_SELECTED_CONSOLE_FORWARD: + return 1; + } + + /* We don't return true for keywords here because they are handled specially by reject_constant_symbols(). */ - ; + return 0; } /* We are setting SYM's value slot (or function slot, if FUNCTION_P is @@ -578,23 +577,25 @@ { Lisp_Object val = fetch_value_maybe_past_magic (sym, follow_past_lisp_magic); - if (symbol_is_constant (sym, val) || - (SYMBOL_VALUE_MAGIC_P (val) && - XSYMBOL_VALUE_MAGIC_TYPE (val) == - SYMVAL_DEFAULT_BUFFER_FORWARD) || - (SYMBOL_VALUE_MAGIC_P (val) && - XSYMBOL_VALUE_MAGIC_TYPE (val) == - SYMVAL_DEFAULT_CONSOLE_FORWARD) || - /* #### It's theoretically possible for it to be reasonable - to have both console-local and buffer-local variables, - but I don't want to consider that right now. */ - (SYMBOL_VALUE_MAGIC_P (val) && - XSYMBOL_VALUE_MAGIC_TYPE (val) == - SYMVAL_SELECTED_CONSOLE_FORWARD) - ) - signal_error (Qerror, - list2 (build_string ("Symbol may not be buffer-local"), - sym)); + if (symbol_is_constant (sym, val)) + goto not_ok; + if (SYMBOL_VALUE_MAGIC_P (val)) + switch (XSYMBOL_VALUE_MAGIC_TYPE (val)) + { + case SYMVAL_DEFAULT_BUFFER_FORWARD: + case SYMVAL_DEFAULT_CONSOLE_FORWARD: + /* #### It's theoretically possible for it to be reasonable + to have both console-local and buffer-local variables, + but I don't want to consider that right now. */ + case SYMVAL_SELECTED_CONSOLE_FORWARD: + goto not_ok; + } + + return; + + not_ok: + signal_error (Qerror, + list2 (build_string ("Symbol may not be buffer-local"), sym)); } DEFUN ("makunbound", Fmakunbound, 1, 1, 0, /* @@ -618,7 +619,7 @@ } DEFUN ("symbol-function", Fsymbol_function, 1, 1, 0, /* -Return SYMBOL's function definition. Error if that is void. +Return SYMBOL's function definition. Error if that is void. */ (symbol)) { @@ -891,40 +892,6 @@ symbol to operate on. */ -static Lisp_Object mark_symbol_value_buffer_local (Lisp_Object, - void (*) (Lisp_Object)); -static Lisp_Object mark_symbol_value_lisp_magic (Lisp_Object, - void (*) (Lisp_Object)); -static Lisp_Object mark_symbol_value_varalias (Lisp_Object, - void (*) (Lisp_Object)); - -DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward", - symbol_value_forward, - this_one_is_unmarkable, - print_symbol_value_magic, 0, 0, 0, - struct symbol_value_forward); - -DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local", - symbol_value_buffer_local, - mark_symbol_value_buffer_local, - print_symbol_value_magic, - 0, 0, 0, - struct symbol_value_buffer_local); - -DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic", - symbol_value_lisp_magic, - mark_symbol_value_lisp_magic, - print_symbol_value_magic, - 0, 0, 0, - struct symbol_value_lisp_magic); - -DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias", - symbol_value_varalias, - mark_symbol_value_varalias, - print_symbol_value_magic, - 0, 0, 0, - struct symbol_value_varalias); - static Lisp_Object mark_symbol_value_buffer_local (Lisp_Object obj, void (*markobj) (Lisp_Object)) @@ -978,11 +945,37 @@ Lisp_Object printcharfun, int escapeflag) { char buf[200]; - sprintf (buf, "#<INTERNAL EMACS BUG (symfwd %d) 0x%p>", - XSYMBOL_VALUE_MAGIC_TYPE (obj), (void *) XPNTR (obj)); + sprintf (buf, "#<INTERNAL EMACS BUG (%s type %d) 0x%p>", + XRECORD_LHEADER_IMPLEMENTATION (obj)->name, + XSYMBOL_VALUE_MAGIC_TYPE (obj), + (void *) XPNTR (obj)); write_c_string (buf, printcharfun); } +DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward", + symbol_value_forward, + this_one_is_unmarkable, + print_symbol_value_magic, 0, 0, 0, + struct symbol_value_forward); + +DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local", + symbol_value_buffer_local, + mark_symbol_value_buffer_local, + print_symbol_value_magic, 0, 0, 0, + struct symbol_value_buffer_local); + +DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic", + symbol_value_lisp_magic, + mark_symbol_value_lisp_magic, + print_symbol_value_magic, 0, 0, 0, + struct symbol_value_lisp_magic); + +DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias", + symbol_value_varalias, + mark_symbol_value_varalias, + print_symbol_value_magic, 0, 0, 0, + struct symbol_value_varalias); + /* Getting and setting values of symbols */ @@ -1867,7 +1860,7 @@ } DEFUN ("default-boundp", Fdefault_boundp, 1, 1, 0, /* -Return T if SYMBOL has a non-void default value. +Return t if SYMBOL has a non-void default value. This is the value that is seen in buffers that do not have their own values for this variable. */ @@ -2058,7 +2051,7 @@ struct symbol_value_buffer_local *bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local, lrecord_symbol_value_buffer_local); - Lisp_Object foo = Qnil; + Lisp_Object foo; bfwd->magic.type = SYMVAL_BUFFER_LOCAL; bfwd->default_value = find_symbol_value (variable); @@ -2083,11 +2076,12 @@ if (UNBOUNDP (valcontents)) Fset (variable, Qnil); #endif - return (variable); + return variable; } } -DEFUN ("make-local-variable", Fmake_local_variable, 1, 1, "vMake Local Variable: ", /* +DEFUN ("make-local-variable", Fmake_local_variable, 1, 1, + "vMake Local Variable: ", /* Make VARIABLE have a separate value in the current buffer. Other buffers will continue to share a common default value. \(The buffer-local value of VARIABLE starts out as the same value @@ -2239,7 +2233,8 @@ return variable; } -DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1, "vKill Local Variable: ", /* +DEFUN ("kill-local-variable", Fkill_local_variable, 1, 1, + "vKill Local Variable: ", /* Make VARIABLE no longer have a separate value in the current buffer. From now on the default value will apply in this buffer. */ @@ -2331,7 +2326,8 @@ } -DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1, "vKill Console Local Variable: ", /* +DEFUN ("kill-console-local-variable", Fkill_console_local_variable, 1, 1, + "vKill Console Local Variable: ", /* Make VARIABLE no longer have a separate value in the selected console. From now on the default value will apply in this console. */ @@ -3021,7 +3017,7 @@ until the alias is removed, at which point it will be restored. Currently VARIABLE cannot be a built-in variable, a variable that has a buffer-local value in any buffer, or the symbols nil or t. -(ALIAS, however, can be any type of variable.) +\(ALIAS, however, can be any type of variable.) */ (variable, alias)) { @@ -3143,10 +3139,20 @@ void init_symbols_once_early (void) { +#ifndef Qzero + Qzero = make_int (0); /* Only used if Lisp_Object is a union type */ +#endif + +#ifndef Qnull_pointer + /* C guarantees that Qnull_pointer will be initialized to all 0 bits, + so the following is a actually a no-op. */ + XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0); +#endif + /* see comment in Fpurecopy() */ Vpure_uninterned_symbol_table = make_lisp_hashtable (50, HASHTABLE_NONWEAK, HASHTABLE_EQ); - staticpro(&Vpure_uninterned_symbol_table); + staticpro (&Vpure_uninterned_symbol_table); Qnil = Fmake_symbol (make_pure_pname ((CONST Bufbyte *) "nil", 3, 1)); /* Bootstrapping problem: Qnil isn't set when make_pure_pname is @@ -3155,28 +3161,13 @@ XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */ XSYMBOL (Qnil)->plist = Qnil; -#ifndef Qzero - Qzero = make_int (0); /* Only used if Lisp_Object is a union type */ -#endif - -#ifndef Qnull_pointer - Qnull_pointer.ui = 0; -#endif - Vobarray = make_vector (OBARRAY_SIZE, Qzero); initial_obarray = Vobarray; staticpro (&initial_obarray); /* Intern nil in the obarray */ { - /* These locals are to kludge around a pyramid compiler bug. */ - int hash; - Lisp_Object *tem; - - hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3); - /* Separate statement here to avoid VAXC bug. */ - hash %= OBARRAY_SIZE; - tem = &XVECTOR_DATA (Vobarray)[hash]; - *tem = Qnil; + int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3); + XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil; XSYMBOL (Qnil)->obarray = Qt; } @@ -3343,8 +3334,7 @@ /* Create and initialize a variable whose value is forwarded to C data */ void -defvar_mumble (CONST char *namestring, - CONST void *magic, int sizeof_magic) +defvar_mumble (CONST char *namestring, CONST void *magic, size_t sizeof_magic) { Lisp_Object kludge; Lisp_Object sym = Fintern (make_pure_pname ((CONST Bufbyte *) namestring,