AFFEND
static void hashtable_expand(arc *c, value hash)
{
unsigned int hv, index, i, j, nhashbits;
value oldtbl, newtbl, e;
nhashbits = HASH_BITS(hash) + 1;
newtbl = arc_mkvector(c, HASHSIZE(nhashbits));
((struct cell *)newtbl)->_type = T_TABLEVEC;
for (i=0; i<HASHSIZE(nhashbits); i++)
XVINDEX(newtbl, i) = CUNBOUND;
oldtbl = HASH_TABLE(hash);
/* Search for active keys and move them into the new table */
for (i=0; i<VECLEN(oldtbl); i++) {
e = VINDEX(oldtbl, i);
if (EMPTYP(e))
continue;
/* remove the old link now that we have a copy */
SVINDEX(oldtbl, i, CUNBOUND);
/* insert the old key into the new table */
hv = (unsigned int)FIX2INT(BHASHVAL(e));
index = hv & HASHMASK(nhashbits);
for (j=0; !EMPTYP(VINDEX(newtbl, index)); j++)
index = (index + PROBE(j)) & HASHMASK(nhashbits);
BTABLE(e) = newtbl;
XVINDEX(newtbl, index) = e;
SBINDEX(e, index); /* change index */
SVINDEX(oldtbl, i, CUNBOUND);
}
SET_HASHBITS(hash, nhashbits);
SET_LLIMIT(hash, (HASHSIZE(nhashbits)*MAX_LOAD_FACTOR) / 100);
HASH_TABLE(hash) = newtbl;
}
CELL func_append(CELL frame)
{
if (FC == 0) {
return V_NULL;
}
CELL pre_tail = V_EMPTY;
CELL result = V_EMPTY;
CELL arg = V_EMPTY;
gc_root_4("func_append", frame, pre_tail, result, arg);
result = FV[FC-1];
int argi = 0;
while(argi < FC-1) {
arg = FV[argi++];
while(CONSP(arg)) {
const CELL next = make_cons(CAR(arg), FV[FC-1]);
if (EMPTYP(pre_tail)) {
pre_tail = result = next;
}
else {
pre_tail = CDR(pre_tail) = next;
}
arg = CDR(arg);
}
if (!NULLP(arg)) {
gc_unroot();
return make_exception("expects a <proper list> for all but last argument");
}
}
gc_unroot();
return result;
}
value arc_hash_insert(arc *c, value hash, value key, value val)
{
unsigned int hv, index, i;
value e;
index = 0;
/* First of all, look for the key if a binding already exists for it */
e = hash_lookup(c, hash, key, &index);
if (BOUND_P(e)) {
/* if we are already bound, overwrite the old value */
e = VINDEX(HASH_TABLE(hash), index);
BVALUE(e) = val;
return(val);
}
/* Not yet bound. Look for a slot where we can put it */
if (HASH_NENTRIES(hash)+1 > HASH_LLIMIT(hash))
hashtable_expand(c, hash);
SET_NENTRIES(hash, HASH_NENTRIES(hash)+1);
hv = arc_hash(c, key);
index = hv & TABLEMASK(hash);
for (i=0;; i++) {
e = VINDEX(HASH_TABLE(hash), index);
/* If we see an empty bucket in our search, or if we see a bucket
whose key is the same as the key specified, we have found the
place where the element should go. This second case should never
happen, based on what we did above, but hey, belt and suspenders. */
if (EMPTYP(e) || arc_is2(c, BKEY(e), key) == CTRUE)
break;
/* We found a bucket, but it is occupied by some other key. Continue
probing. */
index = (index + PROBE(i)) & TABLEMASK(hash);
}
if (EMPTYP(e)) {
/* No such key in the hash table yet. Create a bucket and
assign it to the table. */
e = mkhashbucket(c, key, val, index, hash, INT2FIX(hv));
SVINDEX(HASH_TABLE(hash), index, e);
} else {
/* The key already exists. Use the current bucket but change the
value to the value specified. */
BVALUE(e) = val;
}
return(val);
}
static void tablevec_sweeper(arc *c, value v)
{
int i;
/* Clear the BTABLE links for any active buckets within this tablevec
before fully sweeping it away. */
for (i=0; i<VECLEN(v); i++) {
if (EMPTYP(VINDEX(v, i)))
continue;
BTABLE(VINDEX(v, i)) = CNIL;
}
}
int arc_hash_length(arc *c, value hash)
{
int count, i;
value e, tbl;
count = 0;
tbl = HASH_TABLE(hash);
for (i=0; i<VECLEN(tbl); i++) {
e = VINDEX(tbl, i);
if (EMPTYP(e))
continue;
count++;
}
return(count);
}
static AFFDEF(hash_isocmp)
{
AARG(v1, v2, vh1, vh2);
AVAR(iso2, tbl, e, v2val, i);
value vhh1, vhh2; /* not required after calls */
AFBEGIN;
if ((vhh1 = __arc_visit(c, AV(v1), AV(vh1))) != CNIL) {
/* If we find a visited object, see if v2 is also visited in vh2.
If not, they are not the same. */
vhh2 = __arc_visit(c, AV(v2), AV(vh2));
/* We see if the same value was produced on visiting. */
ARETURN((vhh2 == vhh1) ? CTRUE : CNIL);
}
/* Get value assigned by __arc_visit to v1. */
vhh1 = __arc_visit(c, AV(v1), AV(vh1));
/* If we somehow already visited v2 when v1 was not visited in the
same way, they cannot be the same. */
if (__arc_visit2(c, AV(v2), AV(vh2), vhh1) != CNIL)
ARETURN(CNIL);
/* Two hash tables must have identical numbers of entries to be isomorphic */
if (HASH_NENTRIES(AV(v1)) != HASH_NENTRIES(AV(v2)))
ARETURN(CNIL);
WV(tbl, HASH_TABLE(AV(v1)));
WV(iso2, arc_mkaff(c, arc_iso2, CNIL));
for (WV(i, INT2FIX(0)); FIX2INT(AV(i))<VECLEN(AV(tbl));
WV(i, INT2FIX(FIX2INT(AV(i)) + 1))) {
WV(e, VINDEX(AV(tbl), FIX2INT(AV(i))));
if (EMPTYP(AV(e)))
continue;
WV(v2val, arc_hash_lookup(c, AV(v2), BKEY(AV(e))));
AFCALL(AV(iso2), BVALUE(AV(e)), AV(v2val), AV(vh1), AV(vh2));
if (NIL_P(AFCRV))
ARETURN(CNIL);
}
ARETURN(CTRUE);
AFEND;
}
