48 |
#define NULL (void *)0 |
#define NULL (void *)0 |
49 |
#endif |
#endif |
50 |
|
|
51 |
|
#ifndef min |
52 |
|
#define min(a, b) ((a) < (b) ? (a) : (b)) |
53 |
|
#define max(a, b) ((a) > (b) ? (a) : (b)) |
54 |
|
#endif |
55 |
|
|
56 |
/* Nonzero enables use of dialog boxes for questions |
/* Nonzero enables use of dialog boxes for questions |
57 |
asked by mouse commands. */ |
asked by mouse commands. */ |
58 |
int use_dialog_box; |
int use_dialog_box; |
3179 |
*e++ = (unsigned char) (0xff & value); |
*e++ = (unsigned char) (0xff & value); |
3180 |
} |
} |
3181 |
} |
} |
3182 |
|
|
3183 |
|
|
3184 |
|
|
3185 |
|
/*********************************************************************** |
3186 |
|
***** ***** |
3187 |
|
***** Hash Tables ***** |
3188 |
|
***** ***** |
3189 |
|
***********************************************************************/ |
3190 |
|
|
3191 |
|
/* Implemented by gerd@gnu.org. This hash table implementation was |
3192 |
|
inspired by CMUCL hash tables. */ |
3193 |
|
|
3194 |
|
/* Ideas: |
3195 |
|
|
3196 |
|
1. For small tables, association lists are probably faster than |
3197 |
|
hash tables because they have lower overhead. |
3198 |
|
|
3199 |
|
For uses of hash tables where the O(1) behavior of table |
3200 |
|
operations is not a requirement, it might therefore be a good idea |
3201 |
|
not to hash. Instead, we could just do a linear search in the |
3202 |
|
key_and_value vector of the hash table. This could be done |
3203 |
|
if a `:linear-search t' argument is given to make-hash-table. */ |
3204 |
|
|
3205 |
|
|
3206 |
|
/* Return the contents of vector V at index IDX. */ |
3207 |
|
|
3208 |
|
#define AREF(V, IDX) XVECTOR (V)->contents[IDX] |
3209 |
|
|
3210 |
|
/* Value is the key part of entry IDX in hash table H. */ |
3211 |
|
|
3212 |
|
#define HASH_KEY(H, IDX) AREF ((H)->key_and_value, 2 * (IDX)) |
3213 |
|
|
3214 |
|
/* Value is the value part of entry IDX in hash table H. */ |
3215 |
|
|
3216 |
|
#define HASH_VALUE(H, IDX) AREF ((H)->key_and_value, 2 * (IDX) + 1) |
3217 |
|
|
3218 |
|
/* Value is the index of the next entry following the one at IDX |
3219 |
|
in hash table H. */ |
3220 |
|
|
3221 |
|
#define HASH_NEXT(H, IDX) AREF ((H)->next, (IDX)) |
3222 |
|
|
3223 |
|
/* Value is the hash code computed for entry IDX in hash table H. */ |
3224 |
|
|
3225 |
|
#define HASH_HASH(H, IDX) AREF ((H)->hash, (IDX)) |
3226 |
|
|
3227 |
|
/* Value is the index of the element in hash table H that is the |
3228 |
|
start of the collision list at index IDX in the index vector of H. */ |
3229 |
|
|
3230 |
|
#define HASH_INDEX(H, IDX) AREF ((H)->index, (IDX)) |
3231 |
|
|
3232 |
|
/* Value is the size of hash table H. */ |
3233 |
|
|
3234 |
|
#define HASH_TABLE_SIZE(H) XVECTOR ((H)->next)->size |
3235 |
|
|
3236 |
|
/* The list of all weak hash tables. Don't staticpro this one. */ |
3237 |
|
|
3238 |
|
Lisp_Object Vweak_hash_tables; |
3239 |
|
|
3240 |
|
/* Various symbols. */ |
3241 |
|
|
3242 |
|
Lisp_Object Qhash_table_p, Qeq, Qeql, Qequal, Qkey_weak, Qvalue_weak; |
3243 |
|
Lisp_Object Qkey_value_weak; |
3244 |
|
Lisp_Object QCtest, QCsize, QCrehash_size, QCrehash_threshold, QCweak; |
3245 |
|
Lisp_Object Qhash_table_test; |
3246 |
|
|
3247 |
|
/* Function prototypes. */ |
3248 |
|
|
3249 |
|
static struct Lisp_Hash_Table *check_hash_table P_ ((Lisp_Object)); |
3250 |
|
static int next_almost_prime P_ ((int)); |
3251 |
|
static int get_key_arg P_ ((Lisp_Object, int, Lisp_Object *, char *)); |
3252 |
|
static Lisp_Object larger_vector P_ ((Lisp_Object, int, Lisp_Object)); |
3253 |
|
static void maybe_resize_hash_table P_ ((struct Lisp_Hash_Table *)); |
3254 |
|
static int cmpfn_eq P_ ((struct Lisp_Hash_Table *, Lisp_Object, unsigned, |
3255 |
|
Lisp_Object, unsigned)); |
3256 |
|
static int cmpfn_eql P_ ((struct Lisp_Hash_Table *, Lisp_Object, unsigned, |
3257 |
|
Lisp_Object, unsigned)); |
3258 |
|
static int cmpfn_equal P_ ((struct Lisp_Hash_Table *, Lisp_Object, unsigned, |
3259 |
|
Lisp_Object, unsigned)); |
3260 |
|
static int cmpfn_user_defined P_ ((struct Lisp_Hash_Table *, Lisp_Object, |
3261 |
|
unsigned, Lisp_Object, unsigned)); |
3262 |
|
static unsigned hashfn_eq P_ ((struct Lisp_Hash_Table *, Lisp_Object)); |
3263 |
|
static unsigned hashfn_eql P_ ((struct Lisp_Hash_Table *, Lisp_Object)); |
3264 |
|
static unsigned hashfn_equal P_ ((struct Lisp_Hash_Table *, Lisp_Object)); |
3265 |
|
static unsigned hashfn_user_defined P_ ((struct Lisp_Hash_Table *, |
3266 |
|
Lisp_Object)); |
3267 |
|
static unsigned sxhash_string P_ ((unsigned char *, int)); |
3268 |
|
static unsigned sxhash_list P_ ((Lisp_Object, int)); |
3269 |
|
static unsigned sxhash_vector P_ ((Lisp_Object, int)); |
3270 |
|
static unsigned sxhash_bool_vector P_ ((Lisp_Object)); |
3271 |
|
|
3272 |
|
|
3273 |
|
|
3274 |
|
/*********************************************************************** |
3275 |
|
Utilities |
3276 |
|
***********************************************************************/ |
3277 |
|
|
3278 |
|
/* If OBJ is a Lisp hash table, return a pointer to its struct |
3279 |
|
Lisp_Hash_Table. Otherwise, signal an error. */ |
3280 |
|
|
3281 |
|
static struct Lisp_Hash_Table * |
3282 |
|
check_hash_table (obj) |
3283 |
|
Lisp_Object obj; |
3284 |
|
{ |
3285 |
|
CHECK_HASH_TABLE (obj, 0); |
3286 |
|
return XHASH_TABLE (obj); |
3287 |
|
} |
3288 |
|
|
3289 |
|
|
3290 |
|
/* Value is the next integer I >= N, N >= 0 which is "almost" a prime |
3291 |
|
number. */ |
3292 |
|
|
3293 |
|
static int |
3294 |
|
next_almost_prime (n) |
3295 |
|
int n; |
3296 |
|
{ |
3297 |
|
if (n % 2 == 0) |
3298 |
|
n += 1; |
3299 |
|
if (n % 3 == 0) |
3300 |
|
n += 2; |
3301 |
|
if (n % 7 == 0) |
3302 |
|
n += 4; |
3303 |
|
return n; |
3304 |
|
} |
3305 |
|
|
3306 |
|
|
3307 |
|
/* Find KEY in ARGS which has size NARGS. Don't consider indices for |
3308 |
|
which USED[I] is non-zero. If found at index I in ARGS, set |
3309 |
|
USED[I] and USED[I + 1] to 1, and return I + 1. Otherwise return |
3310 |
|
-1. This function is used to extract a keyword/argument pair from |
3311 |
|
a DEFUN parameter list. */ |
3312 |
|
|
3313 |
|
static int |
3314 |
|
get_key_arg (key, nargs, args, used) |
3315 |
|
Lisp_Object key; |
3316 |
|
int nargs; |
3317 |
|
Lisp_Object *args; |
3318 |
|
char *used; |
3319 |
|
{ |
3320 |
|
int i; |
3321 |
|
|
3322 |
|
for (i = 0; i < nargs - 1; ++i) |
3323 |
|
if (!used[i] && EQ (args[i], key)) |
3324 |
|
break; |
3325 |
|
|
3326 |
|
if (i >= nargs - 1) |
3327 |
|
i = -1; |
3328 |
|
else |
3329 |
|
{ |
3330 |
|
used[i++] = 1; |
3331 |
|
used[i] = 1; |
3332 |
|
} |
3333 |
|
|
3334 |
|
return i; |
3335 |
|
} |
3336 |
|
|
3337 |
|
|
3338 |
|
/* Return a Lisp vector which has the same contents as VEC but has |
3339 |
|
size NEW_SIZE, NEW_SIZE >= VEC->size. Entries in the resulting |
3340 |
|
vector that are not copied from VEC are set to INIT. */ |
3341 |
|
|
3342 |
|
static Lisp_Object |
3343 |
|
larger_vector (vec, new_size, init) |
3344 |
|
Lisp_Object vec; |
3345 |
|
int new_size; |
3346 |
|
Lisp_Object init; |
3347 |
|
{ |
3348 |
|
struct Lisp_Vector *v; |
3349 |
|
int i, old_size; |
3350 |
|
|
3351 |
|
xassert (VECTORP (vec)); |
3352 |
|
old_size = XVECTOR (vec)->size; |
3353 |
|
xassert (new_size >= old_size); |
3354 |
|
|
3355 |
|
v = allocate_vectorlike (new_size); |
3356 |
|
v->size = new_size; |
3357 |
|
bcopy (XVECTOR (vec)->contents, v->contents, |
3358 |
|
old_size * sizeof *v->contents); |
3359 |
|
for (i = old_size; i < new_size; ++i) |
3360 |
|
v->contents[i] = init; |
3361 |
|
XSETVECTOR (vec, v); |
3362 |
|
return vec; |
3363 |
|
} |
3364 |
|
|
3365 |
|
|
3366 |
|
/*********************************************************************** |
3367 |
|
Low-level Functions |
3368 |
|
***********************************************************************/ |
3369 |
|
|
3370 |
|
/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code |
3371 |
|
HASH2 in hash table H using `eq'. Value is non-zero if KEY1 and |
3372 |
|
KEY2 are the same. */ |
3373 |
|
|
3374 |
|
static int |
3375 |
|
cmpfn_eq (h, key1, hash1, key2, hash2) |
3376 |
|
struct Lisp_Hash_Table *h; |
3377 |
|
Lisp_Object key1, key2; |
3378 |
|
unsigned hash1, hash2; |
3379 |
|
{ |
3380 |
|
return EQ (key1, key2); |
3381 |
|
} |
3382 |
|
|
3383 |
|
|
3384 |
|
/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code |
3385 |
|
HASH2 in hash table H using `eql'. Value is non-zero if KEY1 and |
3386 |
|
KEY2 are the same. */ |
3387 |
|
|
3388 |
|
static int |
3389 |
|
cmpfn_eql (h, key1, hash1, key2, hash2) |
3390 |
|
struct Lisp_Hash_Table *h; |
3391 |
|
Lisp_Object key1, key2; |
3392 |
|
unsigned hash1, hash2; |
3393 |
|
{ |
3394 |
|
return (EQ (key1, key2) |
3395 |
|
|| (FLOATP (key1) |
3396 |
|
&& FLOATP (key2) |
3397 |
|
&& XFLOAT (key1)->data == XFLOAT (key2)->data)); |
3398 |
|
} |
3399 |
|
|
3400 |
|
|
3401 |
|
/* Compare KEY1 which has hash code HASH1 and KEY2 with hash code |
3402 |
|
HASH2 in hash table H using `equal'. Value is non-zero if KEY1 and |
3403 |
|
KEY2 are the same. */ |
3404 |
|
|
3405 |
|
static int |
3406 |
|
cmpfn_equal (h, key1, hash1, key2, hash2) |
3407 |
|
struct Lisp_Hash_Table *h; |
3408 |
|
Lisp_Object key1, key2; |
3409 |
|
unsigned hash1, hash2; |
3410 |
|
{ |
3411 |
|
return (EQ (key1, key2) |
3412 |
|
|| (hash1 == hash2 |
3413 |
|
&& !NILP (Fequal (key1, key2)))); |
3414 |
|
} |
3415 |
|
|
3416 |
|
|
3417 |
|
/* Compare KEY1 which has hash code HASH1, and KEY2 with hash code |
3418 |
|
HASH2 in hash table H using H->user_cmp_function. Value is non-zero |
3419 |
|
if KEY1 and KEY2 are the same. */ |
3420 |
|
|
3421 |
|
static int |
3422 |
|
cmpfn_user_defined (h, key1, hash1, key2, hash2) |
3423 |
|
struct Lisp_Hash_Table *h; |
3424 |
|
Lisp_Object key1, key2; |
3425 |
|
unsigned hash1, hash2; |
3426 |
|
{ |
3427 |
|
if (hash1 == hash2) |
3428 |
|
{ |
3429 |
|
Lisp_Object args[3]; |
3430 |
|
|
3431 |
|
args[0] = h->user_cmp_function; |
3432 |
|
args[1] = key1; |
3433 |
|
args[2] = key2; |
3434 |
|
return !NILP (Ffuncall (3, args)); |
3435 |
|
} |
3436 |
|
else |
3437 |
|
return 0; |
3438 |
|
} |
3439 |
|
|
3440 |
|
|
3441 |
|
/* Value is a hash code for KEY for use in hash table H which uses |
3442 |
|
`eq' to compare keys. The hash code returned is guaranteed to fit |
3443 |
|
in a Lisp integer. */ |
3444 |
|
|
3445 |
|
static unsigned |
3446 |
|
hashfn_eq (h, key) |
3447 |
|
struct Lisp_Hash_Table *h; |
3448 |
|
Lisp_Object key; |
3449 |
|
{ |
3450 |
|
/* Lisp strings can change their address. Don't try to compute a |
3451 |
|
hash code for a string from its address. */ |
3452 |
|
if (STRINGP (key)) |
3453 |
|
return sxhash_string (XSTRING (key)->data, XSTRING (key)->size); |
3454 |
|
else |
3455 |
|
return XUINT (key) ^ XGCTYPE (key); |
3456 |
|
} |
3457 |
|
|
3458 |
|
|
3459 |
|
/* Value is a hash code for KEY for use in hash table H which uses |
3460 |
|
`eql' to compare keys. The hash code returned is guaranteed to fit |
3461 |
|
in a Lisp integer. */ |
3462 |
|
|
3463 |
|
static unsigned |
3464 |
|
hashfn_eql (h, key) |
3465 |
|
struct Lisp_Hash_Table *h; |
3466 |
|
Lisp_Object key; |
3467 |
|
{ |
3468 |
|
/* Lisp strings can change their address. Don't try to compute a |
3469 |
|
hash code for a string from its address. */ |
3470 |
|
if (STRINGP (key)) |
3471 |
|
return sxhash_string (XSTRING (key)->data, XSTRING (key)->size); |
3472 |
|
else if (FLOATP (key)) |
3473 |
|
return sxhash (key, 0); |
3474 |
|
else |
3475 |
|
return XUINT (key) ^ XGCTYPE (key); |
3476 |
|
} |
3477 |
|
|
3478 |
|
|
3479 |
|
/* Value is a hash code for KEY for use in hash table H which uses |
3480 |
|
`equal' to compare keys. The hash code returned is guaranteed to fit |
3481 |
|
in a Lisp integer. */ |
3482 |
|
|
3483 |
|
static unsigned |
3484 |
|
hashfn_equal (h, key) |
3485 |
|
struct Lisp_Hash_Table *h; |
3486 |
|
Lisp_Object key; |
3487 |
|
{ |
3488 |
|
return sxhash (key, 0); |
3489 |
|
} |
3490 |
|
|
3491 |
|
|
3492 |
|
/* Value is a hash code for KEY for use in hash table H which uses as |
3493 |
|
user-defined function to compare keys. The hash code returned is |
3494 |
|
guaranteed to fit in a Lisp integer. */ |
3495 |
|
|
3496 |
|
static unsigned |
3497 |
|
hashfn_user_defined (h, key) |
3498 |
|
struct Lisp_Hash_Table *h; |
3499 |
|
Lisp_Object key; |
3500 |
|
{ |
3501 |
|
Lisp_Object args[2], hash; |
3502 |
|
|
3503 |
|
args[0] = h->user_hash_function; |
3504 |
|
args[1] = key; |
3505 |
|
hash = Ffuncall (2, args); |
3506 |
|
if (!INTEGERP (hash)) |
3507 |
|
Fsignal (Qerror, |
3508 |
|
list2 (build_string ("Illegal hash code returned from \ |
3509 |
|
user-supplied hash function"), |
3510 |
|
hash)); |
3511 |
|
return XUINT (hash); |
3512 |
|
} |
3513 |
|
|
3514 |
|
|
3515 |
|
/* Create and initialize a new hash table. |
3516 |
|
|
3517 |
|
TEST specifies the test the hash table will use to compare keys. |
3518 |
|
It must be either one of the predefined tests `eq', `eql' or |
3519 |
|
`equal' or a symbol denoting a user-defined test named TEST with |
3520 |
|
test and hash functions USER_TEST and USER_HASH. |
3521 |
|
|
3522 |
|
Give the table initial capacity SIZE, SIZE > 0, an integer. |
3523 |
|
|
3524 |
|
If REHASH_SIZE is an integer, it must be > 0, and this hash table's |
3525 |
|
new size when it becomes full is computed by adding REHASH_SIZE to |
3526 |
|
its old size. If REHASH_SIZE is a float, it must be > 1.0, and the |
3527 |
|
table's new size is computed by multiplying its old size with |
3528 |
|
REHASH_SIZE. |
3529 |
|
|
3530 |
|
REHASH_THRESHOLD must be a float <= 1.0, and > 0. The table will |
3531 |
|
be resized when the ratio of (number of entries in the table) / |
3532 |
|
(table size) is >= REHASH_THRESHOLD. |
3533 |
|
|
3534 |
|
WEAK specifies the weakness of the table. If non-nil, it must be |
3535 |
|
one of the symbols `key-weak', `value-weak' or `key-value-weak'. */ |
3536 |
|
|
3537 |
|
Lisp_Object |
3538 |
|
make_hash_table (test, size, rehash_size, rehash_threshold, weak, |
3539 |
|
user_test, user_hash) |
3540 |
|
Lisp_Object test, size, rehash_size, rehash_threshold, weak; |
3541 |
|
Lisp_Object user_test, user_hash; |
3542 |
|
{ |
3543 |
|
struct Lisp_Hash_Table *h; |
3544 |
|
struct Lisp_Vector *v; |
3545 |
|
Lisp_Object table; |
3546 |
|
int index_size, i, len, sz; |
3547 |
|
|
3548 |
|
/* Preconditions. */ |
3549 |
|
xassert (SYMBOLP (test)); |
3550 |
|
xassert (INTEGERP (size) && XINT (size) > 0); |
3551 |
|
xassert ((INTEGERP (rehash_size) && XINT (rehash_size) > 0) |
3552 |
|
|| (FLOATP (rehash_size) && XFLOATINT (rehash_size) > 1.0)); |
3553 |
|
xassert (FLOATP (rehash_threshold) |
3554 |
|
&& XFLOATINT (rehash_threshold) > 0 |
3555 |
|
&& XFLOATINT (rehash_threshold) <= 1.0); |
3556 |
|
|
3557 |
|
/* Allocate a vector, and initialize it. */ |
3558 |
|
len = VECSIZE (struct Lisp_Hash_Table); |
3559 |
|
v = allocate_vectorlike (len); |
3560 |
|
v->size = len; |
3561 |
|
for (i = 0; i < len; ++i) |
3562 |
|
v->contents[i] = Qnil; |
3563 |
|
|
3564 |
|
/* Initialize hash table slots. */ |
3565 |
|
sz = XFASTINT (size); |
3566 |
|
h = (struct Lisp_Hash_Table *) v; |
3567 |
|
|
3568 |
|
h->test = test; |
3569 |
|
if (EQ (test, Qeql)) |
3570 |
|
{ |
3571 |
|
h->cmpfn = cmpfn_eql; |
3572 |
|
h->hashfn = hashfn_eql; |
3573 |
|
} |
3574 |
|
else if (EQ (test, Qeq)) |
3575 |
|
{ |
3576 |
|
h->cmpfn = cmpfn_eq; |
3577 |
|
h->hashfn = hashfn_eq; |
3578 |
|
} |
3579 |
|
else if (EQ (test, Qequal)) |
3580 |
|
{ |
3581 |
|
h->cmpfn = cmpfn_equal; |
3582 |
|
h->hashfn = hashfn_equal; |
3583 |
|
} |
3584 |
|
else |
3585 |
|
{ |
3586 |
|
h->user_cmp_function = user_test; |
3587 |
|
h->user_hash_function = user_hash; |
3588 |
|
h->cmpfn = cmpfn_user_defined; |
3589 |
|
h->hashfn = hashfn_user_defined; |
3590 |
|
} |
3591 |
|
|
3592 |
|
h->weak = weak; |
3593 |
|
h->rehash_threshold = rehash_threshold; |
3594 |
|
h->rehash_size = rehash_size; |
3595 |
|
h->count = make_number (0); |
3596 |
|
h->key_and_value = Fmake_vector (make_number (2 * sz), Qnil); |
3597 |
|
h->hash = Fmake_vector (size, Qnil); |
3598 |
|
h->next = Fmake_vector (size, Qnil); |
3599 |
|
index_size = next_almost_prime (sz / XFLOATINT (rehash_threshold)); |
3600 |
|
h->index = Fmake_vector (make_number (index_size), Qnil); |
3601 |
|
|
3602 |
|
/* Set up the free list. */ |
3603 |
|
for (i = 0; i < sz - 1; ++i) |
3604 |
|
HASH_NEXT (h, i) = make_number (i + 1); |
3605 |
|
h->next_free = make_number (0); |
3606 |
|
|
3607 |
|
XSET_HASH_TABLE (table, h); |
3608 |
|
xassert (HASH_TABLE_P (table)); |
3609 |
|
xassert (XHASH_TABLE (table) == h); |
3610 |
|
|
3611 |
|
/* Maybe add this hash table to the list of all weak hash tables. */ |
3612 |
|
if (NILP (h->weak)) |
3613 |
|
h->next_weak = Qnil; |
3614 |
|
else |
3615 |
|
{ |
3616 |
|
h->next_weak = Vweak_hash_tables; |
3617 |
|
Vweak_hash_tables = table; |
3618 |
|
} |
3619 |
|
|
3620 |
|
return table; |
3621 |
|
} |
3622 |
|
|
3623 |
|
|
3624 |
|
/* Resize hash table H if it's too full. If H cannot be resized |
3625 |
|
because it's already too large, throw an error. */ |
3626 |
|
|
3627 |
|
static INLINE void |
3628 |
|
maybe_resize_hash_table (h) |
3629 |
|
struct Lisp_Hash_Table *h; |
3630 |
|
{ |
3631 |
|
if (NILP (h->next_free)) |
3632 |
|
{ |
3633 |
|
int old_size = HASH_TABLE_SIZE (h); |
3634 |
|
int i, new_size, index_size; |
3635 |
|
|
3636 |
|
if (INTEGERP (h->rehash_size)) |
3637 |
|
new_size = old_size + XFASTINT (h->rehash_size); |
3638 |
|
else |
3639 |
|
new_size = old_size * XFLOATINT (h->rehash_size); |
3640 |
|
index_size = next_almost_prime (new_size |
3641 |
|
/ XFLOATINT (h->rehash_threshold)); |
3642 |
|
if (max (index_size, 2 * new_size) & ~VALMASK) |
3643 |
|
error ("Hash table too large to resize"); |
3644 |
|
|
3645 |
|
h->key_and_value = larger_vector (h->key_and_value, 2 * new_size, Qnil); |
3646 |
|
h->next = larger_vector (h->next, new_size, Qnil); |
3647 |
|
h->hash = larger_vector (h->hash, new_size, Qnil); |
3648 |
|
h->index = Fmake_vector (make_number (index_size), Qnil); |
3649 |
|
|
3650 |
|
/* Update the free list. Do it so that new entries are added at |
3651 |
|
the end of the free list. This makes some operations like |
3652 |
|
maphash faster. */ |
3653 |
|
for (i = old_size; i < new_size - 1; ++i) |
3654 |
|
HASH_NEXT (h, i) = make_number (i + 1); |
3655 |
|
|
3656 |
|
if (!NILP (h->next_free)) |
3657 |
|
{ |
3658 |
|
Lisp_Object last, next; |
3659 |
|
|
3660 |
|
last = h->next_free; |
3661 |
|
while (next = HASH_NEXT (h, XFASTINT (last)), |
3662 |
|
!NILP (next)) |
3663 |
|
last = next; |
3664 |
|
|
3665 |
|
HASH_NEXT (h, XFASTINT (last)) = make_number (old_size); |
3666 |
|
} |
3667 |
|
else |
3668 |
|
XSETFASTINT (h->next_free, old_size); |
3669 |
|
|
3670 |
|
/* Rehash. */ |
3671 |
|
for (i = 0; i < old_size; ++i) |
3672 |
|
if (!NILP (HASH_HASH (h, i))) |
3673 |
|
{ |
3674 |
|
unsigned hash_code = XUINT (HASH_HASH (h, i)); |
3675 |
|
int start_of_bucket = hash_code % XVECTOR (h->index)->size; |
3676 |
|
HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket); |
3677 |
|
HASH_INDEX (h, start_of_bucket) = make_number (i); |
3678 |
|
} |
3679 |
|
} |
3680 |
|
} |
3681 |
|
|
3682 |
|
|
3683 |
|
/* Lookup KEY in hash table H. If HASH is non-null, return in *HASH |
3684 |
|
the hash code of KEY. Value is the index of the entry in H |
3685 |
|
matching KEY, or -1 if not found. */ |
3686 |
|
|
3687 |
|
int |
3688 |
|
hash_lookup (h, key, hash) |
3689 |
|
struct Lisp_Hash_Table *h; |
3690 |
|
Lisp_Object key; |
3691 |
|
unsigned *hash; |
3692 |
|
{ |
3693 |
|
unsigned hash_code; |
3694 |
|
int start_of_bucket; |
3695 |
|
Lisp_Object idx; |
3696 |
|
|
3697 |
|
hash_code = h->hashfn (h, key); |
3698 |
|
if (hash) |
3699 |
|
*hash = hash_code; |
3700 |
|
|
3701 |
|
start_of_bucket = hash_code % XVECTOR (h->index)->size; |
3702 |
|
idx = HASH_INDEX (h, start_of_bucket); |
3703 |
|
|
3704 |
|
while (!NILP (idx)) |
3705 |
|
{ |
3706 |
|
int i = XFASTINT (idx); |
3707 |
|
if (h->cmpfn (h, key, hash_code, HASH_KEY (h, i), HASH_HASH (h, i))) |
3708 |
|
break; |
3709 |
|
idx = HASH_NEXT (h, i); |
3710 |
|
} |
3711 |
|
|
3712 |
|
return NILP (idx) ? -1 : XFASTINT (idx); |
3713 |
|
} |
3714 |
|
|
3715 |
|
|
3716 |
|
/* Put an entry into hash table H that associates KEY with VALUE. |
3717 |
|
HASH is a previously computed hash code of KEY. */ |
3718 |
|
|
3719 |
|
void |
3720 |
|
hash_put (h, key, value, hash) |
3721 |
|
struct Lisp_Hash_Table *h; |
3722 |
|
Lisp_Object key, value; |
3723 |
|
unsigned hash; |
3724 |
|
{ |
3725 |
|
int start_of_bucket, i; |
3726 |
|
|
3727 |
|
xassert ((hash & ~VALMASK) == 0); |
3728 |
|
|
3729 |
|
/* Increment count after resizing because resizing may fail. */ |
3730 |
|
maybe_resize_hash_table (h); |
3731 |
|
h->count = make_number (XFASTINT (h->count) + 1); |
3732 |
|
|
3733 |
|
/* Store key/value in the key_and_value vector. */ |
3734 |
|
i = XFASTINT (h->next_free); |
3735 |
|
h->next_free = HASH_NEXT (h, i); |
3736 |
|
HASH_KEY (h, i) = key; |
3737 |
|
HASH_VALUE (h, i) = value; |
3738 |
|
|
3739 |
|
/* Remember its hash code. */ |
3740 |
|
HASH_HASH (h, i) = make_number (hash); |
3741 |
|
|
3742 |
|
/* Add new entry to its collision chain. */ |
3743 |
|
start_of_bucket = hash % XVECTOR (h->index)->size; |
3744 |
|
HASH_NEXT (h, i) = HASH_INDEX (h, start_of_bucket); |
3745 |
|
HASH_INDEX (h, start_of_bucket) = make_number (i); |
3746 |
|
} |
3747 |
|
|
3748 |
|
|
3749 |
|
/* Remove the entry matching KEY from hash table H, if there is one. */ |
3750 |
|
|
3751 |
|
void |
3752 |
|
hash_remove (h, key) |
3753 |
|
struct Lisp_Hash_Table *h; |
3754 |
|
Lisp_Object key; |
3755 |
|
{ |
3756 |
|
unsigned hash_code; |
3757 |
|
int start_of_bucket; |
3758 |
|
Lisp_Object idx, prev; |
3759 |
|
|
3760 |
|
hash_code = h->hashfn (h, key); |
3761 |
|
start_of_bucket = hash_code % XVECTOR (h->index)->size; |
3762 |
|
idx = HASH_INDEX (h, start_of_bucket); |
3763 |
|
prev = Qnil; |
3764 |
|
|
3765 |
|
while (!NILP (idx)) |
3766 |
|
{ |
3767 |
|
int i = XFASTINT (idx); |
3768 |
|
|
3769 |
|
if (h->cmpfn (h, key, hash_code, HASH_KEY (h, i), HASH_HASH (h, i))) |
3770 |
|
{ |
3771 |
|
/* Take entry out of collision chain. */ |
3772 |
|
if (NILP (prev)) |
3773 |
|
HASH_INDEX (h, start_of_bucket) = HASH_NEXT (h, i); |
3774 |
|
else |
3775 |
|
HASH_NEXT (h, XFASTINT (prev)) = HASH_NEXT (h, i); |
3776 |
|
|
3777 |
|
/* Clear slots in key_and_value and add the slots to |
3778 |
|
the free list. */ |
3779 |
|
HASH_KEY (h, i) = HASH_VALUE (h, i) = HASH_HASH (h, i) = Qnil; |
3780 |
|
HASH_NEXT (h, i) = h->next_free; |
3781 |
|
h->next_free = make_number (i); |
3782 |
|
h->count = make_number (XFASTINT (h->count) - 1); |
3783 |
|
xassert (XINT (h->count) >= 0); |
3784 |
|
break; |
3785 |
|
} |
3786 |
|
else |
3787 |
|
{ |
3788 |
|
prev = idx; |
3789 |
|
idx = HASH_NEXT (h, i); |
3790 |
|
} |
3791 |
|
} |
3792 |
|
} |
3793 |
|
|
3794 |
|
|
3795 |
|
/* Clear hash table H. */ |
3796 |
|
|
3797 |
|
void |
3798 |
|
hash_clear (h) |
3799 |
|
struct Lisp_Hash_Table *h; |
3800 |
|
{ |
3801 |
|
if (XFASTINT (h->count) > 0) |
3802 |
|
{ |
3803 |
|
int i, size = HASH_TABLE_SIZE (h); |
3804 |
|
|
3805 |
|
for (i = 0; i < size; ++i) |
3806 |
|
{ |
3807 |
|
HASH_NEXT (h, i) = i < size - 1 ? make_number (i + 1) : Qnil; |
3808 |
|
HASH_KEY (h, i) = Qnil; |
3809 |
|
HASH_VALUE (h, i) = Qnil; |
3810 |
|
HASH_HASH (h, i) = Qnil; |
3811 |
|
} |
3812 |
|
|
3813 |
|
for (i = 0; i < XVECTOR (h->index)->size; ++i) |
3814 |
|
XVECTOR (h->index)->contents[i] = Qnil; |
3815 |
|
|
3816 |
|
h->next_free = make_number (0); |
3817 |
|
h->count = make_number (0); |
3818 |
|
} |
3819 |
|
} |
3820 |
|
|
3821 |
|
|
3822 |
|
|
3823 |
|
/************************************************************************ |
3824 |
|
Weak Hash Tables |
3825 |
|
************************************************************************/ |
3826 |
|
|
3827 |
|
/* Remove elements from weak hash tables that don't survive the |
3828 |
|
current garbage collection. Remove weak tables that don't survive |
3829 |
|
from Vweak_hash_tables. Called from gc_sweep. */ |
3830 |
|
|
3831 |
|
void |
3832 |
|
sweep_weak_hash_tables () |
3833 |
|
{ |
3834 |
|
Lisp_Object table; |
3835 |
|
struct Lisp_Hash_Table *h = 0, *prev; |
3836 |
|
|
3837 |
|
for (table = Vweak_hash_tables; !GC_NILP (table); table = h->next_weak) |
3838 |
|
{ |
3839 |
|
prev = h; |
3840 |
|
h = XHASH_TABLE (table); |
3841 |
|
|
3842 |
|
if (h->size & ARRAY_MARK_FLAG) |
3843 |
|
{ |
3844 |
|
if (XFASTINT (h->count) > 0) |
3845 |
|
{ |
3846 |
|
int bucket, n; |
3847 |
|
|
3848 |
|
n = XVECTOR (h->index)->size & ~ARRAY_MARK_FLAG; |
3849 |
|
for (bucket = 0; bucket < n; ++bucket) |
3850 |
|
{ |
3851 |
|
Lisp_Object idx, key, value, prev, next; |
3852 |
|
|
3853 |
|
/* Follow collision chain, removing entries that |
3854 |
|
don't survive this garbage collection. */ |
3855 |
|
idx = HASH_INDEX (h, bucket); |
3856 |
|
prev = Qnil; |
3857 |
|
while (!GC_NILP (idx)) |
3858 |
|
{ |
3859 |
|
int remove_p; |
3860 |
|
int i = XFASTINT (idx); |
3861 |
|
Lisp_Object next; |
3862 |
|
|
3863 |
|
if (EQ (h->weak, Qkey_weak)) |
3864 |
|
remove_p = !survives_gc_p (HASH_KEY (h, i)); |
3865 |
|
else if (EQ (h->weak, Qvalue_weak)) |
3866 |
|
remove_p = !survives_gc_p (HASH_VALUE (h, i)); |
3867 |
|
else if (EQ (h->weak, Qkey_value_weak)) |
3868 |
|
remove_p = (!survives_gc_p (HASH_KEY (h, i)) |
3869 |
|
|| !survives_gc_p (HASH_VALUE (h, i))); |
3870 |
|
else |
3871 |
|
abort (); |
3872 |
|
|
3873 |
|
next = HASH_NEXT (h, i); |
3874 |
|
if (remove_p) |
3875 |
|
{ |
3876 |
|
/* Take out of collision chain. */ |
3877 |
|
if (GC_NILP (prev)) |
3878 |
|
HASH_INDEX (h, i) = next; |
3879 |
|
else |
3880 |
|
HASH_NEXT (h, XFASTINT (prev)) = next; |
3881 |
|
|
3882 |
|
/* Add to free list. */ |
3883 |
|
HASH_NEXT (h, i) = h->next_free; |
3884 |
|
h->next_free = idx; |
3885 |
|
|
3886 |
|
/* Clear key, value, and hash. */ |
3887 |
|
HASH_KEY (h, i) = HASH_VALUE (h, i) = Qnil; |
3888 |
|
HASH_HASH (h, i) = Qnil; |
3889 |
|
|
3890 |
|
h->count = make_number (XFASTINT (h->count) - 1); |
3891 |
|
} |
3892 |
|
else |
3893 |
|
{ |
3894 |
|
/* Make sure key and value survive. */ |
3895 |
|
mark_object (&HASH_KEY (h, i)); |
3896 |
|
mark_object (&HASH_VALUE (h, i)); |
3897 |
|
} |
3898 |
|
|
3899 |
|
idx = next; |
3900 |
|
} |
3901 |
|
} |
3902 |
|
} |
3903 |
|
} |
3904 |
|
else |
3905 |
|
{ |
3906 |
|
/* Table is not marked, and will thus be freed. |
3907 |
|
Take it out of the list of weak hash tables. */ |
3908 |
|
if (prev) |
3909 |
|
prev->next_weak = h->next_weak; |
3910 |
|
else |
3911 |
|
Vweak_hash_tables = h->next_weak; |
3912 |
|
} |
3913 |
|
} |
3914 |
|
} |
3915 |
|
|
3916 |
|
|
3917 |
|
|
3918 |
|
/*********************************************************************** |
3919 |
|
Hash Code Computation |
3920 |
|
***********************************************************************/ |
3921 |
|
|
3922 |
|
/* Maximum depth up to which to dive into Lisp structures. */ |
3923 |
|
|
3924 |
|
#define SXHASH_MAX_DEPTH 3 |
3925 |
|
|
3926 |
|
/* Maximum length up to which to take list and vector elements into |
3927 |
|
account. */ |
3928 |
|
|
3929 |
|
#define SXHASH_MAX_LEN 7 |
3930 |
|
|
3931 |
|
/* Combine two integers X and Y for hashing. */ |
3932 |
|
|
3933 |
|
#define SXHASH_COMBINE(X, Y) \ |
3934 |
|
((((unsigned)(X) << 4) + ((unsigned)(X) >> 24) & 0x0fffffff) \ |
3935 |
|
+ (unsigned)(Y)) |
3936 |
|
|
3937 |
|
|
3938 |
|
/* Return a hash for string PTR which has length LEN. */ |
3939 |
|
|
3940 |
|
static unsigned |
3941 |
|
sxhash_string (ptr, len) |
3942 |
|
unsigned char *ptr; |
3943 |
|
int len; |
3944 |
|
{ |
3945 |
|
unsigned char *p = ptr; |
3946 |
|
unsigned char *end = p + len; |
3947 |
|
unsigned char c; |
3948 |
|
unsigned hash = 0; |
3949 |
|
|
3950 |
|
while (p != end) |
3951 |
|
{ |
3952 |
|
c = *p++; |
3953 |
|
if (c >= 0140) |
3954 |
|
c -= 40; |
3955 |
|
hash = ((hash << 3) + (hash >> 28) + c); |
3956 |
|
} |
3957 |
|
|
3958 |
|
return hash & 07777777777; |
3959 |
|
} |
3960 |
|
|
3961 |
|
|
3962 |
|
/* Return a hash for list LIST. DEPTH is the current depth in the |
3963 |
|
list. We don't recurse deeper than SXHASH_MAX_DEPTH in it. */ |
3964 |
|
|
3965 |
|
static unsigned |
3966 |
|
sxhash_list (list, depth) |
3967 |
|
Lisp_Object list; |
3968 |
|
int depth; |
3969 |
|
{ |
3970 |
|
unsigned hash = 0; |
3971 |
|
int i; |
3972 |
|
|
3973 |
|
if (depth < SXHASH_MAX_DEPTH) |
3974 |
|
for (i = 0; |
3975 |
|
CONSP (list) && i < SXHASH_MAX_LEN; |
3976 |
|
list = XCDR (list), ++i) |
3977 |
|
{ |
3978 |
|
unsigned hash2 = sxhash (XCAR (list), depth + 1); |
3979 |
|
hash = SXHASH_COMBINE (hash, hash2); |
3980 |
|
} |
3981 |
|
|
3982 |
|
return hash; |
3983 |
|
} |
3984 |
|
|
3985 |
|
|
3986 |
|
/* Return a hash for vector VECTOR. DEPTH is the current depth in |
3987 |
|
the Lisp structure. */ |
3988 |
|
|
3989 |
|
static unsigned |
3990 |
|
sxhash_vector (vec, depth) |
3991 |
|
Lisp_Object vec; |
3992 |
|
int depth; |
3993 |
|
{ |
3994 |
|
unsigned hash = XVECTOR (vec)->size; |
3995 |
|
int i, n; |
3996 |
|
|
3997 |
|
n = min (SXHASH_MAX_LEN, XVECTOR (vec)->size); |
3998 |
|
for (i = 0; i < n; ++i) |
3999 |
|
{ |
4000 |
|
unsigned hash2 = sxhash (XVECTOR (vec)->contents[i], depth + 1); |
4001 |
|
hash = SXHASH_COMBINE (hash, hash2); |
4002 |
|
} |
4003 |
|
|
4004 |
|
return hash; |
4005 |
|
} |
4006 |
|
|
4007 |
|
|
4008 |
|
/* Return a hash for bool-vector VECTOR. */ |
4009 |
|
|
4010 |
|
static unsigned |
4011 |
|
sxhash_bool_vector (vec) |
4012 |
|
Lisp_Object vec; |
4013 |
|
{ |
4014 |
|
unsigned hash = XBOOL_VECTOR (vec)->size; |
4015 |
|
int i, n; |
4016 |
|
|
4017 |
|
n = min (SXHASH_MAX_LEN, XBOOL_VECTOR (vec)->vector_size); |
4018 |
|
for (i = 0; i < n; ++i) |
4019 |
|
hash = SXHASH_COMBINE (hash, XBOOL_VECTOR (vec)->data[i]); |
4020 |
|
|
4021 |
|
return hash; |
4022 |
|
} |
4023 |
|
|
4024 |
|
|
4025 |
|
/* Return a hash code for OBJ. DEPTH is the current depth in the Lisp |
4026 |
|
structure. Value is an unsigned integer clipped to VALMASK. */ |
4027 |
|
|
4028 |
|
unsigned |
4029 |
|
sxhash (obj, depth) |
4030 |
|
Lisp_Object obj; |
4031 |
|
int depth; |
4032 |
|
{ |
4033 |
|
unsigned hash; |
4034 |
|
|
4035 |
|
if (depth > SXHASH_MAX_DEPTH) |
4036 |
|
return 0; |
4037 |
|
|
4038 |
|
switch (XTYPE (obj)) |
4039 |
|
{ |
4040 |
|
case Lisp_Int: |
4041 |
|
hash = XUINT (obj); |
4042 |
|
break; |
4043 |
|
|
4044 |
|
case Lisp_Symbol: |
4045 |
|
hash = sxhash_string (XSYMBOL (obj)->name->data, |
4046 |
|
XSYMBOL (obj)->name->size); |
4047 |
|
break; |
4048 |
|
|
4049 |
|
case Lisp_Misc: |
4050 |
|
hash = XUINT (obj); |
4051 |
|
break; |
4052 |
|
|
4053 |
|
case Lisp_String: |
4054 |
|
hash = sxhash_string (XSTRING (obj)->data, XSTRING (obj)->size); |
4055 |
|
break; |
4056 |
|
|
4057 |
|
/* This can be everything from a vector to an overlay. */ |
4058 |
|
case Lisp_Vectorlike: |
4059 |
|
if (VECTORP (obj)) |
4060 |
|
/* According to the CL HyperSpec, two arrays are equal only if |
4061 |
|
they are `eq', except for strings and bit-vectors. In |
4062 |
|
Emacs, this works differently. We have to compare element |
4063 |
|
by element. */ |
4064 |
|
hash = sxhash_vector (obj, depth); |
4065 |
|
else if (BOOL_VECTOR_P (obj)) |
4066 |
|
hash = sxhash_bool_vector (obj); |
4067 |
|
else |
4068 |
|
/* Others are `equal' if they are `eq', so let's take their |
4069 |
|
address as hash. */ |
4070 |
|
hash = XUINT (obj); |
4071 |
|
break; |
4072 |
|
|
4073 |
|
case Lisp_Cons: |
4074 |
|
hash = sxhash_list (obj, depth); |
4075 |
|
break; |
4076 |
|
|
4077 |
|
case Lisp_Float: |
4078 |
|
{ |
4079 |
|
unsigned char *p = (unsigned char *) &XFLOAT (obj)->data; |
4080 |
|
unsigned char *e = p + sizeof XFLOAT (obj)->data; |
4081 |
|
for (hash = 0; p < e; ++p) |
4082 |
|
hash = SXHASH_COMBINE (hash, *p); |
4083 |
|
break; |
4084 |
|
} |
4085 |
|
|
4086 |
|
default: |
4087 |
|
abort (); |
4088 |
|
} |
4089 |
|
|
4090 |
|
return hash & VALMASK; |
4091 |
|
} |
4092 |
|
|
4093 |
|
|
4094 |
|
|
4095 |
|
/*********************************************************************** |
4096 |
|
Lisp Interface |
4097 |
|
***********************************************************************/ |
4098 |
|
|
4099 |
|
|
4100 |
|
DEFUN ("sxhash", Fsxhash, Ssxhash, 1, 1, 0, |
4101 |
|
"Compute a hash code for OBJ and return it as integer.") |
4102 |
|
(obj) |
4103 |
|
Lisp_Object obj; |
4104 |
|
{ |
4105 |
|
unsigned hash = sxhash (obj, 0);; |
4106 |
|
return make_number (hash); |
4107 |
|
} |
4108 |
|
|
4109 |
|
|
4110 |
|
DEFUN ("make-hash-table", Fmake_hash_table, Smake_hash_table, 0, MANY, 0, |
4111 |
|
"Create and return a new hash table.\n\ |
4112 |
|
Arguments are specified as keyword/argument pairs. The following\n\ |
4113 |
|
arguments are defined:\n\ |
4114 |
|
\n\ |
4115 |
|
:TEST TEST -- TEST must be a symbol that specifies how to compare keys. |
4116 |
|
Default is `eql'. Predefined are the tests `eq', `eql', and `equal'.\n\ |
4117 |
|
User-supplied test and hash functions can be specified via\n\ |
4118 |
|
`define-hash-table-test'.\n\ |
4119 |
|
\n\ |
4120 |
|
:SIZE SIZE -- A hint as to how many elements will be put in the table. |
4121 |
|
Default is 65.\n\ |
4122 |
|
\n\ |
4123 |
|
:REHASH-SIZE REHASH-SIZE - Indicates how to expand the table when\n\ |
4124 |
|
it fills up. If REHASH-SIZE is an integer, add that many space.\n\ |
4125 |
|
If it is a float, it must be > 1.0, and the new size is computed by\n\ |
4126 |
|
multiplying the old size with that factor. Default is 1.5.\n\ |
4127 |
|
\n\ |
4128 |
|
:REHASH-THRESHOLD THRESHOLD -- THRESHOLD must a float > 0, and <= 1.0.\n\ |
4129 |
|
Resize the hash table when ratio of the number of entries in the table.\n\ |
4130 |
|
Default is 0.8.\n\ |
4131 |
|
\n\ |
4132 |
|
:WEAK WEAK -- WEAK must be one of nil, t, `key-weak', `value-weak' or\n\ |
4133 |
|
`key-value-weak'. WEAK t means the same as `key-value-weak'. Elements\n\ |
4134 |
|
are removed from a weak hash table when their key, value or both \n\ |
4135 |
|
according to WEAKNESS are otherwise unreferenced. Default is nil.") |
4136 |
|
(nargs, args) |
4137 |
|
int nargs; |
4138 |
|
Lisp_Object *args; |
4139 |
|
{ |
4140 |
|
Lisp_Object test, size, rehash_size, rehash_threshold, weak; |
4141 |
|
Lisp_Object user_test, user_hash; |
4142 |
|
char *used; |
4143 |
|
int i; |
4144 |
|
|
4145 |
|
/* The vector `used' is used to keep track of arguments that |
4146 |
|
have been consumed. */ |
4147 |
|
used = (char *) alloca (nargs * sizeof *used); |
4148 |
|
bzero (used, nargs * sizeof *used); |
4149 |
|
|
4150 |
|
/* See if there's a `:test TEST' among the arguments. */ |
4151 |
|
i = get_key_arg (QCtest, nargs, args, used); |
4152 |
|
test = i < 0 ? Qeql : args[i]; |
4153 |
|
if (!EQ (test, Qeq) && !EQ (test, Qeql) && !EQ (test, Qequal)) |
4154 |
|
{ |
4155 |
|
/* See if it is a user-defined test. */ |
4156 |
|
Lisp_Object prop; |
4157 |
|
|
4158 |
|
prop = Fget (test, Qhash_table_test); |
4159 |
|
if (!CONSP (prop) || XFASTINT (Flength (prop)) < 2) |
4160 |
|
Fsignal (Qerror, list2 (build_string ("Illegal hash table test"), |
4161 |
|
test)); |
4162 |
|
user_test = Fnth (make_number (0), prop); |
4163 |
|
user_hash = Fnth (make_number (1), prop); |
4164 |
|
} |
4165 |
|
else |
4166 |
|
user_test = user_hash = Qnil; |
4167 |
|
|
4168 |
|
/* See if there's a `:size SIZE' argument. */ |
4169 |
|
i = get_key_arg (QCsize, nargs, args, used); |
4170 |
|
size = i < 0 ? make_number (DEFAULT_HASH_SIZE) : args[i]; |
4171 |
|
if (!INTEGERP (size) || XINT (size) <= 0) |
4172 |
|
Fsignal (Qerror, |
4173 |
|
list2 (build_string ("Illegal hash table size"), |
4174 |
|
size)); |
4175 |
|
|
4176 |
|
/* Look for `:rehash-size SIZE'. */ |
4177 |
|
i = get_key_arg (QCrehash_size, nargs, args, used); |
4178 |
|
rehash_size = i < 0 ? make_float (DEFAULT_REHASH_SIZE) : args[i]; |
4179 |
|
if (!NUMBERP (rehash_size) |
4180 |
|
|| (INTEGERP (rehash_size) && XINT (rehash_size) <= 0) |
4181 |
|
|| XFLOATINT (rehash_size) <= 1.0) |
4182 |
|
Fsignal (Qerror, |
4183 |
|
list2 (build_string ("Illegal hash table rehash size"), |
4184 |
|
rehash_size)); |
4185 |
|
|
4186 |
|
/* Look for `:rehash-threshold THRESHOLD'. */ |
4187 |
|
i = get_key_arg (QCrehash_threshold, nargs, args, used); |
4188 |
|
rehash_threshold = i < 0 ? make_float (DEFAULT_REHASH_THRESHOLD) : args[i]; |
4189 |
|
if (!FLOATP (rehash_threshold) |
4190 |
|
|| XFLOATINT (rehash_threshold) <= 0.0 |
4191 |
|
|| XFLOATINT (rehash_threshold) > 1.0) |
4192 |
|
Fsignal (Qerror, |
4193 |
|
list2 (build_string ("Illegal hash table rehash threshold"), |
4194 |
|
rehash_threshold)); |
4195 |
|
|
4196 |
|
/* Look for `:weak WEAK'. */ |
4197 |
|
i = get_key_arg (QCweak, nargs, args, used); |
4198 |
|
weak = i < 0 ? Qnil : args[i]; |
4199 |
|
if (EQ (weak, Qt)) |
4200 |
|
weak = Qkey_value_weak; |
4201 |
|
if (!NILP (weak) |
4202 |
|
&& !EQ (weak, Qkey_weak) |
4203 |
|
&& !EQ (weak, Qvalue_weak) |
4204 |
|
&& !EQ (weak, Qkey_value_weak)) |
4205 |
|
Fsignal (Qerror, list2 (build_string ("Illegal hash table weakness"), |
4206 |
|
weak)); |
4207 |
|
|
4208 |
|
/* Now, all args should have been used up, or there's a problem. */ |
4209 |
|
for (i = 0; i < nargs; ++i) |
4210 |
|
if (!used[i]) |
4211 |
|
Fsignal (Qerror, |
4212 |
|
list2 (build_string ("Invalid argument list"), args[i])); |
4213 |
|
|
4214 |
|
return make_hash_table (test, size, rehash_size, rehash_threshold, weak, |
4215 |
|
user_test, user_hash); |
4216 |
|
} |
4217 |
|
|
4218 |
|
|
4219 |
|
DEFUN ("makehash", Fmakehash, Smakehash, 0, MANY, 0, |
4220 |
|
"Create a new hash table.\n\ |
4221 |
|
Optional first argument SIZE is a hint to the implementation as\n\ |
4222 |
|
to how many elements will be put in the table. Default is 65.\n\ |
4223 |
|
\n\ |
4224 |
|
Optional second argument TEST specifies how to compare keys in\n\ |
4225 |
|
the table. Predefined tests are `eq', `eql', and `equal'. Default\n\ |
4226 |
|
is `eql'. New tests can be defined with `define-hash-table-test'.\n\ |
4227 |
|
\n\ |
4228 |
|
Optional third argument WEAK must be one of nil, t, `key-weak',\n\ |
4229 |
|
`value-weak' or `key-value-weak'. WEAK t means the same as\n\ |
4230 |
|
`key-value-weak'. Default is nil. Elements of weak hash tables\n\ |
4231 |
|
are removed when their key, value or both are otherwise unreferenced.\n\ |
4232 |
|
\n\ |
4233 |
|
The rest of the optional arguments are keyword/value pairs. The\n\ |
4234 |
|
following are recognized:\n\ |
4235 |
|
\n\ |
4236 |
|
:REHASH-SIZE REHASH-SIZE - Indicates how to expand the table when\n\ |
4237 |
|
it fills up. If REHASH-SIZE is an integer, add that many space.\n\ |
4238 |
|
If it is a float, it must be > 1.0, and the new size is computed by\n\ |
4239 |
|
multiplying the old size with that factor. Default is 1.5.\n\ |
4240 |
|
\n\ |
4241 |
|
:REHASH-THRESHOLD THRESHOLD -- THRESHOLD must a float > 0, and <= 1.0.\n\ |
4242 |
|
Resize the hash table when ratio of the number of entries in the table.\n\ |
4243 |
|
Default is 0.8.") |
4244 |
|
(nargs, args) |
4245 |
|
int nargs; |
4246 |
|
Lisp_Object *args; |
4247 |
|
{ |
4248 |
|
Lisp_Object args2[nargs + 6]; |
4249 |
|
int i, j; |
4250 |
|
|
4251 |
|
/* Recognize size argument. */ |
4252 |
|
i = j = 0; |
4253 |
|
if (INTEGERP (args[i])) |
4254 |
|
{ |
4255 |
|
args2[j++] = QCsize; |
4256 |
|
args2[j++] = args[i++]; |
4257 |
|
} |
4258 |
|
|
4259 |
|
/* Recognize test argument. */ |
4260 |
|
if (SYMBOLP (args[i]) |
4261 |
|
&& !EQ (args[i], QCrehash_size) |
4262 |
|
&& !EQ (args[i], QCrehash_threshold) |
4263 |
|
&& !EQ (args[i], QCweak)) |
4264 |
|
{ |
4265 |
|
args2[j++] = QCtest; |
4266 |
|
args2[j++] = args[i++]; |
4267 |
|
} |
4268 |
|
|
4269 |
|
/* Recognize weakness argument. */ |
4270 |
|
if (EQ (args[i], Qt) |
4271 |
|
|| NILP (args[i]) |
4272 |
|
|| EQ (args[i], Qkey_weak) |
4273 |
|
|| EQ (args[i], Qvalue_weak) |
4274 |
|
|| EQ (args[i], Qkey_value_weak)) |
4275 |
|
{ |
4276 |
|
args2[j++] = QCweak; |
4277 |
|
args2[j++] = args[i++]; |
4278 |
|
} |
4279 |
|
|
4280 |
|
/* Copy remaining arguments. */ |
4281 |
|
while (i < nargs) |
4282 |
|
args2[j++] = args[i++]; |
4283 |
|
|
4284 |
|
return Fmake_hash_table (j, args2); |
4285 |
|
} |
4286 |
|
|
4287 |
|
|
4288 |
|
DEFUN ("hash-table-count", Fhash_table_count, Shash_table_count, 1, 1, 0, |
4289 |
|
"Return the number of elements in TABLE.") |
4290 |
|
(table) |
4291 |
|
Lisp_Object table; |
4292 |
|
{ |
4293 |
|
return check_hash_table (table)->count; |
4294 |
|
} |
4295 |
|
|
4296 |
|
|
4297 |
|
DEFUN ("hash-table-rehash-size", Fhash_table_rehash_size, |
4298 |
|
Shash_table_rehash_size, 1, 1, 0, |
4299 |
|
"Return the current rehash size of TABLE.") |
4300 |
|
(table) |
4301 |
|
Lisp_Object table; |
4302 |
|
{ |
4303 |
|
return check_hash_table (table)->rehash_size; |
4304 |
|
} |
4305 |
|
|
4306 |
|
|
4307 |
|
DEFUN ("hash-table-rehash-threshold", Fhash_table_rehash_threshold, |
4308 |
|
Shash_table_rehash_threshold, 1, 1, 0, |
4309 |
|
"Return the current rehash threshold of TABLE.") |
4310 |
|
(table) |
4311 |
|
Lisp_Object table; |
4312 |
|
{ |
4313 |
|
return check_hash_table (table)->rehash_threshold; |
4314 |
|
} |
4315 |
|
|
4316 |
|
|
4317 |
|
DEFUN ("hash-table-size", Fhash_table_size, Shash_table_size, 1, 1, 0, |
4318 |
|
"Return the size of TABLE.\n\ |
4319 |
|
The size can be used as an argument to `make-hash-table' to create\n\ |
4320 |
|
a hash table than can hold as many elements of TABLE holds\n\ |
4321 |
|
without need for resizing.") |
4322 |
|
(table) |
4323 |
|
Lisp_Object table; |
4324 |
|
{ |
4325 |
|
struct Lisp_Hash_Table *h = check_hash_table (table); |
4326 |
|
return make_number (HASH_TABLE_SIZE (h)); |
4327 |
|
} |
4328 |
|
|
4329 |
|
|
4330 |
|
DEFUN ("hash-table-test", Fhash_table_test, Shash_table_test, 1, 1, 0, |
4331 |
|
"Return the test TABLE uses.") |
4332 |
|
(table) |
4333 |
|
Lisp_Object table; |
4334 |
|
{ |
4335 |
|
return check_hash_table (table)->test; |
4336 |
|
} |
4337 |
|
|
4338 |
|
|
4339 |
|
DEFUN ("hash-table-weak", Fhash_table_weak, Shash_table_weak, 1, 1, 0, |
4340 |
|
"Return the weakness of TABLE.") |
4341 |
|
(table) |
4342 |
|
Lisp_Object table; |
4343 |
|
{ |
4344 |
|
return check_hash_table (table)->weak; |
4345 |
|
} |
4346 |
|
|
4347 |
|
|
4348 |
|
DEFUN ("hash-table-p", Fhash_table_p, Shash_table_p, 1, 1, 0, |
4349 |
|
"Return t if OBJ is a Lisp hash table object.") |
4350 |
|
(obj) |
4351 |
|
Lisp_Object obj; |
4352 |
|
{ |
4353 |
|
return HASH_TABLE_P (obj) ? Qt : Qnil; |
4354 |
|
} |
4355 |
|
|
4356 |
|
|
4357 |
|
DEFUN ("clrhash", Fclrhash, Sclrhash, 1, 1, 0, |
4358 |
|
"Clear hash table TABLE.") |
4359 |
|
(table) |
4360 |
|
Lisp_Object table; |
4361 |
|
{ |
4362 |
|
hash_clear (check_hash_table (table)); |
4363 |
|
return Qnil; |
4364 |
|
} |
4365 |
|
|
4366 |
|
|
4367 |
|
DEFUN ("gethash", Fgethash, Sgethash, 2, 3, 0, |
4368 |
|
"Look up KEY in TABLE and return its associated value.\n\ |
4369 |
|
If KEY is not found, return DFLT which defaults to nil.") |
4370 |
|
(table, key, dflt) |
4371 |
|
Lisp_Object table, key; |
4372 |
|
{ |
4373 |
|
struct Lisp_Hash_Table *h = check_hash_table (table); |
4374 |
|
int i = hash_lookup (h, key, NULL); |
4375 |
|
return i >= 0 ? HASH_VALUE (h, i) : dflt; |
4376 |
|
} |
4377 |
|
|
4378 |
|
|
4379 |
|
DEFUN ("puthash", Fputhash, Sputhash, 3, 3, 0, |
4380 |
|
"Associate KEY with VALUE is hash table TABLE.\n\ |
4381 |
|
If KEY is already present in table, replace its current value with\n\ |
4382 |
|
VALUE.") |
4383 |
|
(table, key, value) |
4384 |
|
Lisp_Object table, key, value; |
4385 |
|
{ |
4386 |
|
struct Lisp_Hash_Table *h = check_hash_table (table); |
4387 |
|
int i; |
4388 |
|
unsigned hash; |
4389 |
|
|
4390 |
|
i = hash_lookup (h, key, &hash); |
4391 |
|
if (i >= 0) |
4392 |
|
HASH_VALUE (h, i) = value; |
4393 |
|
else |
4394 |
|
hash_put (h, key, value, hash); |
4395 |
|
|
4396 |
|
return Qnil; |
4397 |
|
} |
4398 |
|
|
4399 |
|
|
4400 |
|
DEFUN ("remhash", Fremhash, Sremhash, 2, 2, 0, |
4401 |
|
"Remove KEY from TABLE.") |
4402 |
|
(table, key) |
4403 |
|
Lisp_Object table, key; |
4404 |
|
{ |
4405 |
|
struct Lisp_Hash_Table *h = check_hash_table (table); |
4406 |
|
hash_remove (h, key); |
4407 |
|
return Qnil; |
4408 |
|
} |
4409 |
|
|
4410 |
|
|
4411 |
|
DEFUN ("maphash", Fmaphash, Smaphash, 2, 2, 0, |
4412 |
|
"Call FUNCTION for all entries in hash table TABLE.\n\ |
4413 |
|
FUNCTION is called with 2 arguments KEY and VALUE.") |
4414 |
|
(function, table) |
4415 |
|
Lisp_Object function, table; |
4416 |
|
{ |
4417 |
|
struct Lisp_Hash_Table *h = check_hash_table (table); |
4418 |
|
Lisp_Object args[3]; |
4419 |
|
int i; |
4420 |
|
|
4421 |
|
for (i = 0; i < HASH_TABLE_SIZE (h); ++i) |
4422 |
|
if (!NILP (HASH_HASH (h, i))) |
4423 |
|
{ |
4424 |
|
args[0] = function; |
4425 |
|
args[1] = HASH_KEY (h, i); |
4426 |
|
args[2] = HASH_VALUE (h, i); |
4427 |
|
Ffuncall (3, args); |
4428 |
|
} |
4429 |
|
|
4430 |
|
return Qnil; |
4431 |
|
} |
4432 |
|
|
4433 |
|
|
4434 |
|
DEFUN ("define-hash-table-test", Fdefine_hash_table_test, |
4435 |
|
Sdefine_hash_table_test, 3, 3, 0, |
4436 |
|
"Define a new hash table test with name NAME, a symbol.\n\ |
4437 |
|
In hash tables create with NAME specified as test, use TEST to compare\n\ |
4438 |
|
keys, and HASH for computing hash codes of keys.\n\ |
4439 |
|
\n\ |
4440 |
|
TEST must be a function taking two arguments and returning non-nil\n\ |
4441 |
|
if both arguments are the same. HASH must be a function taking\n\ |
4442 |
|
one argument and return an integer that is the hash code of the\n\ |
4443 |
|
argument. Hash code computation should use the whole value range of\n\ |
4444 |
|
integers, including negative integers.") |
4445 |
|
(name, test, hash) |
4446 |
|
Lisp_Object name, test, hash; |
4447 |
|
{ |
4448 |
|
return Fput (name, Qhash_table_test, list2 (test, hash)); |
4449 |
|
} |
4450 |
|
|
4451 |
|
|
4452 |
|
|
4453 |
|
|
4454 |
void |
void |
4455 |
syms_of_fns () |
syms_of_fns () |
4456 |
{ |
{ |
4457 |
|
/* Hash table stuff. */ |
4458 |
|
Qhash_table_p = intern ("hash-table-p"); |
4459 |
|
staticpro (&Qhash_table_p); |
4460 |
|
Qeq = intern ("eq"); |
4461 |
|
staticpro (&Qeq); |
4462 |
|
Qeql = intern ("eql"); |
4463 |
|
staticpro (&Qeql); |
4464 |
|
Qequal = intern ("equal"); |
4465 |
|
staticpro (&Qequal); |
4466 |
|
QCtest = intern (":test"); |
4467 |
|
staticpro (&QCtest); |
4468 |
|
QCsize = intern (":size"); |
4469 |
|
staticpro (&QCsize); |
4470 |
|
QCrehash_size = intern (":rehash-size"); |
4471 |
|
staticpro (&QCrehash_size); |
4472 |
|
QCrehash_threshold = intern (":rehash-threshold"); |
4473 |
|
staticpro (&QCrehash_threshold); |
4474 |
|
QCweak = intern (":weak"); |
4475 |
|
staticpro (&QCweak); |
4476 |
|
Qkey_weak = intern ("key-weak"); |
4477 |
|
staticpro (&Qkey_weak); |
4478 |
|
Qvalue_weak = intern ("value-weak"); |
4479 |
|
staticpro (&Qvalue_weak); |
4480 |
|
Qkey_value_weak = intern ("key-value-weak"); |
4481 |
|
staticpro (&Qkey_value_weak); |
4482 |
|
Qhash_table_test = intern ("hash-table-test"); |
4483 |
|
staticpro (&Qhash_table_test); |
4484 |
|
|
4485 |
|
defsubr (&Ssxhash); |
4486 |
|
defsubr (&Smake_hash_table); |
4487 |
|
defsubr (&Smakehash); |
4488 |
|
defsubr (&Shash_table_count); |
4489 |
|
defsubr (&Shash_table_rehash_size); |
4490 |
|
defsubr (&Shash_table_rehash_threshold); |
4491 |
|
defsubr (&Shash_table_size); |
4492 |
|
defsubr (&Shash_table_test); |
4493 |
|
defsubr (&Shash_table_weak); |
4494 |
|
defsubr (&Shash_table_p); |
4495 |
|
defsubr (&Sclrhash); |
4496 |
|
defsubr (&Sgethash); |
4497 |
|
defsubr (&Sputhash); |
4498 |
|
defsubr (&Sremhash); |
4499 |
|
defsubr (&Smaphash); |
4500 |
|
defsubr (&Sdefine_hash_table_test); |
4501 |
|
|
4502 |
Qstring_lessp = intern ("string-lessp"); |
Qstring_lessp = intern ("string-lessp"); |
4503 |
staticpro (&Qstring_lessp); |
staticpro (&Qstring_lessp); |
4504 |
Qprovide = intern ("provide"); |
Qprovide = intern ("provide"); |
4593 |
defsubr (&Sbase64_encode_string); |
defsubr (&Sbase64_encode_string); |
4594 |
defsubr (&Sbase64_decode_string); |
defsubr (&Sbase64_decode_string); |
4595 |
} |
} |
4596 |
|
|
4597 |
|
|
4598 |
|
void |
4599 |
|
init_fns () |
4600 |
|
{ |
4601 |
|
Vweak_hash_tables = Qnil; |
4602 |
|
} |