hash bug, Yuasa fix

[Robert S. Boyer <boyer@CLI.COM>]

A bug report:

   From boyer Sat Mar 11 22:06:44 1989
   To: yuasa%tutics.tut.junet%utokyo-relay.csnet@RELAY.CS.NET
   Subject:  obscure hash bug?
   Reply-to: boyer@cli.com

   Surely the fourth form below should not return b1!

     (setq ht (make-hash-table :test #'equal :size 1))
     (setf (gethash 'a ht) 'a1)
     (setf (gethash 'b ht) 'b1)
     (gethash 'c ht)

A bug fix:

Date: Thu, 16 Mar 89 22:23:05 jst
From: Taiichi Yuasa <yuasa%tutics.tut.junet%utokyo-relay.csnet@RELAY.CS.NET>
To: boyer@CLI.COM
Subject: Re: obscure hash bug?


>Date: Sat, 11 Mar 89
>From: boyer@cli.com
>Subject:  obscure hash bug?

Yes, there were bugs in hash functions in file c/hash.d.  To fix these 
bugs,
replace the definitions of the C functions gethash, sethash, and
extend_hashtable, and add a new C function gethash1, as follows.




struct htent *
gethash(key, hashtable)
object key;
object hashtable;
{
	enum httest htest;
	int hsize;
	struct htent *e;
	object hkey;
	int i, j = -1, k;
	bool b;

	htest = (enum httest)hashtable->ht.ht_test;
	hsize = hashtable->ht.ht_size;
	if (htest == htt_eq)
		i = (int)key / 4;
	else if (htest == htt_eql)
		i = hash_eql(key);
	else if (htest == htt_equal)
		i = hash_equal(key);
	i &= 0x7fffffff;
	for (i %= hsize, k = 0; k < hsize;  i = (i + 1) % hsize, k++) {
		e = &hashtable->ht.ht_self[i];
		hkey = e->hte_key;
		if (hkey == OBJNULL) {
			if (e->hte_value == OBJNULL)
				if (j < 0)
					return(e);
				else
					return(&hashtable->ht.ht_self[j]);
			else
				if (j < 0)
					j = i;
				else
					;
			continue;
		}
		if (htest == htt_eq)
		    	b = key == hkey;
		else if (htest == htt_eql)
			b = eql(key, hkey);
		else if (htest == htt_equal)
			b = equal(key, hkey);
		if (b)
			return(&hashtable->ht.ht_self[i]);
	}
	return(&hashtable->ht.ht_self[j]);
}

struct htent *
gethash1(key, hashtable)
object key;
object hashtable;
{
	enum httest htest;
	int i, hsize;
	bool b;

	htest = (enum httest)hashtable->ht.ht_test;
	hsize = hashtable->ht.ht_size;
	if (htest == htt_eq)
		i = (int)key / 4;
	else if (htest == htt_eql)
		i = hash_eql(key);
	else if (htest == htt_equal)
		i = hash_equal(key);
	i &= 0x7fffffff;
	for (i %= hsize; ; i = (i + 1) % hsize)
		if (hashtable->ht.ht_self[i].hte_key == OBJNULL)
			return(&hashtable->ht.ht_self[i]);
}

sethash(key, hashtable, value)
object key, hashtable, value;
{
	int i;
	bool over;
	struct htent *e;
	e = gethash(key, hashtable);
	if (e->hte_key != OBJNULL) {
		e->hte_value = value;
		return;
	}
	i = hashtable->ht.ht_nent + 1;
	if (i >= hashtable->ht.ht_size)
		over = TRUE;
	else if (type_of(hashtable->ht.ht_rhthresh) == t_fixnum)
		over = i >= fix(hashtable->ht.ht_rhthresh);
	else if (type_of(hashtable->ht.ht_rhthresh) == t_shortfloat)
		over =
		i >= hashtable->ht.ht_size * sf(hashtable->ht.ht_rhthresh);
	else if (type_of(hashtable->ht.ht_rhthresh) == t_longfloat)
		over =
		i >= hashtable->ht.ht_size * lf(hashtable->ht.ht_rhthresh);
	if (over) {
		extend_hashtable(hashtable);
		e = gethash1(key, hashtable);
	}
	hashtable->ht.ht_nent++;
	e->hte_key = key;
	e->hte_value = value;
}
	
extend_hashtable(hashtable)
object hashtable;
{
	object old, key;
	int old_size, new_size, i;
	struct htent *e;
	old_size = hashtable->ht.ht_size;
	if (type_of(hashtable->ht.ht_rhsize) == t_fixnum)
		new_size = old_size + fix(hashtable->ht.ht_rhsize);
	else if (type_of(hashtable->ht.ht_rhsize) == t_shortfloat)
		new_size = old_size * sf(hashtable->ht.ht_rhsize);
	else if (type_of(hashtable->ht.ht_rhsize) == t_longfloat)
		new_size = old_size * lf(hashtable->ht.ht_rhsize);
	if (new_size <= old_size)
		new_size = old_size + 1;
	old = alloc_object(t_hashtable);
	old->ht = hashtable->ht;
	vs_push(old);
	hashtable->ht.ht_self = NULL;
	hashtable->ht.ht_size = new_size;
	if (type_of(hashtable->ht.ht_rhthresh) == t_fixnum)
		hashtable->ht.ht_rhthresh =
		make_fixnum(fix(hashtable->ht.ht_rhthresh) +
			    (new_size - old->ht.ht_size));
	hashtable->ht.ht_self =
	(struct htent *)alloc_relblock(new_size * sizeof(struct htent));
	for (i = 0;  i < new_size;  i++) {
		hashtable->ht.ht_self[i].hte_key = OBJNULL;
		hashtable->ht.ht_self[i].hte_value = OBJNULL;
	}
	for (i = 0;  i < old_size;  i++)
		if ((key = old->ht.ht_self[i].hte_key) != OBJNULL) {
			e = gethash1(key, hashtable);
			e->hte_key = key;
			e->hte_value = old->ht.ht_self[i].hte_value;
		}
	vs_pop;
}

--- Taiichi