Mercurial > hg > xemacs-beta

comparison src/symbols.c @ 412:697ef44129c6 r21-2-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-14
author cvs
date Mon, 13 Aug 2007 11:20:41 +0200
parents a86b2b5e0111
children 41dbb7a9d5f2
comparison
equal deleted inserted replaced
411:12e008d41344 412:697ef44129c6
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, Qglobally_boundp, Qmakunbound; 66 Lisp_Object Qboundp, Qfboundp, 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) 90 mark_symbol (Lisp_Object obj, void (*markobj) (Lisp_Object))
91 { 91 {
92 Lisp_Symbol *sym = XSYMBOL (obj); 92 struct Lisp_Symbol *sym = XSYMBOL (obj);
93 Lisp_Object pname; 93 Lisp_Object pname;
94 94
95 mark_object (sym->value); 95 markobj (sym->value);
96 mark_object (sym->function); 96 markobj (sym->function);
97 XSETSTRING (pname, sym->name); 97 XSETSTRING (pname, sym->name);
98 mark_object (pname); 98 markobj (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 mark_object (sym->plist); 103 markobj (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 DEFINE_BASIC_LRECORD_IMPLEMENTATION ("symbol", symbol,
112 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, next) }, 112 mark_symbol, print_symbol, 0, 0, 0,
113 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, name) }, 113 struct Lisp_Symbol);
114 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, value) },
115 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, function) },
116 { XD_LISP_OBJECT, offsetof (Lisp_Symbol, plist) },
117 { XD_END }
118 };
119
120 /* Symbol plists are directly accessible, so we need to protect against
121 invalid property list structure */
122
123 static Lisp_Object
124 symbol_getprop (Lisp_Object symbol, Lisp_Object property)
125 {
126 return external_plist_get (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME);
127 }
128
129 static int
130 symbol_putprop (Lisp_Object symbol, Lisp_Object property, Lisp_Object value)
131 {
132 external_plist_put (&XSYMBOL (symbol)->plist, property, value, 0, ERROR_ME);
133 return 1;
134 }
135
136 static int
137 symbol_remprop (Lisp_Object symbol, Lisp_Object property)
138 {
139 return external_remprop (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME);
140 }
141
142 DEFINE_BASIC_LRECORD_IMPLEMENTATION_WITH_PROPS ("symbol", symbol,
143 mark_symbol, print_symbol,
144 0, 0, 0, symbol_description,
145 symbol_getprop,
146 symbol_putprop,
147 symbol_remprop,
148 Fsymbol_plist,
149 Lisp_Symbol);
150 114
151 115
152 /**********************************************************************/ 116 /**********************************************************************/
153 /* Intern */ 117 /* Intern */
154 /**********************************************************************/ 118 /**********************************************************************/
175 } 139 }
176 return obarray; 140 return obarray;
177 } 141 }
178 142
179 Lisp_Object 143 Lisp_Object
180 intern (const char *str) 144 intern (CONST char *str)
181 { 145 {
182 Bytecount len = strlen (str); 146 Bytecount len = strlen (str);
183 const Bufbyte *buf = (const Bufbyte *) str; 147 CONST Bufbyte *buf = (CONST Bufbyte *) str;
184 Lisp_Object obarray = Vobarray; 148 Lisp_Object obarray = Vobarray;
185 149
186 if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0) 150 if (!VECTORP (obarray) || XVECTOR_LENGTH (obarray) == 0)
187 obarray = check_obarray (obarray); 151 obarray = check_obarray (obarray);
188 152
202 it defaults to the value of `obarray'. 166 it defaults to the value of `obarray'.
203 */ 167 */
204 (string, obarray)) 168 (string, obarray))
205 { 169 {
206 Lisp_Object object, *ptr; 170 Lisp_Object object, *ptr;
207 Lisp_Symbol *symbol; 171 struct Lisp_Symbol *symbol;
208 Bytecount len; 172 Bytecount len;
209 173
210 if (NILP (obarray)) obarray = Vobarray; 174 if (NILP (obarray)) obarray = Vobarray;
211 obarray = check_obarray (obarray); 175 obarray = check_obarray (obarray);
212 176
251 (name, obarray)) 215 (name, obarray))
252 { 216 {
253 /* #### Bug! (intern-soft "nil") returns nil. Perhaps we should 217 /* #### Bug! (intern-soft "nil") returns nil. Perhaps we should
254 add a DEFAULT-IF-NOT-FOUND arg, like in get. */ 218 add a DEFAULT-IF-NOT-FOUND arg, like in get. */
255 Lisp_Object tem; 219 Lisp_Object tem;
256 Lisp_String *string; 220 struct Lisp_String *string;
257 221
258 if (NILP (obarray)) obarray = Vobarray; 222 if (NILP (obarray)) obarray = Vobarray;
259 obarray = check_obarray (obarray); 223 obarray = check_obarray (obarray);
260 224
261 if (!SYMBOLP (name)) 225 if (!SYMBOLP (name))
281 OBARRAY defaults to the value of the variable `obarray' 245 OBARRAY defaults to the value of the variable `obarray'
282 */ 246 */
283 (name, obarray)) 247 (name, obarray))
284 { 248 {
285 Lisp_Object tem; 249 Lisp_Object tem;
286 Lisp_String *string; 250 struct Lisp_String *string;
287 int hash; 251 int hash;
288 252
289 if (NILP (obarray)) obarray = Vobarray; 253 if (NILP (obarray)) obarray = Vobarray;
290 obarray = check_obarray (obarray); 254 obarray = check_obarray (obarray);
291 255
337 return the index into OBARRAY that the string hashes to. 301 return the index into OBARRAY that the string hashes to.
338 302
339 Also store the bucket number in oblookup_last_bucket_number. */ 303 Also store the bucket number in oblookup_last_bucket_number. */
340 304
341 Lisp_Object 305 Lisp_Object
342 oblookup (Lisp_Object obarray, const Bufbyte *ptr, Bytecount size) 306 oblookup (Lisp_Object obarray, CONST Bufbyte *ptr, Bytecount size)
343 { 307 {
344 int hash, obsize; 308 int hash, obsize;
345 Lisp_Symbol *tail; 309 struct Lisp_Symbol *tail;
346 Lisp_Object bucket; 310 Lisp_Object bucket;
347 311
348 if (!VECTORP (obarray) || 312 if (!VECTORP (obarray) ||
349 (obsize = XVECTOR_LENGTH (obarray)) == 0) 313 (obsize = XVECTOR_LENGTH (obarray)) == 0)
350 { 314 {
374 return make_int (hash); 338 return make_int (hash);
375 } 339 }
376 340
377 #if 0 /* Emacs 19.34 */ 341 #if 0 /* Emacs 19.34 */
378 int 342 int
379 hash_string (const Bufbyte *ptr, Bytecount len) 343 hash_string (CONST Bufbyte *ptr, Bytecount len)
380 { 344 {
381 const Bufbyte *p = ptr; 345 CONST Bufbyte *p = ptr;
382 const Bufbyte *end = p + len; 346 CONST Bufbyte *end = p + len;
383 Bufbyte c; 347 Bufbyte c;
384 int hash = 0; 348 int hash = 0;
385 349
386 while (p != end) 350 while (p != end)
387 { 351 {
393 } 357 }
394 #endif 358 #endif
395 359
396 /* derived from hashpjw, Dragon Book P436. */ 360 /* derived from hashpjw, Dragon Book P436. */
397 int 361 int
398 hash_string (const Bufbyte *ptr, Bytecount len) 362 hash_string (CONST Bufbyte *ptr, Bytecount len)
399 { 363 {
400 int hash = 0; 364 int hash = 0;
401 365
402 while (len-- > 0) 366 while (len-- > 0)
403 { 367 {
423 { 387 {
424 Lisp_Object tail = XVECTOR_DATA (obarray)[i]; 388 Lisp_Object tail = XVECTOR_DATA (obarray)[i];
425 if (SYMBOLP (tail)) 389 if (SYMBOLP (tail))
426 while (1) 390 while (1)
427 { 391 {
428 Lisp_Symbol *next; 392 struct Lisp_Symbol *next;
429 if ((*fn) (tail, arg)) 393 if ((*fn) (tail, arg))
430 return; 394 return;
431 next = symbol_next (XSYMBOL (tail)); 395 next = symbol_next (XSYMBOL (tail));
432 if (!next) 396 if (!next)
433 break; 397 break;
799 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot 763 SYMVAL_BOOLEAN_FORWARD, respectively, except that the value cannot
800 be changed. 764 be changed.
801 765
802 SYMVAL_CONST_SPECIFIER_FORWARD: 766 SYMVAL_CONST_SPECIFIER_FORWARD:
803 (declare with DEFVAR_SPECIFIER) 767 (declare with DEFVAR_SPECIFIER)
804 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that the error 768 Exactly like SYMVAL_CONST_OBJECT_FORWARD except that error message
805 message you get when attempting to set the value says to use 769 you get when attempting to set the value says to use
806 `set-specifier' instead. 770 `set-specifier' instead.
807 771
808 SYMVAL_CURRENT_BUFFER_FORWARD: 772 SYMVAL_CURRENT_BUFFER_FORWARD:
809 (declare with DEFVAR_BUFFER_LOCAL) 773 (declare with DEFVAR_BUFFER_LOCAL)
810 This is used for built-in buffer-local variables -- i.e. 774 This is used for built-in buffer-local variables -- i.e.
925 low-level functions below do not accept them; you need 889 low-level functions below do not accept them; you need
926 to call follow_varalias_pointers to get the actual 890 to call follow_varalias_pointers to get the actual
927 symbol to operate on. */ 891 symbol to operate on. */
928 892
929 static Lisp_Object 893 static Lisp_Object
930 mark_symbol_value_buffer_local (Lisp_Object obj) 894 mark_symbol_value_buffer_local (Lisp_Object obj,
895 void (*markobj) (Lisp_Object))
931 { 896 {
932 struct symbol_value_buffer_local *bfwd; 897 struct symbol_value_buffer_local *bfwd;
933 898
934 #ifdef ERROR_CHECK_TYPECHECK 899 #ifdef ERROR_CHECK_TYPECHECK
935 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL || 900 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_BUFFER_LOCAL ||
936 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL); 901 XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_SOME_BUFFER_LOCAL);
937 #endif 902 #endif
938 903
939 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj); 904 bfwd = XSYMBOL_VALUE_BUFFER_LOCAL (obj);
940 mark_object (bfwd->default_value); 905 markobj (bfwd->default_value);
941 mark_object (bfwd->current_value); 906 markobj (bfwd->current_value);
942 mark_object (bfwd->current_buffer); 907 markobj (bfwd->current_buffer);
943 return bfwd->current_alist_element; 908 return bfwd->current_alist_element;
944 } 909 }
945 910
946 static Lisp_Object 911 static Lisp_Object
947 mark_symbol_value_lisp_magic (Lisp_Object obj) 912 mark_symbol_value_lisp_magic (Lisp_Object obj,
913 void (*markobj) (Lisp_Object))
948 { 914 {
949 struct symbol_value_lisp_magic *bfwd; 915 struct symbol_value_lisp_magic *bfwd;
950 int i; 916 int i;
951 917
952 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC); 918 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_LISP_MAGIC);
953 919
954 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj); 920 bfwd = XSYMBOL_VALUE_LISP_MAGIC (obj);
955 for (i = 0; i < MAGIC_HANDLER_MAX; i++) 921 for (i = 0; i < MAGIC_HANDLER_MAX; i++)
956 { 922 {
957 mark_object (bfwd->handler[i]); 923 markobj (bfwd->handler[i]);
958 mark_object (bfwd->harg[i]); 924 markobj (bfwd->harg[i]);
959 } 925 }
960 return bfwd->shadowed; 926 return bfwd->shadowed;
961 } 927 }
962 928
963 static Lisp_Object 929 static Lisp_Object
964 mark_symbol_value_varalias (Lisp_Object obj) 930 mark_symbol_value_varalias (Lisp_Object obj,
931 void (*markobj) (Lisp_Object))
965 { 932 {
966 struct symbol_value_varalias *bfwd; 933 struct symbol_value_varalias *bfwd;
967 934
968 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS); 935 assert (XSYMBOL_VALUE_MAGIC_TYPE (obj) == SYMVAL_VARALIAS);
969 936
970 bfwd = XSYMBOL_VALUE_VARALIAS (obj); 937 bfwd = XSYMBOL_VALUE_VARALIAS (obj);
971 mark_object (bfwd->shadowed); 938 markobj (bfwd->shadowed);
972 return bfwd->aliasee; 939 return bfwd->aliasee;
973 } 940 }
974 941
975 /* Should never, ever be called. (except by an external debugger) */ 942 /* Should never, ever be called. (except by an external debugger) */
976 void 943 void
983 XSYMBOL_VALUE_MAGIC_TYPE (obj), 950 XSYMBOL_VALUE_MAGIC_TYPE (obj),
984 (long) XPNTR (obj)); 951 (long) XPNTR (obj));
985 write_c_string (buf, printcharfun); 952 write_c_string (buf, printcharfun);
986 } 953 }
987 954
988 static const struct lrecord_description symbol_value_forward_description[] = {
989 { XD_END }
990 };
991
992 static const struct lrecord_description symbol_value_buffer_local_description[] = {
993 { XD_LISP_OBJECT, offsetof (struct symbol_value_buffer_local, default_value) },
994 { XD_LO_RESET_NIL, offsetof (struct symbol_value_buffer_local, current_value), 3 },
995 { XD_END }
996 };
997
998 static const struct lrecord_description symbol_value_lisp_magic_description[] = {
999 { XD_LISP_OBJECT_ARRAY, offsetof (struct symbol_value_lisp_magic, handler), 2*MAGIC_HANDLER_MAX+1 },
1000 { XD_END }
1001 };
1002
1003 static const struct lrecord_description symbol_value_varalias_description[] = {
1004 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, aliasee) },
1005 { XD_LISP_OBJECT, offsetof (struct symbol_value_varalias, shadowed) },
1006 { XD_END }
1007 };
1008
1009 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward", 955 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-forward",
1010 symbol_value_forward, 956 symbol_value_forward,
1011 0, 957 this_one_is_unmarkable,
1012 print_symbol_value_magic, 0, 0, 0, 958 print_symbol_value_magic, 0, 0, 0,
1013 symbol_value_forward_description,
1014 struct symbol_value_forward); 959 struct symbol_value_forward);
1015 960
1016 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local", 961 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-buffer-local",
1017 symbol_value_buffer_local, 962 symbol_value_buffer_local,
1018 mark_symbol_value_buffer_local, 963 mark_symbol_value_buffer_local,
1019 print_symbol_value_magic, 0, 0, 0, 964 print_symbol_value_magic, 0, 0, 0,
1020 symbol_value_buffer_local_description,
1021 struct symbol_value_buffer_local); 965 struct symbol_value_buffer_local);
1022 966
1023 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic", 967 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-lisp-magic",
1024 symbol_value_lisp_magic, 968 symbol_value_lisp_magic,
1025 mark_symbol_value_lisp_magic, 969 mark_symbol_value_lisp_magic,
1026 print_symbol_value_magic, 0, 0, 0, 970 print_symbol_value_magic, 0, 0, 0,
1027 symbol_value_lisp_magic_description,
1028 struct symbol_value_lisp_magic); 971 struct symbol_value_lisp_magic);
1029 972
1030 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias", 973 DEFINE_LRECORD_IMPLEMENTATION ("symbol-value-varalias",
1031 symbol_value_varalias, 974 symbol_value_varalias,
1032 mark_symbol_value_varalias, 975 mark_symbol_value_varalias,
1033 print_symbol_value_magic, 0, 0, 0, 976 print_symbol_value_magic, 0, 0, 0,
1034 symbol_value_varalias_description,
1035 struct symbol_value_varalias); 977 struct symbol_value_varalias);
1036 978
1037 979
1038 /* Getting and setting values of symbols */ 980 /* Getting and setting values of symbols */
1039 981
1054 996
1055 static Lisp_Object 997 static Lisp_Object
1056 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer, 998 do_symval_forwarding (Lisp_Object valcontents, struct buffer *buffer,
1057 struct console *console) 999 struct console *console)
1058 { 1000 {
1059 const struct symbol_value_forward *fwd; 1001 CONST struct symbol_value_forward *fwd;
1060 1002
1061 if (!SYMBOL_VALUE_MAGIC_P (valcontents)) 1003 if (!SYMBOL_VALUE_MAGIC_P (valcontents))
1062 return valcontents; 1004 return valcontents;
1063 1005
1064 fwd = XSYMBOL_VALUE_FORWARD (valcontents); 1006 fwd = XSYMBOL_VALUE_FORWARD (valcontents);
1122 */ 1064 */
1123 /* At this point, the value cell may not contain a symbol-value-varalias 1065 /* At this point, the value cell may not contain a symbol-value-varalias
1124 or symbol-value-buffer-local, and if there's a handler, we should 1066 or symbol-value-buffer-local, and if there's a handler, we should
1125 have already called it. */ 1067 have already called it. */
1126 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt); 1068 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1127 const struct symbol_value_forward *fwd 1069 CONST struct symbol_value_forward *fwd
1128 = XSYMBOL_VALUE_FORWARD (valcontents); 1070 = XSYMBOL_VALUE_FORWARD (valcontents);
1129 int offset = ((char *) symbol_value_forward_forward (fwd) 1071 int offset = ((char *) symbol_value_forward_forward (fwd)
1130 - (char *) &buffer_local_flags); 1072 - (char *) &buffer_local_flags);
1131 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); 1073 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1132 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object, 1074 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1164 */ 1106 */
1165 /* At this point, the value cell may not contain a symbol-value-varalias 1107 /* At this point, the value cell may not contain a symbol-value-varalias
1166 or symbol-value-buffer-local, and if there's a handler, we should 1108 or symbol-value-buffer-local, and if there's a handler, we should
1167 have already called it. */ 1109 have already called it. */
1168 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt); 1110 Lisp_Object valcontents = fetch_value_maybe_past_magic (sym, Qt);
1169 const struct symbol_value_forward *fwd 1111 CONST struct symbol_value_forward *fwd
1170 = XSYMBOL_VALUE_FORWARD (valcontents); 1112 = XSYMBOL_VALUE_FORWARD (valcontents);
1171 int offset = ((char *) symbol_value_forward_forward (fwd) 1113 int offset = ((char *) symbol_value_forward_forward (fwd)
1172 - (char *) &console_local_flags); 1114 - (char *) &console_local_flags);
1173 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); 1115 int mask = XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
1174 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object, 1116 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, Lisp_Object in_object,
1230 || !SYMBOL_VALUE_MAGIC_P (*store_pointer)); 1172 || !SYMBOL_VALUE_MAGIC_P (*store_pointer));
1231 *store_pointer = newval; 1173 *store_pointer = newval;
1232 } 1174 }
1233 else 1175 else
1234 { 1176 {
1235 const struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue); 1177 CONST struct symbol_value_forward *fwd = XSYMBOL_VALUE_FORWARD (ovalue);
1236 int (*magicfun) (Lisp_Object simm, Lisp_Object *val, 1178 int (*magicfun) (Lisp_Object simm, Lisp_Object *val,
1237 Lisp_Object in_object, int flags) 1179 Lisp_Object in_object, int flags)
1238 = symbol_value_forward_magicfun (fwd); 1180 = symbol_value_forward_magicfun (fwd);
1239 1181
1240 switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue)) 1182 switch (XSYMBOL_VALUE_MAGIC_TYPE (ovalue))
1248 1190
1249 case SYMVAL_BOOLEAN_FORWARD: 1191 case SYMVAL_BOOLEAN_FORWARD:
1250 if (magicfun) 1192 if (magicfun)
1251 magicfun (sym, &newval, Qnil, 0); 1193 magicfun (sym, &newval, Qnil, 0);
1252 *((int *) symbol_value_forward_forward (fwd)) 1194 *((int *) symbol_value_forward_forward (fwd))
1253 = !NILP (newval); 1195 = ((NILP (newval)) ? 0 : 1);
1254 return; 1196 return;
1255 1197
1256 case SYMVAL_OBJECT_FORWARD: 1198 case SYMVAL_OBJECT_FORWARD:
1257 if (magicfun) 1199 if (magicfun)
1258 magicfun (sym, &newval, Qnil, 0); 1200 magicfun (sym, &newval, Qnil, 0);
1581 else 1523 else
1582 { 1524 {
1583 /* This can also get called while we're preparing to shutdown. 1525 /* This can also get called while we're preparing to shutdown.
1584 #### What should really happen in that case? Should we 1526 #### What should really happen in that case? Should we
1585 actually fix things so we can't get here in that case? */ 1527 actually fix things so we can't get here in that case? */
1586 #ifndef PDUMP
1587 assert (!initialized || preparing_for_armageddon); 1528 assert (!initialized || preparing_for_armageddon);
1588 #endif
1589 con = 0; 1529 con = 0;
1590 } 1530 }
1591 1531
1592 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1); 1532 return find_symbol_value_1 (sym, current_buffer, con, 1, Qnil, 1);
1593 } 1533 }
1619 else 1559 else
1620 { 1560 {
1621 /* This can also get called while we're preparing to shutdown. 1561 /* This can also get called while we're preparing to shutdown.
1622 #### What should really happen in that case? Should we 1562 #### What should really happen in that case? Should we
1623 actually fix things so we can't get here in that case? */ 1563 actually fix things so we can't get here in that case? */
1624 #ifndef PDUMP
1625 assert (!initialized || preparing_for_armageddon); 1564 assert (!initialized || preparing_for_armageddon);
1626 #endif
1627 con = 0; 1565 con = 0;
1628 } 1566 }
1629 1567
1630 return find_symbol_value_1 (sym, current_buffer, con, 1, 1568 return find_symbol_value_1 (sym, current_buffer, con, 1,
1631 find_it_p ? symbol_cons : Qnil, 1569 find_it_p ? symbol_cons : Qnil,
1649 Set SYMBOL's value to NEWVAL, and return NEWVAL. 1587 Set SYMBOL's value to NEWVAL, and return NEWVAL.
1650 */ 1588 */
1651 (symbol, newval)) 1589 (symbol, newval))
1652 { 1590 {
1653 REGISTER Lisp_Object valcontents; 1591 REGISTER Lisp_Object valcontents;
1654 Lisp_Symbol *sym; 1592 struct Lisp_Symbol *sym;
1655 /* remember, we're called by Fmakunbound() as well */ 1593 /* remember, we're called by Fmakunbound() as well */
1656 1594
1657 CHECK_SYMBOL (symbol); 1595 CHECK_SYMBOL (symbol);
1658 1596
1659 retry: 1597 retry:
1673 } 1611 }
1674 1612
1675 reject_constant_symbols (symbol, newval, 0, 1613 reject_constant_symbols (symbol, newval, 0,
1676 UNBOUNDP (newval) ? Qmakunbound : Qset); 1614 UNBOUNDP (newval) ? Qmakunbound : Qset);
1677 1615
1616 retry_2:
1617
1678 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents)) 1618 switch (XSYMBOL_VALUE_MAGIC_TYPE (valcontents))
1679 { 1619 {
1680 case SYMVAL_LISP_MAGIC: 1620 case SYMVAL_LISP_MAGIC:
1681 { 1621 {
1622 Lisp_Object retval;
1623
1682 if (UNBOUNDP (newval)) 1624 if (UNBOUNDP (newval))
1683 { 1625 retval = maybe_call_magic_handler (symbol, Qmakunbound, 0);
1684 maybe_call_magic_handler (symbol, Qmakunbound, 0);
1685 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = Qunbound;
1686 }
1687 else 1626 else
1688 { 1627 retval = maybe_call_magic_handler (symbol, Qset, 1, newval);
1689 maybe_call_magic_handler (symbol, Qset, 1, newval); 1628 if (!UNBOUNDP (retval))
1690 return XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed = newval; 1629 return newval;
1691 } 1630 valcontents = XSYMBOL_VALUE_LISP_MAGIC (valcontents)->shadowed;
1631 /* semi-change-o */
1632 goto retry_2;
1692 } 1633 }
1693 1634
1694 case SYMVAL_VARALIAS: 1635 case SYMVAL_VARALIAS:
1695 symbol = follow_varalias_pointers (symbol, 1636 symbol = follow_varalias_pointers (symbol,
1696 UNBOUNDP (newval) 1637 UNBOUNDP (newval)
1710 1651
1711 /* case SYMVAL_UNBOUND_MARKER: break; */ 1652 /* case SYMVAL_UNBOUND_MARKER: break; */
1712 1653
1713 case SYMVAL_CURRENT_BUFFER_FORWARD: 1654 case SYMVAL_CURRENT_BUFFER_FORWARD:
1714 { 1655 {
1715 const struct symbol_value_forward *fwd 1656 CONST struct symbol_value_forward *fwd
1716 = XSYMBOL_VALUE_FORWARD (valcontents); 1657 = XSYMBOL_VALUE_FORWARD (valcontents);
1717 int mask = XINT (*((Lisp_Object *) 1658 int mask = XINT (*((Lisp_Object *)
1718 symbol_value_forward_forward (fwd))); 1659 symbol_value_forward_forward (fwd)));
1719 if (mask > 0) 1660 if (mask > 0)
1720 /* Setting this variable makes it buffer-local */ 1661 /* Setting this variable makes it buffer-local */
1722 break; 1663 break;
1723 } 1664 }
1724 1665
1725 case SYMVAL_SELECTED_CONSOLE_FORWARD: 1666 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1726 { 1667 {
1727 const struct symbol_value_forward *fwd 1668 CONST struct symbol_value_forward *fwd
1728 = XSYMBOL_VALUE_FORWARD (valcontents); 1669 = XSYMBOL_VALUE_FORWARD (valcontents);
1729 int mask = XINT (*((Lisp_Object *) 1670 int mask = XINT (*((Lisp_Object *)
1730 symbol_value_forward_forward (fwd))); 1671 symbol_value_forward_forward (fwd)));
1731 if (mask > 0) 1672 if (mask > 0)
1732 /* Setting this variable makes it console-local */ 1673 /* Setting this variable makes it console-local */
1860 case SYMVAL_UNBOUND_MARKER: 1801 case SYMVAL_UNBOUND_MARKER:
1861 return valcontents; 1802 return valcontents;
1862 1803
1863 case SYMVAL_CURRENT_BUFFER_FORWARD: 1804 case SYMVAL_CURRENT_BUFFER_FORWARD:
1864 { 1805 {
1865 const struct symbol_value_forward *fwd 1806 CONST struct symbol_value_forward *fwd
1866 = XSYMBOL_VALUE_FORWARD (valcontents); 1807 = XSYMBOL_VALUE_FORWARD (valcontents);
1867 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults) 1808 return (*((Lisp_Object *)((char *) XBUFFER (Vbuffer_defaults)
1868 + ((char *)symbol_value_forward_forward (fwd) 1809 + ((char *)symbol_value_forward_forward (fwd)
1869 - (char *)&buffer_local_flags)))); 1810 - (char *)&buffer_local_flags))));
1870 } 1811 }
1871 1812
1872 case SYMVAL_SELECTED_CONSOLE_FORWARD: 1813 case SYMVAL_SELECTED_CONSOLE_FORWARD:
1873 { 1814 {
1874 const struct symbol_value_forward *fwd 1815 CONST struct symbol_value_forward *fwd
1875 = XSYMBOL_VALUE_FORWARD (valcontents); 1816 = XSYMBOL_VALUE_FORWARD (valcontents);
1876 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults) 1817 return (*((Lisp_Object *)((char *) XCONSOLE (Vconsole_defaults)
1877 + ((char *)symbol_value_forward_forward (fwd) 1818 + ((char *)symbol_value_forward_forward (fwd)
1878 - (char *)&console_local_flags)))); 1819 - (char *)&console_local_flags))));
1879 } 1820 }
2309 /* presto change-o! */ 2250 /* presto change-o! */
2310 goto retry; 2251 goto retry;
2311 2252
2312 case SYMVAL_CURRENT_BUFFER_FORWARD: 2253 case SYMVAL_CURRENT_BUFFER_FORWARD:
2313 { 2254 {
2314 const struct symbol_value_forward *fwd 2255 CONST struct symbol_value_forward *fwd
2315 = XSYMBOL_VALUE_FORWARD (valcontents); 2256 = XSYMBOL_VALUE_FORWARD (valcontents);
2316 int offset = ((char *) symbol_value_forward_forward (fwd) 2257 int offset = ((char *) symbol_value_forward_forward (fwd)
2317 - (char *) &buffer_local_flags); 2258 - (char *) &buffer_local_flags);
2318 int mask = 2259 int mask =
2319 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); 2260 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2403 /* presto change-o! */ 2344 /* presto change-o! */
2404 goto retry; 2345 goto retry;
2405 2346
2406 case SYMVAL_SELECTED_CONSOLE_FORWARD: 2347 case SYMVAL_SELECTED_CONSOLE_FORWARD:
2407 { 2348 {
2408 const struct symbol_value_forward *fwd 2349 CONST struct symbol_value_forward *fwd
2409 = XSYMBOL_VALUE_FORWARD (valcontents); 2350 = XSYMBOL_VALUE_FORWARD (valcontents);
2410 int offset = ((char *) symbol_value_forward_forward (fwd) 2351 int offset = ((char *) symbol_value_forward_forward (fwd)
2411 - (char *) &console_local_flags); 2352 - (char *) &console_local_flags);
2412 int mask = 2353 int mask =
2413 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd))); 2354 XINT (*((Lisp_Object *) symbol_value_forward_forward (fwd)));
2462 /* presto change-o! */ 2403 /* presto change-o! */
2463 goto retry; 2404 goto retry;
2464 2405
2465 case SYMVAL_CURRENT_BUFFER_FORWARD: 2406 case SYMVAL_CURRENT_BUFFER_FORWARD:
2466 { 2407 {
2467 const struct symbol_value_forward *fwd 2408 CONST struct symbol_value_forward *fwd
2468 = XSYMBOL_VALUE_FORWARD (valcontents); 2409 = XSYMBOL_VALUE_FORWARD (valcontents);
2469 int mask = XINT (*((Lisp_Object *) 2410 int mask = XINT (*((Lisp_Object *)
2470 symbol_value_forward_forward (fwd))); 2411 symbol_value_forward_forward (fwd)));
2471 if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask))) 2412 if ((mask <= 0) || (buffer && (buffer->local_var_flags & mask)))
2472 /* Already buffer-local */ 2413 /* Already buffer-local */
2872 int i; 2813 int i;
2873 enum lisp_magic_handler htype; 2814 enum lisp_magic_handler htype;
2874 Lisp_Object legerdemain; 2815 Lisp_Object legerdemain;
2875 struct symbol_value_lisp_magic *bfwd; 2816 struct symbol_value_lisp_magic *bfwd;
2876 2817
2877 assert (nargs >= 0 && nargs < countof (args)); 2818 assert (nargs >= 0 && nargs < 20);
2878 legerdemain = XSYMBOL (sym)->value; 2819 legerdemain = XSYMBOL (sym)->value;
2879 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain)); 2820 assert (SYMBOL_VALUE_LISP_MAGIC_P (legerdemain));
2880 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain); 2821 bfwd = XSYMBOL_VALUE_LISP_MAGIC (legerdemain);
2881 2822
2882 va_start (vargs, nargs); 2823 va_start (vargs, nargs);
3131 #ifndef Qnull_pointer 3072 #ifndef Qnull_pointer
3132 Lisp_Object Qnull_pointer; 3073 Lisp_Object Qnull_pointer;
3133 #endif 3074 #endif
3134 3075
3135 /* some losing systems can't have static vars at function scope... */ 3076 /* some losing systems can't have static vars at function scope... */
3136 static const struct symbol_value_magic guts_of_unbound_marker = 3077 static struct symbol_value_magic guts_of_unbound_marker =
3137 { /* struct symbol_value_magic */ 3078 { { symbol_value_forward_lheader_initializer, 0, 69},
3138 { /* struct lcrecord_header */ 3079 SYMVAL_UNBOUND_MARKER };
3139 { /* struct lrecord_header */
3140 lrecord_type_symbol_value_forward, /* lrecord_type_index */
3141 1, /* mark bit */
3142 1, /* c_readonly bit */
3143 1, /* lisp_readonly bit */
3144 },
3145 0, /* next */
3146 0, /* uid */
3147 0, /* free */
3148 },
3149 0, /* value */
3150 SYMVAL_UNBOUND_MARKER
3151 };
3152 3080
3153 void 3081 void
3154 init_symbols_once_early (void) 3082 init_symbols_once_early (void)
3155 { 3083 {
3156 INIT_LRECORD_IMPLEMENTATION (symbol); 3084 #ifndef Qzero
3157 INIT_LRECORD_IMPLEMENTATION (symbol_value_forward); 3085 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3158 INIT_LRECORD_IMPLEMENTATION (symbol_value_buffer_local); 3086 #endif
3159 INIT_LRECORD_IMPLEMENTATION (symbol_value_lisp_magic); 3087
3160 INIT_LRECORD_IMPLEMENTATION (symbol_value_varalias); 3088 #ifndef Qnull_pointer
3161 3089 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3162 reinit_symbols_once_early (); 3090 so the following is actually a no-op. */
3091 XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
3092 #endif
3163 3093
3164 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is 3094 /* Bootstrapping problem: Qnil isn't set when make_string_nocopy is
3165 called the first time. */ 3095 called the first time. */
3166 Qnil = Fmake_symbol (make_string_nocopy ((const Bufbyte *) "nil", 3)); 3096 Qnil = Fmake_symbol (make_string_nocopy ((CONST Bufbyte *) "nil", 3));
3167 XSYMBOL (Qnil)->name->plist = Qnil; 3097 XSYMBOL (Qnil)->name->plist = Qnil;
3168 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */ 3098 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihil */
3169 XSYMBOL (Qnil)->plist = Qnil; 3099 XSYMBOL (Qnil)->plist = Qnil;
3170 3100
3171 Vobarray = make_vector (OBARRAY_SIZE, Qzero); 3101 Vobarray = make_vector (OBARRAY_SIZE, Qzero);
3178 } 3108 }
3179 3109
3180 { 3110 {
3181 /* Required to get around a GCC syntax error on certain 3111 /* Required to get around a GCC syntax error on certain
3182 architectures */ 3112 architectures */
3183 const struct symbol_value_magic *tem = &guts_of_unbound_marker; 3113 struct symbol_value_magic *tem = &guts_of_unbound_marker;
3184 3114
3185 XSETSYMBOL_VALUE_MAGIC (Qunbound, tem); 3115 XSETSYMBOL_VALUE_MAGIC (Qunbound, tem);
3186 } 3116 }
3117 if ((CONST void *) XPNTR (Qunbound) !=
3118 (CONST void *)&guts_of_unbound_marker)
3119 {
3120 /* This might happen on DATA_SEG_BITS machines. */
3121 /* abort (); */
3122 /* Can't represent a pointer to constant C data using a Lisp_Object.
3123 So heap-allocate it. */
3124 struct symbol_value_magic *urk = xnew (struct symbol_value_magic);
3125 memcpy (urk, &guts_of_unbound_marker, sizeof (*urk));
3126 XSETSYMBOL_VALUE_MAGIC (Qunbound, urk);
3127 }
3187 3128
3188 XSYMBOL (Qnil)->function = Qunbound; 3129 XSYMBOL (Qnil)->function = Qunbound;
3189 3130
3190 defsymbol (&Qt, "t"); 3131 defsymbol (&Qt, "t");
3191 XSYMBOL (Qt)->value = Qt; /* Veritas aetera */ 3132 XSYMBOL (Qt)->value = Qt; /* Veritas aetera */
3192 Vquit_flag = Qnil; 3133 Vquit_flag = Qnil;
3193
3194 pdump_wire (&Qnil);
3195 pdump_wire (&Qunbound);
3196 pdump_wire (&Vquit_flag);
3197 } 3134 }
3198 3135
3199 void 3136 void
3200 reinit_symbols_once_early (void) 3137 defsymbol (Lisp_Object *location, CONST char *name)
3201 { 3138 {
3202 #ifndef Qzero 3139 *location = Fintern (make_string_nocopy ((CONST Bufbyte *) name,
3203 Qzero = make_int (0); /* Only used if Lisp_Object is a union type */
3204 #endif
3205
3206 #ifndef Qnull_pointer
3207 /* C guarantees that Qnull_pointer will be initialized to all 0 bits,
3208 so the following is actually a no-op. */
3209 XSETOBJ (Qnull_pointer, (enum Lisp_Type) 0, 0);
3210 #endif
3211 }
3212
3213 void
3214 defsymbol_nodump (Lisp_Object *location, const char *name)
3215 {
3216 *location = Fintern (make_string_nocopy ((const Bufbyte *) name,
3217 strlen (name)),
3218 Qnil);
3219 staticpro_nodump (location);
3220 }
3221
3222 void
3223 defsymbol (Lisp_Object *location, const char *name)
3224 {
3225 *location = Fintern (make_string_nocopy ((const Bufbyte *) name,
3226 strlen (name)), 3140 strlen (name)),
3227 Qnil); 3141 Qnil);
3228 staticpro (location); 3142 staticpro (location);
3229 } 3143 }
3230 3144
3231 void 3145 void
3232 defkeyword (Lisp_Object *location, const char *name) 3146 defkeyword (Lisp_Object *location, CONST char *name)
3233 { 3147 {
3234 defsymbol (location, name); 3148 defsymbol (location, name);
3235 Fset (*location, *location); 3149 Fset (*location, *location);
3236 } 3150 }
3237 3151
3280 * it if required. 3194 * it if required.
3281 * 3195 *
3282 * FIXME: Should newsubr be staticpro()'ed? I dont think so but I need 3196 * FIXME: Should newsubr be staticpro()'ed? I dont think so but I need
3283 * a guru to check. 3197 * a guru to check.
3284 */ 3198 */
3285 #define check_module_subr() \ 3199 #define check_module_subr() \
3286 do { \ 3200 do { \
3287 if (initialized) { \ 3201 if (initialized) { \
3288 Lisp_Subr *newsubr = (Lisp_Subr *) xmalloc (sizeof (Lisp_Subr)); \ 3202 struct Lisp_Subr *newsubr; \
3289 memcpy (newsubr, subr, sizeof (Lisp_Subr)); \ 3203 newsubr = (Lisp_Subr *)xmalloc(sizeof(struct Lisp_Subr)); \
3290 subr->doc = (const char *)newsubr; \ 3204 memcpy (newsubr, subr, sizeof(struct Lisp_Subr)); \
3291 subr = newsubr; \ 3205 subr->doc = (CONST char *)newsubr; \
3292 } \ 3206 subr = newsubr; \
3207 } \
3293 } while (0) 3208 } while (0)
3294 #else /* ! HAVE_SHLIB */ 3209 #else /* ! HAVE_SHLIB */
3295 #define check_module_subr() 3210 #define check_module_subr()
3296 #endif 3211 #endif
3297 3212
3321 XSETSUBR (fun, subr); 3236 XSETSUBR (fun, subr);
3322 XSYMBOL (sym)->function = Fcons (Qmacro, fun); 3237 XSYMBOL (sym)->function = Fcons (Qmacro, fun);
3323 } 3238 }
3324 3239
3325 void 3240 void
3326 deferror (Lisp_Object *symbol, const char *name, const char *messuhhj, 3241 deferror (Lisp_Object *symbol, CONST char *name, CONST char *messuhhj,
3327 Lisp_Object inherits_from) 3242 Lisp_Object inherits_from)
3328 { 3243 {
3329 Lisp_Object conds; 3244 Lisp_Object conds;
3330 defsymbol (symbol, name); 3245 defsymbol (symbol, name);
3331 3246
3332 assert (SYMBOLP (inherits_from)); 3247 assert (SYMBOLP (inherits_from));
3333 conds = Fget (inherits_from, Qerror_conditions, Qnil); 3248 conds = Fget (inherits_from, Qerror_conditions, Qnil);
3334 Fput (*symbol, Qerror_conditions, Fcons (*symbol, conds)); 3249 pure_put (*symbol, Qerror_conditions, Fcons (*symbol, conds));
3335 /* NOT build_translated_string (). This function is called at load time 3250 /* NOT build_translated_string (). This function is called at load time
3336 and the string needs to get translated at run time. (This happens 3251 and the string needs to get translated at run time. (This happens
3337 in the function (display-error) in cmdloop.el.) */ 3252 in the function (display-error) in cmdloop.el.) */
3338 Fput (*symbol, Qerror_message, build_string (messuhhj)); 3253 pure_put (*symbol, Qerror_message, build_string (messuhhj));
3339 } 3254 }
3340 3255
3341 void 3256 void
3342 syms_of_symbols (void) 3257 syms_of_symbols (void)
3343 { 3258 {
3352 defsymbol (&Qmake_unbound, "make-unbound"); 3267 defsymbol (&Qmake_unbound, "make-unbound");
3353 defsymbol (&Qlocal_predicate, "local-predicate"); 3268 defsymbol (&Qlocal_predicate, "local-predicate");
3354 defsymbol (&Qmake_local, "make-local"); 3269 defsymbol (&Qmake_local, "make-local");
3355 3270
3356 defsymbol (&Qboundp, "boundp"); 3271 defsymbol (&Qboundp, "boundp");
3272 defsymbol (&Qfboundp, "fboundp");
3357 defsymbol (&Qglobally_boundp, "globally-boundp"); 3273 defsymbol (&Qglobally_boundp, "globally-boundp");
3358 defsymbol (&Qmakunbound, "makunbound"); 3274 defsymbol (&Qmakunbound, "makunbound");
3359 defsymbol (&Qsymbol_value, "symbol-value"); 3275 defsymbol (&Qsymbol_value, "symbol-value");
3360 defsymbol (&Qset, "set"); 3276 defsymbol (&Qset, "set");
3361 defsymbol (&Qsetq_default, "setq-default"); 3277 defsymbol (&Qsetq_default, "setq-default");
3419 DEFSUBR (Fdontusethis_set_symbol_value_handler); 3335 DEFSUBR (Fdontusethis_set_symbol_value_handler);
3420 } 3336 }
3421 3337
3422 /* Create and initialize a Lisp variable whose value is forwarded to C data */ 3338 /* Create and initialize a Lisp variable whose value is forwarded to C data */
3423 void 3339 void
3424 defvar_magic (const char *symbol_name, const struct symbol_value_forward *magic) 3340 defvar_magic (CONST char *symbol_name, CONST struct symbol_value_forward *magic)
3425 { 3341 {
3426 Lisp_Object sym; 3342 Lisp_Object sym, kludge;
3343
3344 /* Check that `magic' points somewhere we can represent as a Lisp pointer */
3345 XSETOBJ (kludge, Lisp_Type_Record, magic);
3346 if ((void *)magic != (void*) XPNTR (kludge))
3347 {
3348 /* This might happen on DATA_SEG_BITS machines. */
3349 /* abort (); */
3350 /* Copy it to somewhere which is representable. */
3351 struct symbol_value_forward *p = xnew (struct symbol_value_forward);
3352 memcpy (p, magic, sizeof *magic);
3353 magic = p;
3354 }
3427 3355
3428 #if defined(HAVE_SHLIB) 3356 #if defined(HAVE_SHLIB)
3429 /* 3357 /*
3430 * As with defsubr(), this will only be called in a dumped Emacs when 3358 * As with defsubr(), this will only be called in a dumped Emacs when
3431 * we are adding variables from a dynamically loaded module. That means 3359 * we are adding variables from a dynamically loaded module. That means
3433 */ 3361 */
3434 if (initialized) 3362 if (initialized)
3435 sym = Fintern (build_string (symbol_name), Qnil); 3363 sym = Fintern (build_string (symbol_name), Qnil);
3436 else 3364 else
3437 #endif 3365 #endif
3438 sym = Fintern (make_string_nocopy ((const Bufbyte *) symbol_name, 3366 sym = Fintern (make_string_nocopy ((CONST Bufbyte *) symbol_name,
3439 strlen (symbol_name)), Qnil); 3367 strlen (symbol_name)), Qnil);
3440 3368
3441 XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic); 3369 XSETOBJ (XSYMBOL (sym)->value, Lisp_Type_Record, magic);
3442 } 3370 }
3443 3371