151 lines
4.3 KiB
C
151 lines
4.3 KiB
C
/***********************************************************************/
|
|
/* */
|
|
/* Objective Caml */
|
|
/* */
|
|
/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */
|
|
/* */
|
|
/* Copyright 1996 Institut National de Recherche en Informatique et */
|
|
/* en Automatique. All rights reserved. This file is distributed */
|
|
/* under the terms of the GNU Library General Public License. */
|
|
/* */
|
|
/***********************************************************************/
|
|
|
|
/* $Id$ */
|
|
|
|
/* The generic hashing primitive */
|
|
|
|
#include "mlvalues.h"
|
|
#include "custom.h"
|
|
#include "memory.h"
|
|
|
|
static unsigned long hash_accu;
|
|
static long hash_univ_limit, hash_univ_count;
|
|
|
|
static void hash_aux(value obj);
|
|
|
|
value hash_univ_param(value count, value limit, value obj) /* ML */
|
|
{
|
|
hash_univ_limit = Long_val(limit);
|
|
hash_univ_count = Long_val(count);
|
|
hash_accu = 0;
|
|
hash_aux(obj);
|
|
return Val_long(hash_accu & 0x3FFFFFFF);
|
|
/* The & has two purposes: ensure that the return value is positive
|
|
and give the same result on 32 bit and 64 bit architectures. */
|
|
}
|
|
|
|
#define Alpha 65599
|
|
#define Beta 19
|
|
#define Combine(new) (hash_accu = hash_accu * Alpha + (new))
|
|
#define Combine_small(new) (hash_accu = hash_accu * Beta + (new))
|
|
|
|
static void hash_aux(value obj)
|
|
{
|
|
unsigned char * p;
|
|
mlsize_t i, j;
|
|
tag_t tag;
|
|
|
|
hash_univ_limit--;
|
|
if (hash_univ_count < 0 || hash_univ_limit < 0) return;
|
|
|
|
if (Is_long(obj)) {
|
|
hash_univ_count--;
|
|
Combine(Long_val(obj));
|
|
return;
|
|
}
|
|
|
|
/* Pointers into the heap are well-structured blocks. So are atoms.
|
|
We can inspect the block contents. */
|
|
|
|
if (Is_atom(obj) || Is_young(obj) || Is_in_heap(obj)) {
|
|
tag = Tag_val(obj);
|
|
switch (tag) {
|
|
case String_tag:
|
|
hash_univ_count--;
|
|
i = string_length(obj);
|
|
for (p = &Byte_u(obj, 0); i > 0; i--, p++)
|
|
Combine_small(*p);
|
|
break;
|
|
case Double_tag:
|
|
/* For doubles, we inspect their binary representation, LSB first.
|
|
The results are consistent among all platforms with IEEE floats. */
|
|
hash_univ_count--;
|
|
#ifdef ARCH_BIG_ENDIAN
|
|
for (p = &Byte_u(obj, sizeof(double) - 1), i = sizeof(double);
|
|
i > 0;
|
|
p--, i--)
|
|
#else
|
|
for (p = &Byte_u(obj, 0), i = sizeof(double);
|
|
i > 0;
|
|
p++, i--)
|
|
#endif
|
|
Combine_small(*p);
|
|
break;
|
|
case Double_array_tag:
|
|
hash_univ_count--;
|
|
for (j = 0; j < Bosize_val(obj); j += sizeof(double)) {
|
|
#ifdef ARCH_BIG_ENDIAN
|
|
for (p = &Byte_u(obj, j + sizeof(double) - 1), i = sizeof(double);
|
|
i > 0;
|
|
p--, i--)
|
|
#else
|
|
for (p = &Byte_u(obj, j), i = sizeof(double);
|
|
i > 0;
|
|
p++, i--)
|
|
#endif
|
|
Combine_small(*p);
|
|
}
|
|
break;
|
|
case Abstract_tag:
|
|
/* We don't know anything about the contents of the block.
|
|
Better do nothing. */
|
|
break;
|
|
case Infix_tag:
|
|
hash_aux(obj - Infix_offset_val(obj));
|
|
break;
|
|
case Object_tag:
|
|
hash_univ_count--;
|
|
Combine(Oid_val(obj));
|
|
break;
|
|
case Custom_tag:
|
|
/* If no hashing function provided, do nothing */
|
|
if (Custom_ops_val(obj)->hash != NULL) {
|
|
hash_univ_count--;
|
|
Combine(Custom_ops_val(obj)->hash(obj));
|
|
}
|
|
break;
|
|
default:
|
|
hash_univ_count--;
|
|
Combine_small(tag);
|
|
i = Wosize_val(obj);
|
|
while (i != 0) {
|
|
i--;
|
|
hash_aux(Field(obj, i));
|
|
}
|
|
break;
|
|
}
|
|
return;
|
|
}
|
|
|
|
/* Otherwise, obj is a pointer outside the heap, to an object with
|
|
a priori unknown structure. Use its physical address as hash key. */
|
|
Combine((long) obj);
|
|
}
|
|
|
|
/* Hashing variant tags */
|
|
|
|
value hash_variant(char * tag)
|
|
{
|
|
value accu;
|
|
/* Same hashing algorithm as in ../typing/btype.ml, function hash_variant */
|
|
for (accu = Val_int(0); *tag != 0; tag++)
|
|
accu = Val_int(223 * Int_val(accu) + *((unsigned char *) tag));
|
|
#ifdef ARCH_SIXTYFOUR
|
|
accu = accu & Val_int(0x7FFFFFFF);
|
|
#endif
|
|
/* Force sign extension of bit 31 for compatibility between 32 and 64-bit
|
|
platforms */
|
|
return (int32) accu;
|
|
}
|
|
|