mirror of
https://github.com/Interlisp/maiko.git
synced 2026-01-18 09:02:39 +00:00
16093186ee
The definition of a function was ifdef'd out, making it seem like perhaps there was an assembly implementation, but there isn't. That platform support is dead weight also at this point, so removing this because it isn't something that will come back is fine.
319 lines
10 KiB
C
319 lines
10 KiB
C
/* $Id: sxhash.c,v 1.4 2001/12/24 01:09:06 sybalsky Exp $ (C) Copyright Venue, All Rights Reserved
|
|
*/
|
|
|
|
/************************************************************************/
|
|
/* */
|
|
/* (C) Copyright 1989-95 Venue. All Rights Reserved. */
|
|
/* Manufactured in the United States of America. */
|
|
/* */
|
|
/************************************************************************/
|
|
|
|
#include "version.h"
|
|
|
|
#include <stdio.h>
|
|
|
|
#include "lispemul.h"
|
|
#include "lspglob.h"
|
|
#include "lispmap.h"
|
|
#include "lsptypes.h"
|
|
#include "emlglob.h"
|
|
#include "adr68k.h"
|
|
#include "address.h"
|
|
#include "stack.h"
|
|
#include "cell.h"
|
|
#include "array.h"
|
|
#include "arith.h"
|
|
|
|
#include "sxhashdefs.h"
|
|
#include "car-cdrdefs.h"
|
|
#include "commondefs.h"
|
|
|
|
/** Follows definition in LLARRAYELT: **/
|
|
#define EQHASHINGBITS(item) \
|
|
((((item) >> 16) & 0xFFFF) ^ ((((item)&0x1FFF) << 3) ^ (((item) >> 9) & 0x7f)))
|
|
|
|
static unsigned short sxhash(LispPTR obj);
|
|
static unsigned short sxhash_rotate(short unsigned int value);
|
|
static unsigned short sxhash_string(OneDArray *obj);
|
|
static unsigned short sxhash_bitvec(OneDArray *obj);
|
|
static unsigned short sxhash_list(LispPTR obj);
|
|
static unsigned short sxhash_pathname(LispPTR obj);
|
|
static unsigned short stringequalhash(LispPTR obj);
|
|
static unsigned short stringhash(LispPTR obj);
|
|
|
|
/****************************************************************/
|
|
/* */
|
|
/* SXHASH */
|
|
/* */
|
|
/* C-coded version of the hashing function SXHASH */
|
|
/* */
|
|
/****************************************************************/
|
|
|
|
LispPTR SX_hash(LispPTR object) {
|
|
return (S_POSITIVE | (0xFFFF & (sxhash(object))));
|
|
/* Smash the top of the stack to a 0xe, offset */
|
|
}
|
|
|
|
/*****************************************************************/
|
|
/* sxhash */
|
|
/* */
|
|
/* Internal function, called from SXHASH, and used for recursive */
|
|
/* calls, e.g., for hashing lists and compound objects. */
|
|
/* Fails to handle ratios, complex's, bitvectors pathnames & odd */
|
|
/* cases */
|
|
/*****************************************************************/
|
|
static unsigned short sxhash(LispPTR obj) {
|
|
/* unsigned short hashOffset; Not Used */
|
|
unsigned int cell;
|
|
unsigned typen;
|
|
OneDArray *str;
|
|
switch (SEGMASK & obj) {
|
|
case S_POSITIVE:
|
|
case S_NEGATIVE: return (obj & 0xFFFF);
|
|
default:
|
|
switch (typen = GetTypeNumber(obj)) {
|
|
case TYPE_FIXP: return ((FIXP_VALUE(obj)) & 0xFFFF);
|
|
case TYPE_FLOATP:
|
|
cell = (unsigned int)FIXP_VALUE(obj);
|
|
return ((cell & 0xFFFF) ^ (cell >> 16));
|
|
#ifdef BIGATOMS
|
|
case TYPE_NEWATOM: /* as for LITATOM... */
|
|
#endif /* BIGATOMS */
|
|
|
|
case TYPE_LITATOM: return (EQHASHINGBITS(obj));
|
|
case TYPE_LISTP: return (sxhash_list(obj));
|
|
case TYPE_PATHNAME: return (sxhash_pathname(obj));
|
|
case TYPE_ONED_ARRAY:
|
|
case TYPE_GENERAL_ARRAY:
|
|
str = (OneDArray *)Addr68k_from_LADDR(obj);
|
|
if (str->stringp) return (sxhash_string(str));
|
|
if (str->bitp) return (sxhash_bitvec(str));
|
|
return (EQHASHINGBITS(obj));
|
|
case TYPE_BIGNUM: {
|
|
LispPTR contents;
|
|
contents = ((BIGNUM *)Addr68k_from_LADDR(obj))->contents;
|
|
return ((unsigned short)car(contents) + (((unsigned short)car(cdr(contents))) << 12));
|
|
}
|
|
|
|
case TYPE_COMPLEX: {
|
|
COMPLEX *object;
|
|
object = (COMPLEX *)Addr68k_from_LADDR(obj);
|
|
return (sxhash(object->real) ^ sxhash(object->imaginary));
|
|
}
|
|
case TYPE_RATIO: {
|
|
RATIO *object;
|
|
object = (RATIO *)Addr68k_from_LADDR(obj);
|
|
return (sxhash(object->numerator) ^ sxhash(object->denominator));
|
|
}
|
|
|
|
default: return (EQHASHINGBITS(obj));
|
|
}
|
|
}
|
|
}
|
|
|
|
/* Rotates the 16-bit work to the left 7 bits (or to the right 9 bits) */
|
|
static unsigned short sxhash_rotate(short unsigned int value) {
|
|
return ((value << 7) | ((value >> 9) & 0x7f));
|
|
}
|
|
|
|
static unsigned short sxhash_string(OneDArray *obj) {
|
|
unsigned len, offset;
|
|
register unsigned short hash = 0;
|
|
len = (unsigned)obj->fillpointer;
|
|
if (len > 13) len = 13;
|
|
offset = (unsigned)obj->offset;
|
|
switch (obj->typenumber) {
|
|
case THIN_CHAR_TYPENUMBER: {
|
|
register char *thin;
|
|
register unsigned i;
|
|
thin = ((char *)(Addr68k_from_LADDR(obj->base))) + offset;
|
|
for (i = 0; i < len; i++) hash = sxhash_rotate(hash ^ GETBYTE(thin++));
|
|
} break;
|
|
case FAT_CHAR_TYPENUMBER: {
|
|
register unsigned short *fat;
|
|
register unsigned i;
|
|
fat = ((unsigned short *)(Addr68k_from_LADDR(obj->base))) + offset;
|
|
for (i = 0; i < len; i++) hash = sxhash_rotate(hash ^ GETWORD(fat++));
|
|
} break;
|
|
default: error("SXHASH of a string not made of chars!\n");
|
|
}
|
|
return (hash);
|
|
}
|
|
|
|
static unsigned short sxhash_bitvec(OneDArray *obj) {
|
|
unsigned short *base;
|
|
unsigned len, offset, bitoffset;
|
|
unsigned short hash = 0;
|
|
len = (unsigned)obj->fillpointer;
|
|
offset = (unsigned)obj->offset;
|
|
base = ((unsigned short *)(Addr68k_from_LADDR(obj->base))) + (offset >> 4);
|
|
if (offset == 0) {
|
|
hash = (*base);
|
|
if (len < 16) hash = hash >> (16 - len);
|
|
} else {
|
|
bitoffset = offset & 15;
|
|
hash = (GETWORD(base++) << (bitoffset));
|
|
hash |= (GETWORD(base) >> (16 - bitoffset));
|
|
if ((len - offset) < 16) hash = hash >> (16 - (len - offset));
|
|
}
|
|
return (hash);
|
|
}
|
|
|
|
static unsigned short sxhash_list(LispPTR obj) {
|
|
unsigned short hash = 0;
|
|
int counter;
|
|
for (counter = 0; (counter < 13) && (GetTypeNumber(obj) == TYPE_LISTP); counter++) {
|
|
hash = sxhash_rotate(hash ^ sxhash(car(obj)));
|
|
obj = cdr(obj);
|
|
}
|
|
return (hash);
|
|
}
|
|
|
|
static unsigned short sxhash_pathname(LispPTR obj) {
|
|
unsigned short hash = 0;
|
|
PATHNAME *path;
|
|
path = (PATHNAME *)(Addr68k_from_LADDR(obj));
|
|
hash = sxhash_rotate(sxhash(path->host) ^ sxhash(path->device));
|
|
hash = sxhash_rotate(hash ^ sxhash(path->type));
|
|
hash = sxhash_rotate(hash ^ sxhash(path->version));
|
|
hash = sxhash_rotate(hash ^ sxhash(path->directory));
|
|
hash = sxhash_rotate(hash ^ sxhash(path->name));
|
|
return (hash);
|
|
}
|
|
|
|
/****************************************************************/
|
|
/* */
|
|
/* STRING-EQUAL-HASHBITS */
|
|
/* */
|
|
/* C-coded version of the hashing function */
|
|
/* STRING-EQUAL-HASHBITS in LLARRAYELT. */
|
|
/* */
|
|
/****************************************************************/
|
|
|
|
LispPTR STRING_EQUAL_HASHBITS(LispPTR object) {
|
|
return (S_POSITIVE | (0xFFFF & (stringequalhash(object))));
|
|
} /* STRING_EQUAL_HASHBITS */
|
|
|
|
static unsigned short stringequalhash(LispPTR obj) {
|
|
unsigned len, offset, fatp, ind;
|
|
register unsigned short hash = 0;
|
|
PNCell *pnptr;
|
|
DLword *base;
|
|
PLCell *Prop;
|
|
OneDArray *str;
|
|
switch (GetTypeNumber(obj)) {
|
|
#ifdef BIGATOMS
|
|
case TYPE_NEWATOM: /* as for LITATOM; it's all in the macros below. */
|
|
#endif /* BIGATOMS */
|
|
|
|
case TYPE_LITATOM:
|
|
ind = ((int)obj) & POINTERMASK;
|
|
pnptr = (PNCell *)GetPnameCell(ind);
|
|
base = (DLword *)Addr68k_from_LADDR(pnptr->pnamebase);
|
|
Prop = (PLCell *)GetPropCell(ind);
|
|
fatp = Prop->fatpnamep;
|
|
offset = 1;
|
|
len = GETBYTE((unsigned char *)base);
|
|
break;
|
|
case TYPE_ONED_ARRAY:
|
|
case TYPE_GENERAL_ARRAY:
|
|
str = (OneDArray *)Addr68k_from_LADDR(obj);
|
|
if (str->stringp) {
|
|
fatp = (str->typenumber) == FAT_CHAR_TYPENUMBER;
|
|
base = Addr68k_from_LADDR(str->base);
|
|
offset = str->offset;
|
|
len = str->fillpointer;
|
|
} else
|
|
return (EQHASHINGBITS(obj));
|
|
break;
|
|
default: return (EQHASHINGBITS(obj));
|
|
};
|
|
|
|
if (fatp) {
|
|
register unsigned short *fat;
|
|
register unsigned i;
|
|
fat = ((unsigned short *)base) + offset;
|
|
for (i = 0; i < len; i++) {
|
|
hash = hash + ((hash & 0xFFF) << 2);
|
|
hash = hash + (0x20 | GETWORD(fat++)) + ((hash & 0xFF) << 8);
|
|
}
|
|
} else {
|
|
register char *thin;
|
|
register unsigned i;
|
|
thin = ((char *)base) + offset;
|
|
for (i = 0; i < len; i++) {
|
|
hash = hash + ((hash & 0xFFF) << 2);
|
|
hash = hash + (0x20 | GETBYTE(thin++)) + ((hash & 0xFF) << 8);
|
|
}
|
|
}
|
|
return (hash);
|
|
}
|
|
|
|
/****************************************************************/
|
|
/* */
|
|
/* STRING-HASHBITS */
|
|
/* */
|
|
/* C-coded version of the hashing function */
|
|
/* STRINGHASHBITS in LLARRAYELT. */
|
|
/* */
|
|
/****************************************************************/
|
|
|
|
LispPTR STRING_HASHBITS(LispPTR object) {
|
|
return (S_POSITIVE | (0xFFFF & (stringhash(object))));
|
|
} /* STRING_HASHBITS */
|
|
|
|
static unsigned short stringhash(LispPTR obj) {
|
|
unsigned len, offset, fatp, ind;
|
|
register unsigned short hash = 0;
|
|
PNCell *pnptr;
|
|
DLword *base;
|
|
PLCell *Prop;
|
|
OneDArray *str;
|
|
switch (GetTypeNumber(obj)) {
|
|
#ifdef BIGATOMS
|
|
case TYPE_NEWATOM: /* as for LITATOM; it's all in the macros below. */
|
|
#endif /* BIGATOMS */
|
|
|
|
case TYPE_LITATOM:
|
|
ind = ((int)obj) & POINTERMASK;
|
|
pnptr = (PNCell *)GetPnameCell(ind);
|
|
base = (DLword *)Addr68k_from_LADDR(pnptr->pnamebase);
|
|
Prop = (PLCell *)GetPropCell(ind);
|
|
fatp = Prop->fatpnamep;
|
|
offset = 1;
|
|
len = GETBYTE((unsigned char *)base);
|
|
break;
|
|
case TYPE_ONED_ARRAY:
|
|
case TYPE_GENERAL_ARRAY:
|
|
str = (OneDArray *)Addr68k_from_LADDR(obj);
|
|
if (str->stringp) {
|
|
fatp = (str->typenumber) == FAT_CHAR_TYPENUMBER;
|
|
base = Addr68k_from_LADDR(str->base);
|
|
offset = str->offset;
|
|
len = str->fillpointer;
|
|
} else
|
|
return (EQHASHINGBITS(obj));
|
|
break;
|
|
default: return (EQHASHINGBITS(obj));
|
|
}; /* switch */
|
|
|
|
if (fatp) {
|
|
register unsigned short *fat;
|
|
register unsigned i;
|
|
fat = ((unsigned short *)base) + offset;
|
|
for (i = 0; i < len; i++) {
|
|
hash = hash + ((hash & 0xFFF) << 2);
|
|
hash = hash + GETWORD(fat++) + ((hash & 0xFF) << 8);
|
|
}
|
|
} else {
|
|
register char *thin;
|
|
register unsigned i;
|
|
thin = ((char *)base) + offset;
|
|
for (i = 0; i < len; i++) {
|
|
hash = hash + ((hash & 0xFFF) << 2);
|
|
hash = hash + GETBYTE(thin++) + ((hash & 0xFF) << 8);
|
|
}
|
|
}
|
|
return (hash);
|
|
} /* stringhash */
|