Mercurial > hg > xemacs-beta

comparison src/symbols.c @ 70:131b0175ea99 r20-0b30

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b30
author cvs
date Mon, 13 Aug 2007 09:02:59 +0200
parents 4103f0995bd7
children 1ce6082ce73f
comparison
equal deleted inserted replaced
69:804d1389bcd6 70:131b0175ea99
326 break; 326 break;
327 } 327 }
328 return (make_int (hash)); 328 return (make_int (hash));
329 } 329 }
330 330
331 #if 0 /* Emacs 19.34 */
332 int 331 int
333 hash_string (CONST Bufbyte *ptr, Bytecount len) 332 hash_string (CONST Bufbyte *ptr, Bytecount len)
334 { 333 {
335 CONST Bufbyte *p = ptr; 334 CONST Bufbyte *p = ptr;
336 CONST Bufbyte *end = p + len; 335 CONST Bufbyte *end = p + len;
340 while (p != end) 339 while (p != end)
341 { 340 {
342 c = *p++; 341 c = *p++;
343 if (c >= 0140) c -= 40; 342 if (c >= 0140) c -= 40;
344 hash = ((hash<<3) + (hash>>28) + c); 343 hash = ((hash<<3) + (hash>>28) + c);
345 }
346 return hash & 07777777777;
347 }
348 #endif
349
350 /* derived from hashpjw, Dragon Book P436. */
351 int
352 hash_string (CONST Bufbyte *ptr, Bytecount len)
353 {
354 CONST Bufbyte *p = ptr;
355 int hash = 0, g;
356 Bytecount count = len;
357
358 while (count-- > 0)
359 {
360 hash = (hash << 4) + *p++;
361 if (g = (hash & 0xf0000000)) {
362 hash = hash ^ (g >> 24);
363 hash = hash ^ g;
364 }
365 } 344 }
366 return hash & 07777777777; 345 return hash & 07777777777;
367 } 346 }
368 347
369 void 348 void
455 434
456 /* Extract and set components of symbols */ 435 /* Extract and set components of symbols */
457 436
458 static void set_up_buffer_local_cache (Lisp_Object sym, 437 static void set_up_buffer_local_cache (Lisp_Object sym,
459 struct symbol_value_buffer_local *bfwd, 438 struct symbol_value_buffer_local *bfwd,
460 struct buffer *buf, 439 struct buffer *buf);
461 Lisp_Object new_alist_el,
462 int set_it_p);
463 440
464 DEFUN ("boundp", Fboundp, 1, 1, 0, /* 441 DEFUN ("boundp", Fboundp, 1, 1, 0, /*
465 T if SYMBOL's value is not void. 442 T if SYMBOL's value is not void.
466 */ 443 */
467 (sym)) 444 (sym))
497 { 474 {
498 /* #### - I wonder if it would be better to just have a new magic value 475 /* #### - I wonder if it would be better to just have a new magic value
499 type and make nil, t, and all keywords have that same magic 476 type and make nil, t, and all keywords have that same magic
500 constant_symbol value. This test is awfully specific about what is 477 constant_symbol value. This test is awfully specific about what is
501 constant and what isn't. --Stig */ 478 constant and what isn't. --Stig */
502 return 479 return (NILP (sym) || EQ (sym, Qt)
503 NILP (sym) || 480 || (SYMBOL_VALUE_MAGIC_P (val)
504 EQ (sym, Qt) || 481 && (XSYMBOL_VALUE_MAGIC_TYPE (val) ==
505 (SYMBOL_VALUE_MAGIC_P (val) && 482 SYMVAL_CONST_OBJECT_FORWARD ||
506 (XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_OBJECT_FORWARD || 483 XSYMBOL_VALUE_MAGIC_TYPE (val) ==
507 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD || 484 SYMVAL_CONST_SPECIFIER_FORWARD ||
508 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_FIXNUM_FORWARD || 485 XSYMBOL_VALUE_MAGIC_TYPE (val) ==
509 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_BOOLEAN_FORWARD || 486 SYMVAL_CONST_FIXNUM_FORWARD ||
510 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_CURRENT_BUFFER_FORWARD || 487 XSYMBOL_VALUE_MAGIC_TYPE (val) ==
511 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SELECTED_CONSOLE_FORWARD)) 488 SYMVAL_CONST_BOOLEAN_FORWARD ||
489 XSYMBOL_VALUE_MAGIC_TYPE (val) ==
490 SYMVAL_CONST_CURRENT_BUFFER_FORWARD ||
491 XSYMBOL_VALUE_MAGIC_TYPE (val) ==
492 SYMVAL_CONST_SELECTED_CONSOLE_FORWARD))
512 #if 0 493 #if 0
513 /* #### - This is disabled until a new magic symbol_value for 494 /* #### - This is disabled until a new magic symbol_value for
514 constants is added */ 495 constants is added */
515 || SYMBOL_IS_KEYWORD (sym) 496 || SYMBOL_IS_KEYWORD (sym)
516 #endif 497 #endif
517 ; 498 );
518 } 499 }
519 500
520 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is 501 /* We are setting SYM's value slot (or function slot, if FUNCTION_P is
521 non-zero) to NEWVAL. Make sure this is allowed. NEWVAL is only 502 non-zero) to NEWVAL. Make sure this is allowed. NEWVAL is only
522 used in the error message. FOLLOW_PAST_LISP_MAGIC specifies 503 used in the error message. FOLLOW_PAST_LISP_MAGIC specifies
530 Lisp_Object val = 511 Lisp_Object val =
531 (function_p ? XSYMBOL (sym)->function 512 (function_p ? XSYMBOL (sym)->function
532 : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic)); 513 : fetch_value_maybe_past_magic (sym, follow_past_lisp_magic));
533 514
534 if (SYMBOL_VALUE_MAGIC_P (val) && 515 if (SYMBOL_VALUE_MAGIC_P (val) &&
535 XSYMBOL_VALUE_MAGIC_TYPE (val) == SYMVAL_CONST_SPECIFIER_FORWARD) 516 XSYMBOL_VALUE_MAGIC_TYPE (val) ==
517 SYMVAL_CONST_SPECIFIER_FORWARD)
536 signal_simple_error ("Use `set-specifier' to change a specifier's value", 518 signal_simple_error ("Use `set-specifier' to change a specifier's value",
537 sym); 519 sym);
538 520
539 if (symbol_is_constant (sym, val)) 521 if (symbol_is_constant (sym, val))
540 signal_error (Qsetting_constant, 522 {
541 UNBOUNDP (newval) ? list1 (sym) : list2 (sym, newval)); 523 signal_error (Qsetting_constant,
524 ((UNBOUNDP (newval))
525 ? list1 (sym)
526 : list2 (sym, newval)));
527 }
542 } 528 }
543 529
544 /* Verify that it's ok to make SYM buffer-local. This rejects 530 /* Verify that it's ok to make SYM buffer-local. This rejects
545 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC 531 constants and default-buffer-local variables. FOLLOW_PAST_LISP_MAGIC
546 specifies whether we delve into symbol-value-lisp-magic objects. 532 specifies whether we delve into symbol-value-lisp-magic objects.
1296 */ 1282 */
1297 1283
1298 static void 1284 static void
1299 set_up_buffer_local_cache (Lisp_Object sym, 1285 set_up_buffer_local_cache (Lisp_Object sym,
1300 struct symbol_value_buffer_local *bfwd, 1286 struct symbol_value_buffer_local *bfwd,
1301 struct buffer *buf, 1287 struct buffer *buf)
1302 Lisp_Object new_alist_el, 1288 {
1303 int set_it_p) 1289 Lisp_Object new_alist_el, new_val;
1304 {
1305 Lisp_Object new_val;
1306 1290
1307 if (!NILP (bfwd->current_buffer) 1291 if (!NILP (bfwd->current_buffer)
1308 && buf == XBUFFER (bfwd->current_buffer)) 1292 && buf == XBUFFER (bfwd->current_buffer))
1309 /* Cache is already set up. */ 1293 /* Cache is already set up. */
1310 return; 1294 return;
1311 1295
1312 /* Flush out the old cache. */ 1296 /* Flush out the old cache. */
1313 write_out_buffer_local_cache (sym, bfwd); 1297 write_out_buffer_local_cache (sym, bfwd);
1314 1298
1315 /* Retrieve the new alist element and new value. */ 1299 /* Retrieve the new alist element and new value. */
1316 if (NILP (new_alist_el)
1317 && set_it_p)
1318 new_alist_el = buffer_local_alist_element (buf, sym, bfwd); 1300 new_alist_el = buffer_local_alist_element (buf, sym, bfwd);
1319
1320 if (NILP (new_alist_el)) 1301 if (NILP (new_alist_el))
1321 new_val = bfwd->default_value; 1302 new_val = bfwd->default_value;
1322 else 1303 else
1323 new_val = Fcdr (new_alist_el); 1304 new_val = Fcdr (new_alist_el);
1324 1305
1386 variable forwards to a C variable, we need to change the 1367 variable forwards to a C variable, we need to change the
1387 value of the C variable. set_up_buffer_local_cache() 1368 value of the C variable. set_up_buffer_local_cache()
1388 will do this. It doesn't hurt to do it whenever 1369 will do this. It doesn't hurt to do it whenever
1389 BUF == current_buffer, so just go ahead and do that. */ 1370 BUF == current_buffer, so just go ahead and do that. */
1390 if (buf == current_buffer) 1371 if (buf == current_buffer)
1391 set_up_buffer_local_cache (sym, bfwd, buf, Qnil, 0); 1372 set_up_buffer_local_cache (sym, bfwd, buf);
1392 } 1373 }
1393 } 1374 }
1394 } 1375 }
1395 1376
1396 static Lisp_Object 1377 static Lisp_Object
1397 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf, 1378 find_symbol_value_1 (Lisp_Object sym, struct buffer *buf,
1398 struct console *con, int swap_it_in, 1379 struct console *con, int swap_it_in)
1399 Lisp_Object symcons, int set_it_p)
1400 { 1380 {
1401 Lisp_Object valcontents; 1381 Lisp_Object valcontents;
1402 1382
1403 retry: 1383 retry:
1404 valcontents = XSYMBOL (sym)->value; 1384 valcontents = XSYMBOL (sym)->value;
1415 /* semi-change-o */ 1395 /* semi-change-o */
1416 goto retry_2; 1396 goto retry_2;
1417 1397
1418 case SYMVAL_VARALIAS: 1398 case SYMVAL_VARALIAS:
1419 sym = follow_varalias_pointers (sym, Qt /* #### kludge */); 1399 sym = follow_varalias_pointers (sym, Qt /* #### kludge */);
1420 symcons = Qnil;
1421 /* presto change-o! */ 1400 /* presto change-o! */
1422 goto retry; 1401 goto retry;
1423 1402
1424 case SYMVAL_BUFFER_LOCAL: 1403 case SYMVAL_BUFFER_LOCAL:
1425 case SYMVAL_SOME_BUFFER_LOCAL: 1404 case SYMVAL_SOME_BUFFER_LOCAL:
1427 struct symbol_value_buffer_local *bfwd 1406 struct symbol_value_buffer_local *bfwd
1428 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents); 1407 = XSYMBOL_VALUE_BUFFER_LOCAL (valcontents);
1429 1408
1430 if (swap_it_in) 1409 if (swap_it_in)
1431 { 1410 {
1432 set_up_buffer_local_cache (sym, bfwd, buf, symcons, set_it_p); 1411 set_up_buffer_local_cache (sym, bfwd, buf);
1433 valcontents = bfwd->current_value; 1412 valcontents = bfwd->current_value;
1434 } 1413 }
1435 else 1414 else
1436 { 1415 {
1437 if (!NILP (bfwd->current_buffer) && 1416 if (!NILP (bfwd->current_buffer) &&
1438 buf == XBUFFER (bfwd->current_buffer)) 1417 buf == XBUFFER (bfwd->current_buffer))
1439 valcontents = bfwd->current_value; 1418 valcontents = bfwd->current_value;
1440 else if (NILP (symcons)) 1419 else
1441 { 1420 {
1442 if (set_it_p)
1443 valcontents = assq_no_quit (sym, buf->local_var_alist); 1421 valcontents = assq_no_quit (sym, buf->local_var_alist);
1444 if (NILP (valcontents)) 1422 if (NILP (valcontents))
1445 valcontents = bfwd->default_value; 1423 valcontents = bfwd->default_value;
1446 else 1424 else
1447 valcontents = XCDR (valcontents); 1425 valcontents = Fcdr (valcontents);
1448 } 1426 }
1449 else
1450 valcontents = XCDR (symcons);
1451 } 1427 }
1452 break; 1428 break;
1453 } 1429 }
1454 1430
1455 default: 1431 default:
1480 1456
1481 return find_symbol_value_1 (sym, buf, 1457 return find_symbol_value_1 (sym, buf,
1482 /* If it bombs out at startup due to a 1458 /* If it bombs out at startup due to a
1483 Lisp error, this may be nil. */ 1459 Lisp error, this may be nil. */
1484 CONSOLEP (Vselected_console) 1460 CONSOLEP (Vselected_console)
1485 ? XCONSOLE (Vselected_console) : 0, 0, Qnil, 1); 1461 ? XCONSOLE (Vselected_console) : 0, 0);
1486 } 1462 }
1487 1463
1488 static Lisp_Object 1464 static Lisp_Object
1489 symbol_value_in_console (Lisp_Object sym, Lisp_Object console) 1465 symbol_value_in_console (Lisp_Object sym, Lisp_Object console)
1490 { 1466 {
1493 if (!NILP (console)) 1469 if (!NILP (console))
1494 CHECK_CONSOLE (console); 1470 CHECK_CONSOLE (console);
1495 else 1471 else
1496 console = Vselected_console; 1472 console = Vselected_console;
1497 1473
1498 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0, 1474 return find_symbol_value_1 (sym, current_buffer, XCONSOLE (console), 0);
1499 Qnil, 1);
1500 } 1475 }
1501 1476
1502 /* Return the current value of SYM. The difference between this function 1477 /* Return the current value of SYM. The difference between this function
1503 and calling symbol_value_in_buffer with a BUFFER of Qnil is that 1478 and calling symbol_value_in_buffer with a BUFFER of Qnil is that
1504 this updates the CURRENT_VALUE slot of buffer-local variables to 1479 this updates the CURRENT_VALUE slot of buffer-local variables to
1521 actually fix things so we can't get here in that case? */ 1496 actually fix things so we can't get here in that case? */
1522 assert (!initialized || preparing_for_armageddon); 1497 assert (!initialized || preparing_for_armageddon);
1523 dev = 0; 1498 dev = 0;
1524 } 1499 }
1525 1500
1526 return find_symbol_value_1 (sym, current_buffer, dev, 1, Qnil, 1); 1501 return find_symbol_value_1 (sym, current_buffer, dev, 1);
1527 }
1528
1529 /* This is an optimized function for quick lookup of buffer local symbols
1530 by avoiding O(n) search. This will work when either:
1531 a) We have already found the symbol e.g. by traversing local_var_alist.
1532 or
1533 b) We know that the symbol will not be found in the current buffer's
1534 list of local variables.
1535 In the former case, find_it_p is 1 and symbol_cons is the element from
1536 local_var_alist. In the latter case, find_it_p is 0 and symbol_cons
1537 is the symbol.
1538
1539 This function is called from set_buffer_internal which does both of these
1540 things. */
1541
1542 Lisp_Object
1543 find_symbol_value_quickly (Lisp_Object symbol_cons, int find_it_p)
1544 {
1545 /* WARNING: This function can be called when current_buffer is 0
1546 and Vselected_console is Qnil, early in initialization. */
1547 struct console *dev;
1548 Lisp_Object sym = find_it_p ? XCAR (symbol_cons) : symbol_cons;
1549
1550 CHECK_SYMBOL (sym);
1551 if (CONSOLEP (Vselected_console))
1552 dev = XCONSOLE (Vselected_console);
1553 else
1554 {
1555 /* This can also get called while we're preparing to shutdown.
1556 #### What should really happen in that case? Should we
1557 actually fix things so we can't get here in that case? */
1558 assert (!initialized || preparing_for_armageddon);
1559 dev = 0;
1560 }
1561
1562 return find_symbol_value_1 (sym, current_buffer, dev, 1,
1563 find_it_p ? symbol_cons : Qnil,
1564 find_it_p);
1565 } 1502 }
1566 1503
1567 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /* 1504 DEFUN ("symbol-value", Fsymbol_value, 1, 1, 0, /*
1568 Return SYMBOL's value. Error if that is void. 1505 Return SYMBOL's value. Error if that is void.
1569 */ 1506 */
2189 { 2126 {
2190 case SYMVAL_FIXNUM_FORWARD: 2127 case SYMVAL_FIXNUM_FORWARD:
2191 case SYMVAL_BOOLEAN_FORWARD: 2128 case SYMVAL_BOOLEAN_FORWARD:
2192 case SYMVAL_OBJECT_FORWARD: 2129 case SYMVAL_OBJECT_FORWARD:
2193 case SYMVAL_DEFAULT_BUFFER_FORWARD: 2130 case SYMVAL_DEFAULT_BUFFER_FORWARD:
2194 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1); 2131 set_up_buffer_local_cache (variable, bfwd, current_buffer);
2195 break; 2132 break;
2196 2133
2197 case SYMVAL_UNBOUND_MARKER: 2134 case SYMVAL_UNBOUND_MARKER:
2198 case SYMVAL_CURRENT_BUFFER_FORWARD: 2135 case SYMVAL_CURRENT_BUFFER_FORWARD:
2199 break; 2136 break;
2285 /* We just changed the value in the current_buffer. If this 2222 /* We just changed the value in the current_buffer. If this
2286 variable forwards to a C variable, we need to change the 2223 variable forwards to a C variable, we need to change the
2287 value of the C variable. set_up_buffer_local_cache() 2224 value of the C variable. set_up_buffer_local_cache()
2288 will do this. It doesn't hurt to do it always, 2225 will do this. It doesn't hurt to do it always,
2289 so just go ahead and do that. */ 2226 so just go ahead and do that. */
2290 set_up_buffer_local_cache (variable, bfwd, current_buffer, Qnil, 1); 2227 set_up_buffer_local_cache (variable, bfwd, current_buffer);
2291 } 2228 }
2292 return (variable); 2229 return (variable);
2293 2230
2294 default: 2231 default:
2295 return (variable); 2232 return (variable);