Mercurial > hg > xemacs-beta

comparison src/symbols.c @ 440:8de8e3f6228a r21-2-28

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-28
author cvs
date Mon, 13 Aug 2007 11:33:38 +0200
parents 3ecd8885ac67
children abe6d1db359e
comparison
equal deleted inserted replaced
439:357dd071b03c 440:8de8e3f6228a
87 87
88 88
89 static Lisp_Object 89 static Lisp_Object
90 mark_symbol (Lisp_Object obj) 90 mark_symbol (Lisp_Object obj)
91 { 91 {
92 struct Lisp_Symbol *sym = XSYMBOL (obj); 92 Lisp_Symbol *sym = XSYMBOL (obj);
93 Lisp_Object pname; 93 Lisp_Object pname;
94 94
95 mark_object (sym->value); 95 mark_object (sym->value);
96 mark_object (sym->function); 96 mark_object (sym->function);
97 XSETSTRING (pname, sym->name); 97 XSETSTRING (pname, sym->name);
107 return obj; 107 return obj;
108 } 108 }
109 } 109 }
110 110
111 static const struct lrecord_description symbol_description[] = { 111 static const struct lrecord_description symbol_description[] = {
112 { XD_LISP_OBJECT, offsetof(struct Lisp_Symbol, next), 5 }, 112 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, next) },
113 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, name) },
114 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, value) },
115 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, function) },
116 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, plist) },
113 { XD_END } 117 { XD_END }
114 }; 118 };
115 119
116 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol, 120 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol,
117 mark_symbol, print_symbol, 0, 0, 0, 121 mark_symbol, print_symbol, 0, 0, 0,
118 symbol_description, struct Lisp_Symbol); 122 symbol_description, Lisp_Symbol);
119 123
120 124
121 /**********************************************************************/ 125 /**********************************************************************/
122 /* Intern */ 126 /* Intern */
123 /**********************************************************************/ 127 /**********************************************************************/
171 it defaults to the value of `obarray'. 175 it defaults to the value of `obarray'.
172 */ 176 */
173 (string, obarray)) 177 (string, obarray))
174 { 178 {
175 Lisp_Object object, *ptr; 179 Lisp_Object object, *ptr;
176 struct Lisp_Symbol *symbol; 180 Lisp_Symbol *symbol;
177 Bytecount len; 181 Bytecount len;
178 182
179 if (NILP (obarray)) obarray = Vobarray; 183 if (NILP (obarray)) obarray = Vobarray;
180 obarray = check_obarray (obarray); 184 obarray = check_obarray (obarray);
181 185
220 (name, obarray)) 224 (name, obarray))
221 { 225 {
222 /* #### Bug! (intern-soft "nil") returns nil. Perhaps we should 226 /* #### Bug! (intern-soft "nil") returns nil. Perhaps we should
223 add a DEFAULT-IF-NOT-FOUND arg, like in get. */ 227 add a DEFAULT-IF-NOT-FOUND arg, like in get. */
224 Lisp_Object tem; 228 Lisp_Object tem;
225 struct Lisp_String *string; 229 Lisp_String *string;
226 230
227 if (NILP (obarray)) obarray = Vobarray; 231 if (NILP (obarray)) obarray = Vobarray;
228 obarray = check_obarray (obarray); 232 obarray = check_obarray (obarray);
229 233
230 if (!SYMBOLP (name)) 234 if (!SYMBOLP (name))
250 OBARRAY defaults to the value of the variable `obarray' 254 OBARRAY defaults to the value of the variable `obarray'
251 */ 255 */
252 (name, obarray)) 256 (name, obarray))
253 { 257 {
254 Lisp_Object tem; 258 Lisp_Object tem;
255 struct Lisp_String *string; 259 Lisp_String *string;
256 int hash; 260 int hash;
257 261
258 if (NILP (obarray)) obarray = Vobarray; 262 if (NILP (obarray)) obarray = Vobarray;
259 obarray = check_obarray (obarray); 263 obarray = check_obarray (obarray);
260 264
309 313
310 Lisp_Object 314 Lisp_Object
311 oblookup (Lisp_Object obarray, CONST Bufbyte *ptr, Bytecount size) 315 oblookup (Lisp_Object obarray, CONST Bufbyte *ptr, Bytecount size)
312 { 316 {
313 int hash, obsize; 317 int hash, obsize;
314 struct Lisp_Symbol *tail; 318 Lisp_Symbol *tail;
315 Lisp_Object bucket; 319 Lisp_Object bucket;
316 320
317 if (!VECTORP (obarray) || 321 if (!VECTORP (obarray) ||
318 (obsize = XVECTOR_LENGTH (obarray)) == 0) 322 (obsize = XVECTOR_LENGTH (obarray)) == 0)
319 { 323 {
392 { 396 {
393 Lisp_Object tail = XVECTOR_DATA (obarray)[i]; 397 Lisp_Object tail = XVECTOR_DATA (obarray)[i];
394 if (SYMBOLP (tail)) 398 if (SYMBOLP (tail))
395 while (1) 399 while (1)
396 { 400 {
397 struct Lisp_Symbol *next; 401 Lisp_Symbol *next;
398 if ((*fn) (tail, arg)) 402 if ((*fn) (tail, arg))
399 return; 403 return;
400 next = symbol_next (XSYMBOL (tail)); 404 next = symbol_next (XSYMBOL (tail));
401 if (!next) 405 if (!next)
402 break; 406 break;
768 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot 772 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
769 be changed. 773 be changed.
770 774
771 SYMVAL_CONST_SPECIFIER_FORWARD: 775 SYMVAL_CONST_SPECIFIER_FORWARD:
772 (declare with DEFVAR_SPECIFIER) 776 (declare with DEFVAR_SPECIFIER)
773 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that error message 777 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that the error
774 you get when attempting to set the value says to use 778 message you get when attempting to set the value says to use
775 `set-specifier' instead. 779 `set-specifier' instead.
776 780
777 SYMVAL_CURRENT_BUFFER_FORWARD: 781 SYMVAL_CURRENT_BUFFER_FORWARD:
778 (declare with DEFVAR_BUFFER_LOCAL) 782 (declare with DEFVAR_BUFFER_LOCAL)
779 This is used for built-in buffer-local variables -- i.e. 783 This is used for built-in buffer-local variables -- i.e.
957 static const struct lrecord_description symbol_value_forward_description[] = { 961 static const struct lrecord_description symbol_value_forward_description[] = {
958 { XD_END } 962 { XD_END }
959 }; 963 };
960 964
961 static const struct lrecord_description symbol_value_buffer_local_description[] = { 965 static const struct lrecord_description symbol_value_buffer_local_description[] = {
962 { XD_LISP_OBJECT, offsetof(struct symbol_value_buffer_local, default_value), 1 }, 966 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, default_value) },
963 { XD_LO_RESET_NIL, offsetof(struct symbol_value_buffer_local, current_value), 3 }, 967 { XD_LO_RESET_NIL, offsetof (struct symbol_value_buffer_local, current_value), 3 },
964 { XD_END } 968 { XD_END }
965 }; 969 };
966 970
967 static const struct lrecord_description symbol_value_lisp_magic_description[] = { 971 static const struct lrecord_description symbol_value_lisp_magic_description[] = {
968 { XD_LISP_OBJECT, offsetof(struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 }, 972 { XD_LISP_OBJECT_ARRAY, offsetof (struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 },
969 { XD_END } 973 { XD_END }
970 }; 974 };
971 975
972 static const struct lrecord_description symbol_value_varalias_description[] = { 976 static const struct lrecord_description symbol_value_varalias_description[] = {
973 { XD_LISP_OBJECT, offsetof(struct symbol_value_varalias, aliasee), 2 }, 977 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, aliasee) },
978 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, shadowed) },
974 { XD_END } 979 { XD_END }
975 }; 980 };
976 981
977 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward", 982 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
978 symbol_value_forward, 983 symbol_value_forward,
1617 Set SYMBOL's value to NEWVAL, and return NEWVAL. 1622 Set SYMBOL's value to NEWVAL, and return NEWVAL.
1618 */ 1623 */
1619 (symbol, newval)) 1624 (symbol, newval))
1620 { 1625 {
1621 REGISTER Lisp_Object valcontents; 1626 REGISTER Lisp_Object valcontents;
1622 struct Lisp_Symbol *sym; 1627 Lisp_Symbol *sym;
1623 /* remember, we're called by Fmakunbound() as well */ 1628 /* remember, we're called by Fmakunbound() as well */
1624 1629
1625 CHECK_SYMBOL (symbol); 1630 CHECK_SYMBOL (symbol);
1626 1631
1627 retry: 1632 retry:
1641 } 1646 }
1642 1647
1643 reject_constant_symbols (symbol, newval, 0, 1648 reject_constant_symbols (symbol, newval, 0,
1644 UNBOUNDP (newval) ? Qmakunbound : Qset); 1649 UNBOUNDP (newval) ? Qmakunbound : Qset);
1645 1650
1646 retry_2:
1647
1648 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) 1651 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1649 { 1652 {
1650 case SYMVAL_LISP_MAGIC: 1653 case SYMVAL_LISP_MAGIC:
1651 { 1654 {
1652 Lisp_Object retval;
1653
1654 if (UNBOUNDP (newval)) 1655 if (UNBOUNDP (newval))
1655 retval = maybe_call_magic_handler (symbol, Qmakunbound, 0); 1656 {
1657 maybe_call_magic_handler (symbol, Qmakunbound, 0);
1658 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = Qunbound;
1659 }
1656 else 1660 else
1657 retval = maybe_call_magic_handler (symbol, Qset, 1, newval); 1661 {
1658 if (!UNBOUNDP (retval)) 1662 maybe_call_magic_handler (symbol, Qset, 1, newval);
1659 return newval; 1663 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = newval;
1660 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed; 1664 }
1661 /* semi-change-o */
1662 goto retry_2;
1663 } 1665 }
1664 1666
1665 case SYMVAL_VARALIAS: 1667 case SYMVAL_VARALIAS:
1666 symbol = follow_varalias_pointers (symbol, 1668 symbol = follow_varalias_pointers (symbol,
1667 UNBOUNDP (newval) 1669 UNBOUNDP (newval)
2843 int i; 2845 int i;
2844 enum lisp_magic_handler htype; 2846 enum lisp_magic_handler htype;
2845 Lisp_Object legerdemain; 2847 Lisp_Object legerdemain;
2846 struct symbol_value_lisp_magic *bfwd; 2848 struct symbol_value_lisp_magic *bfwd;
2847 2849
2848 assert (nargs >= 0 && nargs < 20); 2850 assert (nargs >= 0 && nargs < countof (args));
2849 legerdemain = XSYMBOL (sym)->value; 2851 legerdemain = XSYMBOL (sym)->value;
2850 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain)); 2852 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
2851 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain); 2853 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
2852 2854
2853 va_start (vargs, nargs); 2855 va_start (vargs, nargs);
3109 SYMVAL_UNBOUND_MARKER }; 3111 SYMVAL_UNBOUND_MARKER };
3110 3112
3111 void 3113 void
3112 init_symbols_once_early (void) 3114 init_symbols_once_early (void)
3113 { 3115 {
3114 #ifndef Qzero 3116 reinit_symbols_once_early ();
3115 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3116 #endif
3117
3118 #ifndef Qnull_pointer
3119 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3120 so the following is actually a no-op. */
3121 XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
3122 #endif
3123 3117
3124 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is 3118 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
3125 called the first time. */ 3119 called the first time. */
3126 Qnil = Fmake_symbol (make_string_nocopy ((CONST Bufbyte *) "nil", 3)); 3120 Qnil = Fmake_symbol (make_string_nocopy ((CONST Bufbyte *) "nil", 3));
3127 XSYMBOL (Qnil)->name->plist = Qnil; 3121 XSYMBOL (Qnil)->name->plist = Qnil;
3163 Vquit_flag = Qnil; 3157 Vquit_flag = Qnil;
3164 3158
3165 pdump_wire (&Qnil); 3159 pdump_wire (&Qnil);
3166 pdump_wire (&Qunbound); 3160 pdump_wire (&Qunbound);
3167 pdump_wire (&Vquit_flag); 3161 pdump_wire (&Vquit_flag);
3162 }
3163
3164 void
3165 reinit_symbols_once_early (void)
3166 {
3167 #ifndef Qzero
3168 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3169 #endif
3170
3171 #ifndef Qnull_pointer
3172 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3173 so the following is actually a no-op. */
3174 XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
3175 #endif
3168 } 3176 }
3169 3177
3170 void 3178 void
3171 defsymbol_nodump (Lisp_Object *location, CONST char *name) 3179 defsymbol_nodump (Lisp_Object *location, CONST char *name)
3172 { 3180 {
3237 * it if required. 3245 * it if required.
3238 * 3246 *
3239 * FIXME: Should newsubr be staticpro()'ed? I dont think so but I need 3247 * FIXME: Should newsubr be staticpro()'ed? I dont think so but I need
3240 * a guru to check. 3248 * a guru to check.
3241 */ 3249 */
3242 #define check_module_subr() \ 3250 #define check_module_subr() \
3243 do { \ 3251 do { \
3244 if (initialized) { \ 3252 if (initialized) { \
3245 struct Lisp_Subr *newsubr; \ 3253 Lisp_Subr *newsubr = (Lisp_Subr *) xmalloc (sizeof (Lisp_Subr)); \
3246 newsubr = (Lisp_Subr *)xmalloc(sizeof(struct Lisp_Subr)); \ 3254 memcpy (newsubr, subr, sizeof (Lisp_Subr)); \
3247 memcpy (newsubr, subr, sizeof(struct Lisp_Subr)); \ 3255 subr->doc = (CONST char *)newsubr; \
3248 subr->doc = (CONST char *)newsubr; \ 3256 subr = newsubr; \
3249 subr = newsubr; \ 3257 } \
3250 } \
3251 } while (0) 3258 } while (0)
3252 #else /* ! HAVE_SHLIB */ 3259 #else /* ! HAVE_SHLIB */
3253 #define check_module_subr() 3260 #define check_module_subr()
3254 #endif 3261 #endif
3255 3262