X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;ds=sidebyside;f=src%2Fsymbols.c;h=01a6c36b7ecf98a12da07296c6c6b81d0ebf7982;hb=a71e0987b7080176e0046b0b0ed72a9a70e2571d;hp=8c70d026d084a80bb3363e3390a3e14b6d8cef99;hpb=f3ec20f455f3f1212d2c5ee4cadc984330da9c38;p=chise%2Fxemacs-chise.git.1 diff --git a/src/symbols.c b/src/symbols.c index 8c70d02..01a6c36 100644 --- a/src/symbols.c +++ b/src/symbols.c @@ -58,6 +58,8 @@ Boston, MA 02111-1307, USA. */ #include "console.h" #include "elhash.h" +#include + Lisp_Object Qad_advice_info, Qad_activate; Lisp_Object Qget_value, Qset_value, Qbound_predicate, Qmake_unbound; @@ -86,8 +88,6 @@ static Lisp_Object follow_varalias_pointers (Lisp_Object symbol, Lisp_Object follow_past_lisp_magic); -#ifdef LRECORD_SYMBOL - static Lisp_Object mark_symbol (Lisp_Object obj, void (*markobj) (Lisp_Object)) { @@ -96,8 +96,6 @@ mark_symbol (Lisp_Object obj, void (*markobj) (Lisp_Object)) markobj (sym->value); markobj (sym->function); - /* No need to mark through ->obarray, because it only holds nil or t. */ - /* markobj (sym->obarray);*/ XSETSTRING (pname, sym->name); markobj (pname); if (!symbol_next (sym)) @@ -112,10 +110,13 @@ mark_symbol (Lisp_Object obj, void (*markobj) (Lisp_Object)) } } +static const struct lrecord_description symbol_description[] = { + { XD_LISP_OBJECT, offsetof(struct Lisp_Symbol, next), 5 } +}; + DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol, mark_symbol, print_symbol, 0, 0, 0, - struct Lisp_Symbol); -#endif /* LRECORD_SYMBOL */ + symbol_description, struct Lisp_Symbol); /**********************************************************************/ @@ -161,10 +162,7 @@ intern (CONST char *str) return tem; } - return Fintern ((purify_flag - ? make_pure_pname (buf, len, 0) - : make_string (buf, len)), - obarray); + return Fintern (make_string (buf, len), obarray); } DEFUN ("intern", Fintern, 1, 2, 0, /* @@ -175,7 +173,8 @@ it defaults to the value of `obarray'. */ (string, obarray)) { - Lisp_Object sym, *ptr; + Lisp_Object object, *ptr; + struct Lisp_Symbol *symbol; Bytecount len; if (NILP (obarray)) obarray = Vobarray; @@ -184,52 +183,64 @@ it defaults to the value of `obarray'. CHECK_STRING (string); len = XSTRING_LENGTH (string); - sym = oblookup (obarray, XSTRING_DATA (string), len); - if (!INTP (sym)) + object = oblookup (obarray, XSTRING_DATA (string), len); + if (!INTP (object)) /* Found it */ - return sym; - - ptr = &XVECTOR_DATA (obarray)[XINT (sym)]; + return object; - if (purify_flag && ! purified (string)) - string = make_pure_pname (XSTRING_DATA (string), len, 0); - sym = Fmake_symbol (string); - /* FSFmacs places OBARRAY here, but it is pointless because we do - not mark through this slot, so it is not usable later (because - the obarray might have been collected). Marking through the - ->obarray slot is an even worse idea, because it would keep - obarrays from being collected because of symbols pointed to them. + ptr = &XVECTOR_DATA (obarray)[XINT (object)]; - NOTE: We place Qt here only if OBARRAY is actually Vobarray. It - is safer to do it this way, to avoid hosing with symbols within - pure objects. */ - if (EQ (obarray, Vobarray)) - XSYMBOL (sym)->obarray = Qt; + object = Fmake_symbol (string); + symbol = XSYMBOL (object); if (SYMBOLP (*ptr)) - symbol_next (XSYMBOL (sym)) = XSYMBOL (*ptr); + symbol_next (symbol) = XSYMBOL (*ptr); else - symbol_next (XSYMBOL (sym)) = 0; - *ptr = sym; - return sym; + symbol_next (symbol) = 0; + *ptr = object; + + if (string_byte (symbol_name (symbol), 0) == ':' && EQ (obarray, Vobarray)) + { + /* The LISP way is to put keywords in their own package, but we + don't have packages, so we do something simpler. Someday, + maybe we'll have packages and then this will be reworked. + --Stig. */ + symbol_value (symbol) = object; + } + + return object; } DEFUN ("intern-soft", Fintern_soft, 1, 2, 0, /* -Return the canonical symbol whose name is STRING, or nil if none exists. +Return the canonical symbol named NAME, or nil if none exists. +NAME may be a string or a symbol. If it is a symbol, that exact +symbol is searched for. A second optional argument specifies the obarray to use; it defaults to the value of `obarray'. */ - (string, obarray)) + (name, obarray)) { + /* #### Bug! (intern-soft "nil") returns nil. Perhaps we should + add a DEFAULT-IF-NOT-FOUND arg, like in get. */ Lisp_Object tem; + struct Lisp_String *string; if (NILP (obarray)) obarray = Vobarray; obarray = check_obarray (obarray); - CHECK_STRING (string); + if (!SYMBOLP (name)) + { + CHECK_STRING (name); + string = XSTRING (name); + } + else + string = symbol_name (XSYMBOL (name)); - tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string)); - return !INTP (tem) ? tem : Qnil; + tem = oblookup (obarray, string_data (string), string_length (string)); + if (INTP (tem) || (SYMBOLP (name) && !EQ (name, tem))) + return Qnil; + else + return tem; } DEFUN ("unintern", Funintern, 1, 2, 0, /* @@ -241,21 +252,22 @@ OBARRAY defaults to the value of the variable `obarray' */ (name, obarray)) { - Lisp_Object string, tem; + Lisp_Object tem; + struct Lisp_String *string; int hash; if (NILP (obarray)) obarray = Vobarray; obarray = check_obarray (obarray); if (SYMBOLP (name)) - XSETSTRING (string, XSYMBOL (name)->name); + string = symbol_name (XSYMBOL (name)); else { CHECK_STRING (name); - string = name; + string = XSTRING (name); } - tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string)); + tem = oblookup (obarray, string_data (string), string_length (string)); if (INTP (tem)) return Qnil; /* If arg was a symbol, don't delete anything but that symbol itself. */ @@ -287,7 +299,6 @@ OBARRAY defaults to the value of the variable `obarray' } } } - XSYMBOL (tem)->obarray = Qnil; return Qt; } @@ -310,11 +321,6 @@ oblookup (Lisp_Object obarray, CONST Bufbyte *ptr, Bytecount size) obarray = check_obarray (obarray); obsize = XVECTOR_LENGTH (obarray); } -#if 0 /* FSFmacs */ - /* #### Huh? */ - /* This is sometimes needed in the middle of GC. */ - obsize &= ~ARRAY_MARK_FLAG; -#endif hash = hash_string (ptr, size) % obsize; oblookup_last_bucket_number = hash; bucket = XVECTOR_DATA (obarray)[hash]; @@ -558,8 +564,7 @@ reject_constant_symbols (Lisp_Object sym, Lisp_Object newval, int function_p, sym); if (symbol_is_constant (sym, val) - || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym) - && !NILP (XSYMBOL (sym)->obarray))) + || (SYMBOL_IS_KEYWORD (sym) && !EQ (newval, sym))) signal_error (Qsetting_constant, UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval)); } @@ -953,28 +958,46 @@ print_symbol_value_magic (Lisp_Object obj, write_c_string (buf, printcharfun); } +static const struct lrecord_description symbol_value_buffer_local_description[] = { + { XD_LISP_OBJECT, offsetof(struct symbol_value_buffer_local, default_value), 4 }, + { XD_END } +}; + +static const struct lrecord_description symbol_value_lisp_magic_description[] = { + { XD_LISP_OBJECT, offsetof(struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 }, + { XD_END } +}; + +static const struct lrecord_description symbol_value_varalias_description[] = { + { XD_LISP_OBJECT, offsetof(struct symbol_value_varalias, aliasee), 2 }, + { XD_END } +}; + DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward", symbol_value_forward, this_one_is_unmarkable, - print_symbol_value_magic, 0, 0, 0, + print_symbol_value_magic, 0, 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, + symbol_value_buffer_local_description, 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, + symbol_value_lisp_magic_description, 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, + symbol_value_varalias_description, struct symbol_value_varalias); @@ -2035,7 +2058,7 @@ sets it. { struct symbol_value_buffer_local *bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local, - lrecord_symbol_value_buffer_local); + &lrecord_symbol_value_buffer_local); Lisp_Object foo; bfwd->magic.type = SYMVAL_BUFFER_LOCAL; @@ -2143,7 +2166,7 @@ Use `make-local-hook' instead. /* Make sure variable is set up to hold per-buffer values */ bfwd = alloc_lcrecord_type (struct symbol_value_buffer_local, - lrecord_symbol_value_buffer_local); + &lrecord_symbol_value_buffer_local); bfwd->magic.type = SYMVAL_SOME_BUFFER_LOCAL; bfwd->current_buffer = Qnil; @@ -2863,7 +2886,7 @@ pity, thereby invalidating your code. if (!SYMBOL_VALUE_LISP_MAGIC_P (valcontents)) { bfwd = alloc_lcrecord_type (struct symbol_value_lisp_magic, - lrecord_symbol_value_lisp_magic); + &lrecord_symbol_value_lisp_magic); bfwd->magic.type = SYMVAL_LISP_MAGIC; for (i = 0; i < MAGIC_HANDLER_MAX; i++) { @@ -2999,7 +3022,7 @@ has a buffer-local value in any buffer, or the symbols nil or t. reject_constant_symbols (variable, Qunbound, 0, Qt); bfwd = alloc_lcrecord_type (struct symbol_value_varalias, - lrecord_symbol_value_varalias); + &lrecord_symbol_value_varalias); bfwd->magic.type = SYMVAL_VARALIAS; bfwd->aliasee = alias; bfwd->shadowed = valcontents; @@ -3079,8 +3102,6 @@ static struct symbol_value_magic guts_of_unbound_marker = { { symbol_value_forward_lheader_initializer, 0, 69}, SYMVAL_UNBOUND_MARKER }; -Lisp_Object Vpure_uninterned_symbol_table; - void init_symbols_once_early (void) { @@ -3094,14 +3115,9 @@ init_symbols_once_early (void) XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0); #endif - /* see comment in Fpurecopy() */ - Vpure_uninterned_symbol_table = - make_lisp_hash_table (50, HASH_TABLE_NON_WEAK, HASH_TABLE_EQ); - 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 + /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is called the first time. */ + Qnil = Fmake_symbol (make_string_nocopy ((CONST Bufbyte *) "nil", 3)); XSYMBOL (Qnil)->name->plist = Qnil; XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */ XSYMBOL (Qnil)->plist = Qnil; @@ -3113,7 +3129,6 @@ init_symbols_once_early (void) { int hash = hash_string (string_data (XSYMBOL (Qnil)->name), 3); XVECTOR_DATA (Vobarray)[hash % OBARRAY_SIZE] = Qnil; - XSYMBOL (Qnil)->obarray = Qt; } { @@ -3145,8 +3160,8 @@ init_symbols_once_early (void) void defsymbol (Lisp_Object *location, CONST char *name) { - *location = Fintern (make_pure_pname ((CONST Bufbyte *) name, - strlen (name), 1), + *location = Fintern (make_string_nocopy ((CONST Bufbyte *) name, + strlen (name)), Qnil); staticpro (location); } @@ -3372,8 +3387,8 @@ defvar_magic (CONST char *symbol_name, CONST struct symbol_value_forward *magic) sym = Fintern (build_string (symbol_name), Qnil); else #endif - sym = Fintern (make_pure_pname ((CONST Bufbyte *) symbol_name, - strlen (symbol_name), 1), Qnil); + sym = Fintern (make_string_nocopy ((CONST Bufbyte *) symbol_name, + strlen (symbol_name)), Qnil); XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic); }