suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix equal hashing with stack overflow

Browse Source 
svn: r1717
This commit is contained in:
Matthew Flatt 2005-12-30 15:49:20 +00:00
parent 894a3c6260
commit 1e0dfa7a44
2 changed files with 64 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
src/mzscheme/src/hash.c
View File

@ -893,24 +893,31 @@ END_XFORM_SKIP;
/* equal? hashing */
/*========================================================================*/
static long equal_hash_key(Scheme_Object *o, long k);
static Scheme_Object *hash_k(void)
{
Scheme_Thread *p = scheme_current_thread;
Scheme_Object *v = (Scheme_Object *)p->ku.k.p1;
long nv;
p->ku.k.p1 = NULL;
return (Scheme_Object *)scheme_equal_hash_key(v);
nv = equal_hash_key(v, p->ku.k.i1);
return scheme_make_integer_value(nv);
}
/* Number of lists/vectors/structs/boxes to hash before
paying for a stack check. */
#define HASH_COUNT_START 20
long scheme_equal_hash_key(Scheme_Object *o)
#define MZ_HASH_K hash_k
#define MZ_HASH_I1 (k - t)
static long equal_hash_key(Scheme_Object *o, long k)
{
Scheme_Type t;
long k = 0;
static int hash_counter = HASH_COUNT_START;
top:
@ -951,7 +958,7 @@ long scheme_equal_hash_key(Scheme_Object *o)
break;
case scheme_rational_type:
{
k += scheme_equal_hash_key(scheme_rational_numerator(o));
k += equal_hash_key(scheme_rational_numerator(o), 0);
o = scheme_rational_denominator(o);
break;
}
@ -959,14 +966,14 @@ long scheme_equal_hash_key(Scheme_Object *o)
case scheme_complex_izi_type:
{
Scheme_Complex *c = (Scheme_Complex *)o;
k += scheme_equal_hash_key(c->r);
k += equal_hash_key(c->r, 0);
o = c->i;
break;
}
case scheme_pair_type:
{
# include "mzhashchk.inc"
k += scheme_equal_hash_key(SCHEME_CAR(o));
k += equal_hash_key(SCHEME_CAR(o), 0);
o = SCHEME_CDR(o);
break;
}
@ -982,7 +989,7 @@ long scheme_equal_hash_key(Scheme_Object *o)
--len;
for (i = 0; i < len; i++) {
SCHEME_USE_FUEL(1);
val = scheme_equal_hash_key(SCHEME_VEC_ELS(o)[i]);
val = equal_hash_key(SCHEME_VEC_ELS(o)[i], 0);
k = (k << 5) + k + val;
}
@ -1024,7 +1031,7 @@ long scheme_equal_hash_key(Scheme_Object *o)
# include "mzhashchk.inc"
for (i = SCHEME_STRUCT_NUM_SLOTS(s1); i--; ) {
k += scheme_equal_hash_key(s1->slots[i]);
k += equal_hash_key(s1->slots[i], 0);
k = (k << 5) + k;
}
@ -1042,7 +1049,7 @@ long scheme_equal_hash_key(Scheme_Object *o)
}
case scheme_hash_table_type:
{
Scheme_Hash_Table *t = (Scheme_Hash_Table *)o;
Scheme_Hash_Table *ht = (Scheme_Hash_Table *)o;
Scheme_Object **vals, **keys;
int i;
@ -1050,12 +1057,12 @@ long scheme_equal_hash_key(Scheme_Object *o)
k = (k << 1) + 3;
keys = t->keys;
vals = t->vals;
for (i = t->size; i--; ) {
keys = ht->keys;
vals = ht->vals;
for (i = ht->size; i--; ) {
if (vals[i]) {
k += scheme_equal_hash_key(keys[i]);
k += (scheme_equal_hash_key(vals[i]) << 1);
k += equal_hash_key(keys[i], 0);
k += (equal_hash_key(vals[i], 0) << 1);
}
}
@ -1063,19 +1070,19 @@ long scheme_equal_hash_key(Scheme_Object *o)
}
case scheme_bucket_table_type:
{
Scheme_Bucket_Table *t = (Scheme_Bucket_Table *)o;
Scheme_Bucket_Table *ht = (Scheme_Bucket_Table *)o;
Scheme_Bucket **buckets, *bucket;
const char *key;
int i, weak;
# include "mzhashchk.inc"
buckets = t->buckets;
weak = t->weak;
buckets = ht->buckets;
weak = ht->weak;
k = (k << 1) + 7;
for (i = t->size; i--; ) {
for (i = ht->size; i--; ) {
bucket = buckets[i];
if (bucket) {
if (weak) {
@ -1084,8 +1091,8 @@ long scheme_equal_hash_key(Scheme_Object *o)
key = bucket->key;
}
if (key) {
k += (scheme_equal_hash_key((Scheme_Object *)bucket->val) << 1);
k += scheme_equal_hash_key((Scheme_Object *)key);
k += (equal_hash_key((Scheme_Object *)bucket->val, 0) << 1);
k += equal_hash_key((Scheme_Object *)key, 0);
}
}
}
@ -1123,6 +1130,29 @@ long scheme_equal_hash_key(Scheme_Object *o)
goto top;
}
long scheme_equal_hash_key(Scheme_Object *o)
{
return equal_hash_key(o, 0);
}
static Scheme_Object *hash2_k(void)
{
Scheme_Thread *p = scheme_current_thread;
Scheme_Object *v = (Scheme_Object *)p->ku.k.p1;
long nv;
p->ku.k.p1 = NULL;
nv = scheme_equal_hash_key2(v);
return scheme_make_integer(nv);
}
#undef MZ_HASH_K
#undef MZ_HASH_I1
#define MZ_HASH_K hash2_k
#define MZ_HASH_I1 0
long scheme_equal_hash_key2(Scheme_Object *o)
{
Scheme_Type t;
@ -1229,16 +1259,16 @@ long scheme_equal_hash_key2(Scheme_Object *o)
goto top;
case scheme_hash_table_type:
{
Scheme_Hash_Table *t = (Scheme_Hash_Table *)o;
Scheme_Hash_Table *ht = (Scheme_Hash_Table *)o;
Scheme_Object **vals, **keys;
int i;
long k = 0;
# include "mzhashchk.inc"
keys = t->keys;
vals = t->vals;
for (i = t->size; i--; ) {
keys = ht->keys;
vals = ht->vals;
for (i = ht->size; i--; ) {
if (vals[i]) {
k += scheme_equal_hash_key2(keys[i]);
k += scheme_equal_hash_key2(vals[i]);
@ -1249,7 +1279,7 @@ long scheme_equal_hash_key2(Scheme_Object *o)
}
case scheme_bucket_table_type:
{
Scheme_Bucket_Table *t = (Scheme_Bucket_Table *)o;
Scheme_Bucket_Table *ht = (Scheme_Bucket_Table *)o;
Scheme_Bucket **buckets, *bucket;
const char *key;
int i, weak;
@ -1257,10 +1287,10 @@ long scheme_equal_hash_key2(Scheme_Object *o)
# include "mzhashchk.inc"
buckets = t->buckets;
weak = t->weak;
buckets = ht->buckets;
weak = ht->weak;
for (i = t->size; i--; ) {
for (i = ht->size; i--; ) {
bucket = buckets[i];
if (bucket) {
if (weak) {

7
src/mzscheme/src/mzhashchk.inc
View File

@ -7,11 +7,16 @@
{
#include "mzstkchk.h"
{
Scheme_Object *nv;
long val;
#ifndef ERROR_ON_OVERFLOW
Scheme_Thread *p = scheme_current_thread;
p->ku.k.p1 = (void *)o;
p->ku.k.i1 = MZ_HASH_I1;
#endif
return (long)scheme_handle_stack_overflow(hash_k);
nv = scheme_handle_stack_overflow(MZ_HASH_K);
scheme_get_int_val(nv, &val);
return val;
}
}
#endif