Mercurial > hg > xemacs-beta

comparison src/symbols.c @ 424:11054d720c21 r21-2-20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-20
author cvs
date Mon, 13 Aug 2007 11:26:11 +0200
parents 41dbb7a9d5f2
children
comparison
equal deleted inserted replaced
423:28d9c139be4c 424:11054d720c21
61 Lisp_Object Qad_advice_info, Qad_activate; 61 Lisp_Object Qad_advice_info, Qad_activate;
62 62
63 Lisp_Object Qget_value, Qset_value, Qbound_predicate, Qmake_unbound; 63 Lisp_Object Qget_value, Qset_value, Qbound_predicate, Qmake_unbound;
64 Lisp_Object Qlocal_predicate, Qmake_local; 64 Lisp_Object Qlocal_predicate, Qmake_local;
65 65
66 Lisp_Object Qboundp, Qfboundp, Qglobally_boundp, Qmakunbound; 66 Lisp_Object Qboundp, Qglobally_boundp, Qmakunbound;
67 Lisp_Object Qsymbol_value, Qset, Qdefault_boundp, Qdefault_value; 67 Lisp_Object Qsymbol_value, Qset, Qdefault_boundp, Qdefault_value;
68 Lisp_Object Qset_default, Qsetq_default; 68 Lisp_Object Qset_default, Qsetq_default;
69 Lisp_Object Qmake_variable_buffer_local, Qmake_local_variable; 69 Lisp_Object Qmake_variable_buffer_local, Qmake_local_variable;
70 Lisp_Object Qkill_local_variable, Qkill_console_local_variable; 70 Lisp_Object Qkill_local_variable, Qkill_console_local_variable;
71 Lisp_Object Qsymbol_value_in_buffer, Qsymbol_value_in_console; 71 Lisp_Object Qsymbol_value_in_buffer, Qsymbol_value_in_console;
85 static Lisp_Object follow_varalias_pointers (Lisp_Object symbol, 85 static Lisp_Object follow_varalias_pointers (Lisp_Object symbol,
86 Lisp_Object follow_past_lisp_magic); 86 Lisp_Object follow_past_lisp_magic);
87 87
88 88
89 static Lisp_Object 89 static Lisp_Object
90 mark_symbol (Lisp_Object obj, void (*markobj) (Lisp_Object)) 90 mark_symbol (Lisp_Object obj)
91 { 91 {
92 struct Lisp_Symbol *sym = XSYMBOL (obj); 92 struct Lisp_Symbol *sym = XSYMBOL (obj);
93 Lisp_Object pname; 93 Lisp_Object pname;
94 94
95 markobj (sym->value); 95 mark_object (sym->value);
96 markobj (sym->function); 96 mark_object (sym->function);
97 XSETSTRING (pname, sym->name); 97 XSETSTRING (pname, sym->name);
98 markobj (pname); 98 mark_object (pname);
99 if (!symbol_next (sym)) 99 if (!symbol_next (sym))
100 return sym->plist; 100 return sym->plist;
101 else 101 else
102 { 102 {
103 markobj (sym->plist); 103 mark_object (sym->plist);
104 /* Mark the rest of the symbols in the obarray hash-chain */ 104 /* Mark the rest of the symbols in the obarray hash-chain */
105 sym = symbol_next (sym); 105 sym = symbol_next (sym);
106 XSETSYMBOL (obj, sym); 106 XSETSYMBOL (obj, sym);
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(struct Lisp_Symbol, next), 5 },
113 { XD_END }
113 }; 114 };
114 115
115 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol, 116 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol,
116 mark_symbol, print_symbol, 0, 0, 0, 117 mark_symbol, print_symbol, 0, 0, 0,
117 symbol_description, struct Lisp_Symbol); 118 symbol_description, struct Lisp_Symbol);
893 low-level functions below do not accept them; you need 894 low-level functions below do not accept them; you need
894 to call follow_varalias_pointers to get the actual 895 to call follow_varalias_pointers to get the actual
895 symbol to operate on. */ 896 symbol to operate on. */
896 897
897 static Lisp_Object 898 static Lisp_Object
898 mark_symbol_value_buffer_local (Lisp_Object obj, 899 mark_symbol_value_buffer_local (Lisp_Object obj)
899 void (*markobj) (Lisp_Object))
900 { 900 {
901 struct symbol_value_buffer_local *bfwd; 901 struct symbol_value_buffer_local *bfwd;
902 902
903 #ifdef ERROR_CHECK_TYPECHECK 903 #ifdef ERROR_CHECK_TYPECHECK
904 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL || 904 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL ||
905 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL); 905 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL);
906 #endif 906 #endif
907 907
908 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj); 908 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
909 markobj (bfwd->default_value); 909 mark_object (bfwd->default_value);
910 markobj (bfwd->current_value); 910 mark_object (bfwd->current_value);
911 markobj (bfwd->current_buffer); 911 mark_object (bfwd->current_buffer);
912 return bfwd->current_alist_element; 912 return bfwd->current_alist_element;
913 } 913 }
914 914
915 static Lisp_Object 915 static Lisp_Object
916 mark_symbol_value_lisp_magic (Lisp_Object obj, 916 mark_symbol_value_lisp_magic (Lisp_Object obj)
917 void (*markobj) (Lisp_Object))
918 { 917 {
919 struct symbol_value_lisp_magic *bfwd; 918 struct symbol_value_lisp_magic *bfwd;
920 int i; 919 int i;
921 920
922 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC); 921 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
923 922
924 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj); 923 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
925 for (i = 0; i < MAGIC_HANDLER_MAX; i++) 924 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
926 { 925 {
927 markobj (bfwd->handler[i]); 926 mark_object (bfwd->handler[i]);
928 markobj (bfwd->harg[i]); 927 mark_object (bfwd->harg[i]);
929 } 928 }
930 return bfwd->shadowed; 929 return bfwd->shadowed;
931 } 930 }
932 931
933 static Lisp_Object 932 static Lisp_Object
934 mark_symbol_value_varalias (Lisp_Object obj, 933 mark_symbol_value_varalias (Lisp_Object obj)
935 void (*markobj) (Lisp_Object))
936 { 934 {
937 struct symbol_value_varalias *bfwd; 935 struct symbol_value_varalias *bfwd;
938 936
939 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS); 937 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
940 938
941 bfwd = XSYMBOL_VALUE_VARALIAS (obj); 939 bfwd = XSYMBOL_VALUE_VARALIAS (obj);
942 markobj (bfwd->shadowed); 940 mark_object (bfwd->shadowed);
943 return bfwd->aliasee; 941 return bfwd->aliasee;
944 } 942 }
945 943
946 /* Should never, ever be called. (except by an external debugger) */ 944 /* Should never, ever be called. (except by an external debugger) */
947 void 945 void
954 XSYMBOL_VALUE_MAGIC_TYPE (obj), 952 XSYMBOL_VALUE_MAGIC_TYPE (obj),
955 (long) XPNTR (obj)); 953 (long) XPNTR (obj));
956 write_c_string (buf, printcharfun); 954 write_c_string (buf, printcharfun);
957 } 955 }
958 956
957 static const struct lrecord_description symbol_value_forward_description[] = {
958 { XD_END }
959 };
960
959 static const struct lrecord_description symbol_value_buffer_local_description[] = { 961 static const struct lrecord_description symbol_value_buffer_local_description[] = {
960 { XD_LISP_OBJECT, offsetof(struct symbol_value_buffer_local, default_value), 4 }, 962 { XD_LISP_OBJECT, offsetof(struct symbol_value_buffer_local, default_value), 1 },
963 { XD_LO_RESET_NIL, offsetof(struct symbol_value_buffer_local, current_value), 3 },
961 { XD_END } 964 { XD_END }
962 }; 965 };
963 966
964 static const struct lrecord_description symbol_value_lisp_magic_description[] = { 967 static const struct lrecord_description symbol_value_lisp_magic_description[] = {
965 { XD_LISP_OBJECT, offsetof(struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 }, 968 { XD_LISP_OBJECT, offsetof(struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 },
972 }; 975 };
973 976
974 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward", 977 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
975 symbol_value_forward, 978 symbol_value_forward,
976 this_one_is_unmarkable, 979 this_one_is_unmarkable,
977 print_symbol_value_magic, 0, 0, 0, 0, 980 print_symbol_value_magic, 0, 0, 0,
981 symbol_value_forward_description,
978 struct symbol_value_forward); 982 struct symbol_value_forward);
979 983
980 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local", 984 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
981 symbol_value_buffer_local, 985 symbol_value_buffer_local,
982 mark_symbol_value_buffer_local, 986 mark_symbol_value_buffer_local,
1212 1216
1213 case SYMVAL_BOOLEAN_FORWARD: 1217 case SYMVAL_BOOLEAN_FORWARD:
1214 if (magicfun) 1218 if (magicfun)
1215 magicfun (sym, &newval, Qnil, 0); 1219 magicfun (sym, &newval, Qnil, 0);
1216 *((int *) symbol_value_forward_forward (fwd)) 1220 *((int *) symbol_value_forward_forward (fwd))
1217 = ((NILP (newval)) ? 0 : 1); 1221 = !NILP (newval);
1218 return; 1222 return;
1219 1223
1220 case SYMVAL_OBJECT_FORWARD: 1224 case SYMVAL_OBJECT_FORWARD:
1221 if (magicfun) 1225 if (magicfun)
1222 magicfun (sym, &newval, Qnil, 0); 1226 magicfun (sym, &newval, Qnil, 0);
1545 else 1549 else
1546 { 1550 {
1547 /* This can also get called while we're preparing to shutdown. 1551 /* This can also get called while we're preparing to shutdown.
1548 #### What should really happen in that case? Should we 1552 #### What should really happen in that case? Should we
1549 actually fix things so we can't get here in that case? */ 1553 actually fix things so we can't get here in that case? */
1554 #ifndef PDUMP
1550 assert (!initialized || preparing_for_armageddon); 1555 assert (!initialized || preparing_for_armageddon);
1556 #endif
1551 con = 0; 1557 con = 0;
1552 } 1558 }
1553 1559
1554 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1); 1560 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1);
1555 } 1561 }
1581 else 1587 else
1582 { 1588 {
1583 /* This can also get called while we're preparing to shutdown. 1589 /* This can also get called while we're preparing to shutdown.
1584 #### What should really happen in that case? Should we 1590 #### What should really happen in that case? Should we
1585 actually fix things so we can't get here in that case? */ 1591 actually fix things so we can't get here in that case? */
1592 #ifndef PDUMP
1586 assert (!initialized || preparing_for_armageddon); 1593 assert (!initialized || preparing_for_armageddon);
1594 #endif
1587 con = 0; 1595 con = 0;
1588 } 1596 }
1589 1597
1590 return find_symbol_value_1 (sym, current_buffer, con, 1, 1598 return find_symbol_value_1 (sym, current_buffer, con, 1,
1591 find_it_p ? symbol_cons : Qnil, 1599 find_it_p ? symbol_cons : Qnil,
3151 XSYMBOL (Qnil)->function = Qunbound; 3159 XSYMBOL (Qnil)->function = Qunbound;
3152 3160
3153 defsymbol (&Qt, "t"); 3161 defsymbol (&Qt, "t");
3154 XSYMBOL (Qt)->value = Qt; /* Veritas aetera */ 3162 XSYMBOL (Qt)->value = Qt; /* Veritas aetera */
3155 Vquit_flag = Qnil; 3163 Vquit_flag = Qnil;
3164
3165 pdump_wire (&Qnil);
3166 pdump_wire (&Qunbound);
3167 pdump_wire (&Vquit_flag);
3168 }
3169
3170 void
3171 defsymbol_nodump (Lisp_Object *location, CONST char *name)
3172 {
3173 *location = Fintern (make_string_nocopy ((CONST Bufbyte *) name,
3174 strlen (name)),
3175 Qnil);
3176 staticpro_nodump (location);
3156 } 3177 }
3157 3178
3158 void 3179 void
3159 defsymbol (Lisp_Object *location, CONST char *name) 3180 defsymbol (Lisp_Object *location, CONST char *name)
3160 { 3181 {
3266 Lisp_Object conds; 3287 Lisp_Object conds;
3267 defsymbol (symbol, name); 3288 defsymbol (symbol, name);
3268 3289
3269 assert (SYMBOLP (inherits_from)); 3290 assert (SYMBOLP (inherits_from));
3270 conds = Fget (inherits_from, Qerror_conditions, Qnil); 3291 conds = Fget (inherits_from, Qerror_conditions, Qnil);
3271 pure_put (*symbol, Qerror_conditions, Fcons (*symbol, conds)); 3292 Fput (*symbol, Qerror_conditions, Fcons (*symbol, conds));
3272 /* NOT build_translated_string (). This function is called at load time 3293 /* NOT build_translated_string (). This function is called at load time
3273 and the string needs to get translated at run time. (This happens 3294 and the string needs to get translated at run time. (This happens
3274 in the function (display-error) in cmdloop.el.) */ 3295 in the function (display-error) in cmdloop.el.) */
3275 pure_put (*symbol, Qerror_message, build_string (messuhhj)); 3296 Fput (*symbol, Qerror_message, build_string (messuhhj));
3276 } 3297 }
3277 3298
3278 void 3299 void
3279 syms_of_symbols (void) 3300 syms_of_symbols (void)
3280 { 3301 {
3289 defsymbol (&Qmake_unbound, "make-unbound"); 3310 defsymbol (&Qmake_unbound, "make-unbound");
3290 defsymbol (&Qlocal_predicate, "local-predicate"); 3311 defsymbol (&Qlocal_predicate, "local-predicate");
3291 defsymbol (&Qmake_local, "make-local"); 3312 defsymbol (&Qmake_local, "make-local");
3292 3313
3293 defsymbol (&Qboundp, "boundp"); 3314 defsymbol (&Qboundp, "boundp");
3294 defsymbol (&Qfboundp, "fboundp");
3295 defsymbol (&Qglobally_boundp, "globally-boundp"); 3315 defsymbol (&Qglobally_boundp, "globally-boundp");
3296 defsymbol (&Qmakunbound, "makunbound"); 3316 defsymbol (&Qmakunbound, "makunbound");
3297 defsymbol (&Qsymbol_value, "symbol-value"); 3317 defsymbol (&Qsymbol_value, "symbol-value");
3298 defsymbol (&Qset, "set"); 3318 defsymbol (&Qset, "set");
3299 defsymbol (&Qsetq_default, "setq-default"); 3319 defsymbol (&Qsetq_default, "setq-default");