Mercurial > hg > xemacs-beta

comparison src/elhash.c @ 187:b405438285a2 r20-3b20

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-3b20
author cvs
date Mon, 13 Aug 2007 09:56:28 +0200
parents 3d6bfa290dbd
children a2f645c6b9f8
comparison
equal deleted inserted replaced
186:24ac94803b48 187:b405438285a2
209 lisp_object_eql_equal (CONST void *x1, CONST void *x2) 209 lisp_object_eql_equal (CONST void *x1, CONST void *x2)
210 { 210 {
211 Lisp_Object obj1, obj2; 211 Lisp_Object obj1, obj2;
212 CVOID_TO_LISP (obj1, x1); 212 CVOID_TO_LISP (obj1, x1);
213 CVOID_TO_LISP (obj2, x2); 213 CVOID_TO_LISP (obj2, x2);
214 return 214 return FLOATP (obj1) ? !NILP (Fequal (obj1, obj2)) : EQ (obj1, obj2);
215 (FLOATP (obj1) ? !NILP (Fequal (obj1, obj2)) : EQ (obj1, obj2));
216 } 215 }
217 216
218 static unsigned long 217 static unsigned long
219 lisp_object_eql_hash (CONST void *x) 218 lisp_object_eql_hash (CONST void *x)
220 { 219 {
255 * LISP_OBJECTS_PER_HENTRY), 254 * LISP_OBJECTS_PER_HENTRY),
256 Qzero); 255 Qzero);
257 switch (test) 256 switch (test)
258 { 257 {
259 case HASHTABLE_EQ: 258 case HASHTABLE_EQ:
260 table->test_function = 0; 259 table->test_function = NULL;
261 table->hash_function = 0; 260 table->hash_function = NULL;
262 break; 261 break;
263 262
264 case HASHTABLE_EQL: 263 case HASHTABLE_EQL:
265 table->test_function = lisp_object_eql_equal; 264 table->test_function = lisp_object_eql_equal;
266 table->hash_function = lisp_object_eql_hash; 265 table->hash_function = lisp_object_eql_hash;
290 } 289 }
291 290
292 static enum hashtable_test_fun 291 static enum hashtable_test_fun
293 decode_hashtable_test_fun (Lisp_Object sym) 292 decode_hashtable_test_fun (Lisp_Object sym)
294 { 293 {
295 if (NILP (sym)) 294 if (NILP (sym)) return HASHTABLE_EQL;
296 return HASHTABLE_EQL;
297
298 CHECK_SYMBOL (sym);
299
300 if (EQ (sym, Qeq)) return HASHTABLE_EQ; 295 if (EQ (sym, Qeq)) return HASHTABLE_EQ;
301 if (EQ (sym, Qequal)) return HASHTABLE_EQUAL; 296 if (EQ (sym, Qequal)) return HASHTABLE_EQUAL;
302 if (EQ (sym, Qeql)) return HASHTABLE_EQL; 297 if (EQ (sym, Qeql)) return HASHTABLE_EQL;
303 298
304 signal_simple_error ("Invalid hashtable test fun", sym); 299 signal_simple_error ("Invalid hashtable test fun", sym);
364 return result; 359 return result;
365 } 360 }
366 361
367 362
368 DEFUN ("gethash", Fgethash, 2, 3, 0, /* 363 DEFUN ("gethash", Fgethash, 2, 3, 0, /*
369 Find hash value for KEY in TABLE. 364 Find hash value for KEY in HASHTABLE.
370 If there is no corresponding value, return DEFAULT (defaults to nil). 365 If there is no corresponding value, return DEFAULT (defaults to nil).
371 */ 366 */
372 (key, table, default_)) 367 (key, hashtable, default_))
373 { 368 {
374 CONST void *vval; 369 CONST void *vval;
375 struct _C_hashtable htbl; 370 struct _C_hashtable htbl;
376 if (!gc_in_progress) 371 if (!gc_in_progress)
377 CHECK_HASHTABLE (table); 372 CHECK_HASHTABLE (hashtable);
378 ht_copy_to_c (XHASHTABLE (table), &htbl); 373 ht_copy_to_c (XHASHTABLE (hashtable), &htbl);
379 if (gethash (LISP_TO_VOID (key), &htbl, &vval)) 374 if (gethash (LISP_TO_VOID (key), &htbl, &vval))
380 { 375 {
381 Lisp_Object val; 376 Lisp_Object val;
382 CVOID_TO_LISP (val, vval); 377 CVOID_TO_LISP (val, vval);
383 return val; 378 return val;
386 return default_; 381 return default_;
387 } 382 }
388 383
389 384
390 DEFUN ("remhash", Fremhash, 2, 2, 0, /* 385 DEFUN ("remhash", Fremhash, 2, 2, 0, /*
391 Remove hash value for KEY in TABLE. 386 Remove hash value for KEY in HASHTABLE.
392 */ 387 */
393 (key, table)) 388 (key, hashtable))
394 { 389 {
395 struct _C_hashtable htbl; 390 struct _C_hashtable htbl;
396 CHECK_HASHTABLE (table); 391 CHECK_HASHTABLE (hashtable);
397 392
398 ht_copy_to_c (XHASHTABLE (table), &htbl); 393 ht_copy_to_c (XHASHTABLE (hashtable), &htbl);
399 remhash (LISP_TO_VOID (key), &htbl); 394 remhash (LISP_TO_VOID (key), &htbl);
400 ht_copy_from_c (&htbl, XHASHTABLE (table)); 395 ht_copy_from_c (&htbl, XHASHTABLE (hashtable));
401 return Qnil; 396 return Qnil;
402 } 397 }
403 398
404 399
405 DEFUN ("puthash", Fputhash, 3, 3, 0, /* 400 DEFUN ("puthash", Fputhash, 3, 3, 0, /*
406 Hash KEY to VAL in TABLE. 401 Hash KEY to VAL in HASHTABLE.
407 */ 402 */
408 (key, val, table)) 403 (key, val, hashtable))
409 { 404 {
410 struct hashtable *ht; 405 struct hashtable *ht;
411 void *vkey = LISP_TO_VOID (key); 406 void *vkey = LISP_TO_VOID (key);
412 407
413 CHECK_HASHTABLE (table); 408 CHECK_HASHTABLE (hashtable);
414 ht = XHASHTABLE (table); 409 ht = XHASHTABLE (hashtable);
415 if (!vkey) 410 if (!vkey)
416 ht->zero_entry = val; 411 ht->zero_entry = val;
417 else 412 else
418 { 413 {
419 struct gcpro gcpro1, gcpro2, gcpro3; 414 struct gcpro gcpro1, gcpro2, gcpro3;
420 struct _C_hashtable htbl; 415 struct _C_hashtable htbl;
421 416
422 ht_copy_to_c (XHASHTABLE (table), &htbl); 417 ht_copy_to_c (XHASHTABLE (hashtable), &htbl);
423 GCPRO3 (key, val, table); 418 GCPRO3 (key, val, hashtable);
424 puthash (vkey, LISP_TO_VOID (val), &htbl); 419 puthash (vkey, LISP_TO_VOID (val), &htbl);
425 ht_copy_from_c (&htbl, XHASHTABLE (table)); 420 ht_copy_from_c (&htbl, XHASHTABLE (hashtable));
426 UNGCPRO; 421 UNGCPRO;
427 } 422 }
428 return val; 423 return val;
429 } 424 }
430 425
431 DEFUN ("clrhash", Fclrhash, 1, 1, 0, /* 426 DEFUN ("clrhash", Fclrhash, 1, 1, 0, /*
432 Flush TABLE. 427 Remove all entries from HASHTABLE.
433 */ 428 */
434 (table)) 429 (hashtable))
435 { 430 {
436 struct _C_hashtable htbl; 431 struct _C_hashtable htbl;
437 CHECK_HASHTABLE (table); 432 CHECK_HASHTABLE (hashtable);
438 ht_copy_to_c (XHASHTABLE (table), &htbl); 433 ht_copy_to_c (XHASHTABLE (hashtable), &htbl);
439 clrhash (&htbl); 434 clrhash (&htbl);
440 ht_copy_from_c (&htbl, XHASHTABLE (table)); 435 ht_copy_from_c (&htbl, XHASHTABLE (hashtable));
441 return Qnil; 436 return Qnil;
442 } 437 }
443 438
444 DEFUN ("hashtable-fullness", Fhashtable_fullness, 1, 1, 0, /* 439 DEFUN ("hashtable-fullness", Fhashtable_fullness, 1, 1, 0, /*
445 Return number of entries in TABLE. 440 Return number of entries in HASHTABLE.
446 */ 441 */
447 (table)) 442 (hashtable))
448 { 443 {
449 struct _C_hashtable htbl; 444 struct _C_hashtable htbl;
450 CHECK_HASHTABLE (table); 445 CHECK_HASHTABLE (hashtable);
451 ht_copy_to_c (XHASHTABLE (table), &htbl); 446 ht_copy_to_c (XHASHTABLE (hashtable), &htbl);
452 return make_int (htbl.fullness); 447 return make_int (htbl.fullness);
453 } 448 }
454 449
455 450
456 static void 451 static void
466 if (SUBRP (function) || COMPILED_FUNCTIONP (function)) 461 if (SUBRP (function) || COMPILED_FUNCTIONP (function))
467 return; 462 return;
468 else if (CONSP (function)) 463 else if (CONSP (function))
469 { 464 {
470 Lisp_Object funcar = Fcar (function); 465 Lisp_Object funcar = Fcar (function);
471 if ((SYMBOLP (funcar)) 466 if ((SYMBOLP (funcar)) && (EQ (funcar, Qlambda) ||
472 && (EQ (funcar, Qlambda) 467 EQ (funcar, Qautoload)))
473 || EQ (funcar, Qautoload)))
474 return; 468 return;
475 } 469 }
476 signal_error (Qinvalid_function, list1 (function)); 470 signal_error (Qinvalid_function, list1 (function));
477 } 471 }
478 472
489 call2 (fn, key, val); 483 call2 (fn, key, val);
490 } 484 }
491 485
492 486
493 DEFUN ("maphash", Fmaphash, 2, 2, 0, /* 487 DEFUN ("maphash", Fmaphash, 2, 2, 0, /*
494 Map FUNCTION over entries in TABLE, calling it with two args, 488 Map FUNCTION over entries in HASHTABLE, calling it with two args,
495 each key and value in the table. 489 each key and value in the table.
496 */ 490 */
497 (function, table)) 491 (function, hashtable))
498 { 492 {
499 struct _C_hashtable htbl; 493 struct _C_hashtable htbl;
500 struct gcpro gcpro1, gcpro2; 494 struct gcpro gcpro1, gcpro2;
501 495
502 verify_function (function, GETTEXT ("hashtable mapping function")); 496 verify_function (function, GETTEXT ("hashtable mapping function"));
503 CHECK_HASHTABLE (table); 497 CHECK_HASHTABLE (hashtable);
504 ht_copy_to_c (XHASHTABLE (table), &htbl); 498 ht_copy_to_c (XHASHTABLE (hashtable), &htbl);
505 GCPRO2 (table, function); 499 GCPRO2 (hashtable, function);
506 maphash (lisp_maphash_function, &htbl, LISP_TO_VOID (function)); 500 maphash (lisp_maphash_function, &htbl, LISP_TO_VOID (function));
507 UNGCPRO; 501 UNGCPRO;
508 return Qnil; 502 return Qnil;
509 } 503 }
510 504
511 505
512 /* This function is for mapping a *C* function over the elements of a 506 /* This function is for mapping a *C* function over the elements of a
513 lisp hashtable. 507 lisp hashtable.
514 */ 508 */
515 void 509 void
516 elisp_maphash (maphash_function function, Lisp_Object table, void *closure) 510 elisp_maphash (maphash_function function, Lisp_Object hashtable, void *closure)
517 { 511 {
518 struct _C_hashtable htbl; 512 struct _C_hashtable htbl;
519 513
520 if (!gc_in_progress) CHECK_HASHTABLE (table); 514 if (!gc_in_progress) CHECK_HASHTABLE (hashtable);
521 ht_copy_to_c (XHASHTABLE (table), &htbl); 515 ht_copy_to_c (XHASHTABLE (hashtable), &htbl);
522 maphash (function, &htbl, closure); 516 maphash (function, &htbl, closure);
523 } 517 }
524 518
525 void 519 void
526 elisp_map_remhash (remhash_predicate function, 520 elisp_map_remhash (remhash_predicate function, Lisp_Object hashtable,
527 Lisp_Object table, 521 void *closure)
528 void *closure)
529 { 522 {
530 struct _C_hashtable htbl; 523 struct _C_hashtable htbl;
531 524
532 if (!gc_in_progress) CHECK_HASHTABLE (table); 525 if (!gc_in_progress) CHECK_HASHTABLE (hashtable);
533 ht_copy_to_c (XHASHTABLE (table), &htbl); 526 ht_copy_to_c (XHASHTABLE (hashtable), &htbl);
534 map_remhash (function, &htbl, closure); 527 map_remhash (function, &htbl, closure);
535 ht_copy_from_c (&htbl, XHASHTABLE (table)); 528 ht_copy_from_c (&htbl, XHASHTABLE (hashtable));
536 } 529 }
537 530
538 #if 0 531 #if 0
539 void 532 void
540 elisp_table_op (Lisp_Object table, generic_hashtable_op op, void *arg1, 533 elisp_table_op (Lisp_Object table, generic_hashtable_op op, void *arg1,
693 686
694 if (! ((*obj_marked_p) (rest))) 687 if (! ((*obj_marked_p) (rest)))
695 /* The hashtable is probably garbage. Ignore it. */ 688 /* The hashtable is probably garbage. Ignore it. */
696 continue; 689 continue;
697 type = XHASHTABLE (rest)->type; 690 type = XHASHTABLE (rest)->type;
698 if (type == HASHTABLE_KEY_WEAK || type == HASHTABLE_VALUE_WEAK 691 if (type == HASHTABLE_KEY_WEAK ||
699 || type == HASHTABLE_KEY_CAR_WEAK 692 type == HASHTABLE_VALUE_WEAK ||
700 || type == HASHTABLE_VALUE_CAR_WEAK) 693 type == HASHTABLE_KEY_CAR_WEAK ||
694 type == HASHTABLE_VALUE_CAR_WEAK)
701 { 695 {
702 struct marking_closure fmh; 696 struct marking_closure fmh;
703 697
704 fmh.obj_marked_p = obj_marked_p; 698 fmh.obj_marked_p = obj_marked_p;
705 fmh.markobj = markobj; 699 fmh.markobj = markobj;