Mercurial > hg > xemacs-beta

comparison src/symbols.c @ 16:0293115a14e9 r19-15b91

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b91
author cvs
date Mon, 13 Aug 2007 08:49:20 +0200
parents ac2d302a0011
children 859a2309aef8
comparison
equal deleted inserted replaced
15:ad457d5f7d04 16:0293115a14e9
179 if (NILP (obarray)) obarray = Vobarray; 179 if (NILP (obarray)) obarray = Vobarray;
180 obarray = check_obarray (obarray); 180 obarray = check_obarray (obarray);
181 181
182 CHECK_STRING (str); 182 CHECK_STRING (str);
183 183
184 len = string_length (XSTRING (str)); 184 len = XSTRING_LENGTH (str);
185 sym = oblookup (obarray, string_data (XSTRING (str)), len); 185 sym = oblookup (obarray, XSTRING_DATA (str), len);
186 if (!INTP (sym)) 186 if (!INTP (sym))
187 /* Found it */ 187 /* Found it */
188 return sym; 188 return sym;
189 189
190 ptr = &vector_data (XVECTOR (obarray))[XINT (sym)]; 190 ptr = &vector_data (XVECTOR (obarray))[XINT (sym)];
191 191
192 if (purify_flag && ! purified (str)) 192 if (purify_flag && ! purified (str))
193 str = make_pure_pname (string_data (XSTRING (str)), len, 0); 193 str = make_pure_pname (XSTRING_DATA (str), len, 0);
194 sym = Fmake_symbol (str); 194 sym = Fmake_symbol (str);
195 195
196 if (SYMBOLP (*ptr)) 196 if (SYMBOLP (*ptr))
197 symbol_next (XSYMBOL (sym)) = XSYMBOL (*ptr); 197 symbol_next (XSYMBOL (sym)) = XSYMBOL (*ptr);
198 else 198 else
214 if (NILP (obarray)) obarray = Vobarray; 214 if (NILP (obarray)) obarray = Vobarray;
215 obarray = check_obarray (obarray); 215 obarray = check_obarray (obarray);
216 216
217 CHECK_STRING (str); 217 CHECK_STRING (str);
218 218
219 tem = oblookup (obarray, string_data (XSTRING (str)), 219 tem = oblookup (obarray, XSTRING_DATA (str), XSTRING_LENGTH (str));
220 string_length (XSTRING (str)));
221 if (!INTP (tem)) 220 if (!INTP (tem))
222 return tem; 221 return tem;
223 return Qnil; 222 return Qnil;
224 } 223 }
225 224
245 { 244 {
246 CHECK_STRING (name); 245 CHECK_STRING (name);
247 string = name; 246 string = name;
248 } 247 }
249 248
250 tem = oblookup (obarray, string_data (XSTRING (string)), 249 tem = oblookup (obarray, XSTRING_DATA (string), XSTRING_LENGTH (string));
251 string_length (XSTRING (string)));
252 if (INTP (tem)) 250 if (INTP (tem))
253 return Qnil; 251 return Qnil;
254 /* If arg was a symbol, don't delete anything but that symbol itself. */ 252 /* If arg was a symbol, don't delete anything but that symbol itself. */
255 if (SYMBOLP (name) && !EQ (name, tem)) 253 if (SYMBOLP (name) && !EQ (name, tem))
256 return Qnil; 254 return Qnil;
441 439
442 /* Extract and set components of symbols */ 440 /* Extract and set components of symbols */
443 441
444 static void set_up_buffer_local_cache (Lisp_Object sym, 442 static void set_up_buffer_local_cache (Lisp_Object sym,
445 struct symbol_value_buffer_local *bfwd, 443 struct symbol_value_buffer_local *bfwd,
446 struct buffer *buf); 444 struct buffer *buf,
445 Lisp_Object new_alist_el,
446 int set_it_p);
447 447
448 DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0 /* 448 DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0 /*
449 T if SYMBOL's value is not void. 449 T if SYMBOL's value is not void.
450 */ ) 450 */ )
451 (sym) 451 (sym)
484 { 484 {
485 /* #### - I wonder if it would be better to just have a new magic value 485 /* #### - I wonder if it would be better to just have a new magic value
486 type and make nil, t, and all keywords have that same magic 486 type and make nil, t, and all keywords have that same magic
487 constant_symbol value. This test is awfully specific about what is 487 constant_symbol value. This test is awfully specific about what is
488 constant and what isn't. --Stig */ 488 constant and what isn't. --Stig */
489 return (NILP (sym) || EQ (sym, Qt) 489 return
490 || (SYMBOL_VALUE_MAGIC_P (val) 490 NILP (sym) ||
491 && (XSYMBOL_VALUE_MAGIC_TYPE (val) == 491 EQ (sym, Qt) ||
492 SYMVAL_CONST_OBJECT_FORWARD || 492 (SYMBOL_VALUE_MAGIC_P (val) &&
493 XSYMBOL_VALUE_MAGIC_TYPE (val) == 493 (XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_OBJECT_FORWARD ||
494 SYMVAL_CONST_SPECIFIER_FORWARD || 494 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD ||
495 XSYMBOL_VALUE_MAGIC_TYPE (val) == 495 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_FIXNUM_FORWARD ||
496 SYMVAL_CONST_FIXNUM_FORWARD || 496 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_BOOLEAN_FORWARD ||
497 XSYMBOL_VALUE_MAGIC_TYPE (val) == 497 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_CURRENT_BUFFER_FORWARD ||
498 SYMVAL_CONST_BOOLEAN_FORWARD || 498 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SELECTED_CONSOLE_FORWARD))
499 XSYMBOL_VALUE_MAGIC_TYPE (val) ==
500 SYMVAL_CONST_CURRENT_BUFFER_FORWARD ||
501 XSYMBOL_VALUE_MAGIC_TYPE (val) ==
502 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD))
503 #if 0 499 #if 0
504 /* #### - This is disabled until a new magic symbol_value for 500 /* #### - This is disabled until a new magic symbol_value for
505 constants is added */ 501 constants is added */
506 || SYMBOL_IS_KEYWORD (sym) 502 || SYMBOL_IS_KEYWORD (sym)
507 #endif 503 #endif
508 ); 504 ;
509 } 505 }
510 506
511 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is 507 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is
512 non-zero) to NEWVAL. Make sure this is allowed. NEWVAL is only 508 non-zero) to NEWVAL. Make sure this is allowed. NEWVAL is only
513 used in the error message. FOLLOW_PAST_LISP_MAGIC specifies 509 used in the error message. FOLLOW_PAST_LISP_MAGIC specifies
521 Lisp_Object val = 517 Lisp_Object val =
522 (function_p ? XSYMBOL (sym)->function 518 (function_p ? XSYMBOL (sym)->function
523 : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic)); 519 : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic));
524 520
525 if (SYMBOL_VALUE_MAGIC_P (val) && 521 if (SYMBOL_VALUE_MAGIC_P (val) &&
526 XSYMBOL_VALUE_MAGIC_TYPE (val) == 522 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD)
527 SYMVAL_CONST_SPECIFIER_FORWARD)
528 signal_simple_error ("Use `set-specifier' to change a specifier's value", 523 signal_simple_error ("Use `set-specifier' to change a specifier's value",
529 sym); 524 sym);
530 525
531 if (symbol_is_constant (sym, val)) 526 if (symbol_is_constant (sym, val))
532 { 527 signal_error (Qsetting_constant,
533 signal_error (Qsetting_constant, 528 UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval));
534 ((UNBOUNDP (newval))
535 ? list1 (sym)
536 : list2 (sym, newval)));
537 }
538 } 529 }
539 530
540 /* Verify that it's ok to make SYM buffer-local. This rejects 531 /* Verify that it's ok to make SYM buffer-local. This rejects
541 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC 532 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC
542 specifies whether we delve into symbol-value-lisp-magic objects. 533 specifies whether we delve into symbol-value-lisp-magic objects.
1300 */ 1291 */
1301 1292
1302 static void 1293 static void
1303 set_up_buffer_local_cache (Lisp_Object sym, 1294 set_up_buffer_local_cache (Lisp_Object sym,
1304 struct symbol_value_buffer_local *bfwd, 1295 struct symbol_value_buffer_local *bfwd,
1305 struct buffer *buf) 1296 struct buffer *buf,
1306 { 1297 Lisp_Object new_alist_el,
1307 Lisp_Object new_alist_el, new_val; 1298 int set_it_p)
1299 {
1300 Lisp_Object new_val;
1308 1301
1309 if (!NILP (bfwd->current_buffer) 1302 if (!NILP (bfwd->current_buffer)
1310 && buf == XBUFFER (bfwd->current_buffer)) 1303 && buf == XBUFFER (bfwd->current_buffer))
1311 /* Cache is already set up. */ 1304 /* Cache is already set up. */
1312 return; 1305 return;
1313 1306
1314 /* Flush out the old cache. */ 1307 /* Flush out the old cache. */
1315 write_out_buffer_local_cache (sym, bfwd); 1308 write_out_buffer_local_cache (sym, bfwd);
1316 1309
1317 /* Retrieve the new alist element and new value. */ 1310 /* Retrieve the new alist element and new value. */
1311 if (NILP (new_alist_el)
1312 && set_it_p)
1318 new_alist_el = buffer_local_alist_element (buf, sym, bfwd); 1313 new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
1314
1319 if (NILP (new_alist_el)) 1315 if (NILP (new_alist_el))
1320 new_val = bfwd->default_value; 1316 new_val = bfwd->default_value;
1321 else 1317 else
1322 new_val = Fcdr (new_alist_el); 1318 new_val = Fcdr (new_alist_el);
1323 1319
1385 variable forwards to a C variable, we need to change the 1381 variable forwards to a C variable, we need to change the
1386 value of the C variable. set_up_buffer_local_cache() 1382 value of the C variable. set_up_buffer_local_cache()
1387 will do this. It doesn't hurt to do it whenever 1383 will do this. It doesn't hurt to do it whenever
1388 BUF == current_buffer, so just go ahead and do that. */ 1384 BUF == current_buffer, so just go ahead and do that. */
1389 if (buf == current_buffer) 1385 if (buf == current_buffer)
1390 set_up_buffer_local_cache (sym, bfwd, buf); 1386 set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0);
1391 } 1387 }
1392 } 1388 }
1393 } 1389 }
1394 1390
1395 static Lisp_Object 1391 static Lisp_Object
1396 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf, 1392 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
1397 struct console *con, int swap_it_in) 1393 struct console *con, int swap_it_in,
1394 Lisp_Object symcons, int set_it_p)
1398 { 1395 {
1399 Lisp_Object valcontents; 1396 Lisp_Object valcontents;
1400 1397
1401 retry: 1398 retry:
1402 valcontents = XSYMBOL (sym)->value; 1399 valcontents = XSYMBOL (sym)->value;
1413 /* semi-change-o */ 1410 /* semi-change-o */
1414 goto retry_2; 1411 goto retry_2;
1415 1412
1416 case SYMVAL_VARALIAS: 1413 case SYMVAL_VARALIAS:
1417 sym = follow_varalias_pointers (sym, Qt /* #### kludge */); 1414 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1415 symcons = Qnil;
1418 /* presto change-o! */ 1416 /* presto change-o! */
1419 goto retry; 1417 goto retry;
1420 1418
1421 case SYMVAL_BUFFER_LOCAL: 1419 case SYMVAL_BUFFER_LOCAL:
1422 case SYMVAL_SOME_BUFFER_LOCAL: 1420 case SYMVAL_SOME_BUFFER_LOCAL:
1424 struct symbol_value_buffer_local *bfwd 1422 struct symbol_value_buffer_local *bfwd
1425 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); 1423 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1426 1424
1427 if (swap_it_in) 1425 if (swap_it_in)
1428 { 1426 {
1429 set_up_buffer_local_cache (sym, bfwd, buf); 1427 set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p);
1430 valcontents = bfwd->current_value; 1428 valcontents = bfwd->current_value;
1431 } 1429 }
1432 else 1430 else
1433 { 1431 {
1434 if (!NILP (bfwd->current_buffer) && 1432 if (!NILP (bfwd->current_buffer) &&
1435 buf == XBUFFER (bfwd->current_buffer)) 1433 buf == XBUFFER (bfwd->current_buffer))
1436 valcontents = bfwd->current_value; 1434 valcontents = bfwd->current_value;
1437 else 1435 else if (NILP (symcons))
1438 { 1436 {
1437 if (set_it_p)
1439 valcontents = assq_no_quit (sym, buf->local_var_alist); 1438 valcontents = assq_no_quit (sym, buf->local_var_alist);
1440 if (NILP (valcontents)) 1439 if (NILP (valcontents))
1441 valcontents = bfwd->default_value; 1440 valcontents = bfwd->default_value;
1442 else 1441 else
1443 valcontents = Fcdr (valcontents); 1442 valcontents = XCDR (valcontents);
1444 } 1443 }
1444 else
1445 valcontents = XCDR (symcons);
1445 } 1446 }
1446 break; 1447 break;
1447 } 1448 }
1448 1449
1449 default: 1450 default:
1474 1475
1475 return find_symbol_value_1 (sym, buf, 1476 return find_symbol_value_1 (sym, buf,
1476 /* If it bombs out at startup due to a 1477 /* If it bombs out at startup due to a
1477 Lisp error, this may be nil. */ 1478 Lisp error, this may be nil. */
1478 CONSOLEP (Vselected_console) 1479 CONSOLEP (Vselected_console)
1479 ? XCONSOLE (Vselected_console) : 0, 0); 1480 ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1);
1480 } 1481 }
1481 1482
1482 static Lisp_Object 1483 static Lisp_Object
1483 symbol_value_in_console (Lisp_Object sym, Lisp_Object console) 1484 symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
1484 { 1485 {
1487 if (!NILP (console)) 1488 if (!NILP (console))
1488 CHECK_CONSOLE (console); 1489 CHECK_CONSOLE (console);
1489 else 1490 else
1490 console = Vselected_console; 1491 console = Vselected_console;
1491 1492
1492 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0); 1493 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0,
1494 Qnil, 1);
1493 } 1495 }
1494 1496
1495 /* Return the current value of SYM. The difference between this function 1497 /* Return the current value of SYM. The difference between this function
1496 and calling symbol_value_in_buffer with a BUFFER of Qnil is that 1498 and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1497 this updates the CURRENT_VALUE slot of buffer-local variables to 1499 this updates the CURRENT_VALUE slot of buffer-local variables to
1514 actually fix things so we can't get here in that case? */ 1516 actually fix things so we can't get here in that case? */
1515 assert (!initialized || preparing_for_armageddon); 1517 assert (!initialized || preparing_for_armageddon);
1516 dev = 0; 1518 dev = 0;
1517 } 1519 }
1518 1520
1519 return find_symbol_value_1 (sym, current_buffer, dev, 1); 1521 return find_symbol_value_1 (sym, current_buffer, dev, 1, Qnil, 1);
1522 }
1523
1524 /* This is an optimized function for quick lookup of buffer local symbols
1525 by avoiding O(n) search. This will work when either:
1526 a) We have already found the symbol e.g. by traversing local_var_alist.
1527 or
1528 b) We know that the symbol will not be found in the current buffer's
1529 list of local variables.
1530 In the former case, find_it_p is 1 and symbol_cons is the element from
1531 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
1532 is the symbol.
1533
1534 This function is called from set_buffer_internal which does both of these
1535 things. */
1536
1537 Lisp_Object
1538 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
1539 {
1540 /* WARNING: This function can be called when current_buffer is 0
1541 and Vselected_console is Qnil, early in initialization. */
1542 struct console *dev;
1543 Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
1544
1545 CHECK_SYMBOL (sym);
1546 if (CONSOLEP (Vselected_console))
1547 dev = XCONSOLE (Vselected_console);
1548 else
1549 {
1550 /* This can also get called while we're preparing to shutdown.
1551 #### What should really happen in that case? Should we
1552 actually fix things so we can't get here in that case? */
1553 assert (!initialized || preparing_for_armageddon);
1554 dev = 0;
1555 }
1556
1557 return find_symbol_value_1 (sym, current_buffer, dev, 1,
1558 find_it_p ? symbol_cons : Qnil,
1559 find_it_p);
1520 } 1560 }
1521 1561
1522 DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0 /* 1562 DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0 /*
1523 Return SYMBOL's value. Error if that is void. 1563 Return SYMBOL's value. Error if that is void.
1524 */ ) 1564 */ )
2154 { 2194 {
2155 case SYMVAL_FIXNUM_FORWARD: 2195 case SYMVAL_FIXNUM_FORWARD:
2156 case SYMVAL_BOOLEAN_FORWARD: 2196 case SYMVAL_BOOLEAN_FORWARD:
2157 case SYMVAL_OBJECT_FORWARD: 2197 case SYMVAL_OBJECT_FORWARD:
2158 case SYMVAL_DEFAULT_BUFFER_FORWARD: 2198 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2159 set_up_buffer_local_cache (variable, bfwd, current_buffer); 2199 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2160 break; 2200 break;
2161 2201
2162 case SYMVAL_UNBOUND_MARKER: 2202 case SYMVAL_UNBOUND_MARKER:
2163 case SYMVAL_CURRENT_BUFFER_FORWARD: 2203 case SYMVAL_CURRENT_BUFFER_FORWARD:
2164 break; 2204 break;
2252 /* We just changed the value in the current_buffer. If this 2292 /* We just changed the value in the current_buffer. If this
2253 variable forwards to a C variable, we need to change the 2293 variable forwards to a C variable, we need to change the
2254 value of the C variable. set_up_buffer_local_cache() 2294 value of the C variable. set_up_buffer_local_cache()
2255 will do this. It doesn't hurt to do it always, 2295 will do this. It doesn't hurt to do it always,
2256 so just go ahead and do that. */ 2296 so just go ahead and do that. */
2257 set_up_buffer_local_cache (variable, bfwd, current_buffer); 2297 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1);
2258 } 2298 }
2259 return (variable); 2299 return (variable);
2260 2300
2261 default: 2301 default:
2262 return (variable); 2302 return (variable);
3164 void 3204 void
3165 defsubr (struct Lisp_Subr *subr) 3205 defsubr (struct Lisp_Subr *subr)
3166 { 3206 {
3167 Lisp_Object sym = intern (subr_name (subr)); 3207 Lisp_Object sym = intern (subr_name (subr));
3168 3208
3169 /* Check that nobody spazzed */ 3209 #ifdef DEBUG_XEMACS
3210 /* Check that nobody spazzed writing a DEFUN. */
3211 assert (subr->min_args >= 0);
3212 assert (subr->min_args <= SUBR_MAX_ARGS);
3213
3170 if (subr->max_args != MANY && subr->max_args != UNEVALLED) 3214 if (subr->max_args != MANY && subr->max_args != UNEVALLED)
3171 { 3215 {
3172 if (subr->max_args > SUBR_MAX_ARGS /* Need to fix eval.c if so */ 3216 /* Need to fix lisp.h and eval.c if SUBR_MAX_ARGS too small */
3173 || subr->max_args < subr->min_args) 3217 assert (subr->max_args <= SUBR_MAX_ARGS);
3174 abort (); 3218 assert (subr->min_args <= subr->max_args);
3175 } 3219 }
3176 if (subr->min_args < 0 || subr->min_args > SUBR_MAX_ARGS) 3220
3177 abort (); 3221 assert (UNBOUNDP (XSYMBOL (sym)->function));
3178 3222 #endif /* DEBUG_XEMACS */
3179 if (!UNBOUNDP (XSYMBOL (sym)->function)) abort ();
3180 3223
3181 XSETSUBR (XSYMBOL (sym)->function, subr); 3224 XSETSUBR (XSYMBOL (sym)->function, subr);
3182 } 3225 }
3183 3226
3184 void 3227 void