/* 

 * tclHash.c --

 *

 *	Implementation of in-memory hash tables for Tcl and Tcl-based

 *	applications.

 *

 * Copyright (c) 1991-1993 The Regents of the University of California.

 * Copyright (c) 1994 Sun Microsystems, Inc.

 * Portions Copyright (c) 2007-2008 Nokia Corporation and/or its subsidiaries. All rights reserved.  

 *

 * See the file "license.terms" for information on usage and redistribution

 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.

 *

 * RCS: @(#) $Id: tclHash.c,v 1.12.2.1 2004/11/11 01:18:07 das Exp $

 */

#include "tclInt.h"

/*

 * Prevent macros from clashing with function definitions.

 */

#if TCL_PRESERVE_BINARY_COMPATABILITY

#   undef Tcl_FindHashEntry

#   undef Tcl_CreateHashEntry

#endif

/*

 * When there are this many entries per bucket, on average, rebuild

 * the hash table to make it larger.

 */

#define REBUILD_MULTIPLIER	3

/*

 * The following macro takes a preliminary integer hash value and

 * produces an index into a hash tables bucket list.  The idea is

 * to make it so that preliminary values that are arbitrarily similar

 * will end up in different buckets.  The hash function was taken

 * from a random-number generator.

 */

#define RANDOM_INDEX(tablePtr, i) \

    (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)

/*

 * Prototypes for the array hash key methods.

 */

static Tcl_HashEntry *	AllocArrayEntry _ANSI_ARGS_((

			    Tcl_HashTable *tablePtr,

			    VOID *keyPtr));

static int		CompareArrayKeys _ANSI_ARGS_((

			    VOID *keyPtr, Tcl_HashEntry *hPtr));

static unsigned int	HashArrayKey _ANSI_ARGS_((

			    Tcl_HashTable *tablePtr,

			    VOID *keyPtr));

/*

 * Prototypes for the one word hash key methods.

 */

#if 0

static Tcl_HashEntry *	AllocOneWordEntry _ANSI_ARGS_((

			    Tcl_HashTable *tablePtr,

			    VOID *keyPtr));

static int		CompareOneWordKeys _ANSI_ARGS_((

			    VOID *keyPtr, Tcl_HashEntry *hPtr));

static unsigned int	HashOneWordKey _ANSI_ARGS_((

			    Tcl_HashTable *tablePtr,

			    VOID *keyPtr));

#endif

/*

 * Prototypes for the string hash key methods.

 */

static Tcl_HashEntry *	AllocStringEntry _ANSI_ARGS_((

			    Tcl_HashTable *tablePtr,

			    VOID *keyPtr));

static int		CompareStringKeys _ANSI_ARGS_((

			    VOID *keyPtr, Tcl_HashEntry *hPtr));

static unsigned int	HashStringKey _ANSI_ARGS_((

			    Tcl_HashTable *tablePtr,

			    VOID *keyPtr));

/*

 * Procedure prototypes for static procedures in this file:

 */

#if TCL_PRESERVE_BINARY_COMPATABILITY

static Tcl_HashEntry *	BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,

			    CONST char *key));

static Tcl_HashEntry *	BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,

			    CONST char *key, int *newPtr));

#endif

static void		RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));

Tcl_HashKeyType tclArrayHashKeyType = {

    TCL_HASH_KEY_TYPE_VERSION,		/* version */

    TCL_HASH_KEY_RANDOMIZE_HASH,	/* flags */

    HashArrayKey,			/* hashKeyProc */

    CompareArrayKeys,			/* compareKeysProc */

    AllocArrayEntry,			/* allocEntryProc */

    NULL				/* freeEntryProc */

};

Tcl_HashKeyType tclOneWordHashKeyType = {

    TCL_HASH_KEY_TYPE_VERSION,		/* version */

    0,					/* flags */

    NULL, /* HashOneWordKey, */		/* hashProc */

    NULL, /* CompareOneWordKey, */	/* compareProc */

    NULL, /* AllocOneWordKey, */	/* allocEntryProc */

    NULL  /* FreeOneWordKey, */		/* freeEntryProc */

};

Tcl_HashKeyType tclStringHashKeyType = {

    TCL_HASH_KEY_TYPE_VERSION,		/* version */

    0,					/* flags */

    HashStringKey,			/* hashKeyProc */

    CompareStringKeys,			/* compareKeysProc */

    AllocStringEntry,			/* allocEntryProc */

    NULL				/* freeEntryProc */

};

/*

 *----------------------------------------------------------------------

 *

 * Tcl_InitHashTable --

 *

 *	Given storage for a hash table, set up the fields to prepare

 *	the hash table for use.

 *

 * Results:

 *	None.

 *

 * Side effects:

 *	TablePtr is now ready to be passed to Tcl_FindHashEntry and

 *	Tcl_CreateHashEntry.

 *

 *----------------------------------------------------------------------

 */

#undef Tcl_InitHashTable

EXPORT_C void

Tcl_InitHashTable(tablePtr, keyType)

    register Tcl_HashTable *tablePtr;	/* Pointer to table record, which

					 * is supplied by the caller. */

    int keyType;			/* Type of keys to use in table:

					 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,

					 * or an integer >= 2. */

{

    /*

     * Use a special value to inform the extended version that it must

     * not access any of the new fields in the Tcl_HashTable. If an

     * extension is rebuilt then any calls to this function will be

     * redirected to the extended version by a macro.

     */

    Tcl_InitCustomHashTable(tablePtr, keyType, (Tcl_HashKeyType *) -1);

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_InitCustomHashTable --

 *

 *	Given storage for a hash table, set up the fields to prepare

 *	the hash table for use. This is an extended version of

 *	Tcl_InitHashTable which supports user defined keys.

 *

 * Results:

 *	None.

 *

 * Side effects:

 *	TablePtr is now ready to be passed to Tcl_FindHashEntry and

 *	Tcl_CreateHashEntry.

 *

 *----------------------------------------------------------------------

 */

EXPORT_C void

Tcl_InitCustomHashTable(tablePtr, keyType, typePtr)

    register Tcl_HashTable *tablePtr;	/* Pointer to table record, which

					 * is supplied by the caller. */

    int keyType;			/* Type of keys to use in table:

					 * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,

					 * TCL_CUSTOM_TYPE_KEYS,

					 * TCL_CUSTOM_PTR_KEYS,  or an

					 * integer >= 2. */

    Tcl_HashKeyType *typePtr;		/* Pointer to structure which defines

					 * the behaviour of this table. */

{

#if (TCL_SMALL_HASH_TABLE != 4) 

    panic("Tcl_InitCustomHashTable: TCL_SMALL_HASH_TABLE is %d, not 4\n",

	    TCL_SMALL_HASH_TABLE);

#endif

    tablePtr->buckets = tablePtr->staticBuckets;

    tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;

    tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;

    tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;

    tablePtr->numEntries = 0;

    tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;

    tablePtr->downShift = 28;

    tablePtr->mask = 3;

    tablePtr->keyType = keyType;

#if TCL_PRESERVE_BINARY_COMPATABILITY

    tablePtr->findProc = Tcl_FindHashEntry;

    tablePtr->createProc = Tcl_CreateHashEntry;

    if (typePtr == NULL) {

	/*

	 * The caller has been rebuilt so the hash table is an extended

	 * version.

	 */

    } else if (typePtr != (Tcl_HashKeyType *) -1) {

	/*

	 * The caller is requesting a customized hash table so it must be

	 * an extended version.

	 */

	tablePtr->typePtr = typePtr;

    } else {

	/*

	 * The caller has not been rebuilt so the hash table is not

	 * extended.

	 */

    }

#else

    if (typePtr == NULL) {

	/*

	 * Use the key type to decide which key type is needed.

	 */

	if (keyType == TCL_STRING_KEYS) {

	    typePtr = &tclStringHashKeyType;

	} else if (keyType == TCL_ONE_WORD_KEYS) {

	    typePtr = &tclOneWordHashKeyType;

	} else if (keyType == TCL_CUSTOM_TYPE_KEYS) {

	    Tcl_Panic ("No type structure specified for TCL_CUSTOM_TYPE_KEYS");

	} else if (keyType == TCL_CUSTOM_PTR_KEYS) {

	    Tcl_Panic ("No type structure specified for TCL_CUSTOM_PTR_KEYS");

	} else {

	    typePtr = &tclArrayHashKeyType;

	}

    } else if (typePtr == (Tcl_HashKeyType *) -1) {

	/*

	 * If the caller has not been rebuilt then we cannot continue as

	 * the hash table is not an extended version.

	 */

	Tcl_Panic ("Hash table is not compatible");

    }

    tablePtr->typePtr = typePtr;

#endif

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_FindHashEntry --

 *

 *	Given a hash table find the entry with a matching key.

 *

 * Results:

 *	The return value is a token for the matching entry in the

 *	hash table, or NULL if there was no matching entry.

 *

 * Side effects:

 *	None.

 *

 *----------------------------------------------------------------------

 */

EXPORT_C Tcl_HashEntry *

Tcl_FindHashEntry(tablePtr, key)

    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */

    CONST char *key;		/* Key to use to find matching entry. */

{

    register Tcl_HashEntry *hPtr;

    Tcl_HashKeyType *typePtr;

    unsigned int hash;

    int index;

#if TCL_PRESERVE_BINARY_COMPATABILITY

    if (tablePtr->keyType == TCL_STRING_KEYS) {

	typePtr = &tclStringHashKeyType;

    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {

	typePtr = &tclOneWordHashKeyType;

    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS

	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {

	typePtr = tablePtr->typePtr;

    } else {

	typePtr = &tclArrayHashKeyType;

    }

#else

    typePtr = tablePtr->typePtr;

    if (typePtr == NULL) {

	Tcl_Panic("called Tcl_FindHashEntry on deleted table");

	return NULL;

    }

#endif

    if (typePtr->hashKeyProc) {

	hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);

	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {

	    index = RANDOM_INDEX (tablePtr, hash);

	} else {

	    index = hash & tablePtr->mask;

	}

    } else {

	hash = (unsigned int) key;

	index = RANDOM_INDEX (tablePtr, hash);

    }

    /*

     * Search all of the entries in the appropriate bucket.

     */

    if (typePtr->compareKeysProc) {

	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;

	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;

	        hPtr = hPtr->nextPtr) {

#if TCL_HASH_KEY_STORE_HASH

	    if (hash != (unsigned int) hPtr->hash) {

		continue;

	    }

#endif

	    if (compareKeysProc ((VOID *) key, hPtr)) {

		return hPtr;

	    }

	}

    } else {

	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;

	        hPtr = hPtr->nextPtr) {

#if TCL_HASH_KEY_STORE_HASH

	    if (hash != (unsigned int) hPtr->hash) {

		continue;

	    }

#endif

	    if (key == hPtr->key.oneWordValue) {

		return hPtr;

	    }

	}

    }

    return NULL;

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_CreateHashEntry --

 *

 *	Given a hash table with string keys, and a string key, find

 *	the entry with a matching key.  If there is no matching entry,

 *	then create a new entry that does match.

 *

 * Results:

 *	The return value is a pointer to the matching entry.  If this

 *	is a newly-created entry, then *newPtr will be set to a non-zero

 *	value;  otherwise *newPtr will be set to 0.  If this is a new

 *	entry the value stored in the entry will initially be 0.

 *

 * Side effects:

 *	A new entry may be added to the hash table.

 *

 *----------------------------------------------------------------------

 */

EXPORT_C Tcl_HashEntry *

Tcl_CreateHashEntry(tablePtr, key, newPtr)

    Tcl_HashTable *tablePtr;	/* Table in which to lookup entry. */

    CONST char *key;		/* Key to use to find or create matching

				 * entry. */

    int *newPtr;		/* Store info here telling whether a new

				 * entry was created. */

{

    register Tcl_HashEntry *hPtr;

    Tcl_HashKeyType *typePtr;

    unsigned int hash;

    int index;

#if TCL_PRESERVE_BINARY_COMPATABILITY

    if (tablePtr->keyType == TCL_STRING_KEYS) {

	typePtr = &tclStringHashKeyType;

    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {

	typePtr = &tclOneWordHashKeyType;

    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS

	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {

	typePtr = tablePtr->typePtr;

    } else {

	typePtr = &tclArrayHashKeyType;

    }

#else

    typePtr = tablePtr->typePtr;

    if (typePtr == NULL) {

	Tcl_Panic("called Tcl_CreateHashEntry on deleted table");

	return NULL;

    }

#endif

    if (typePtr->hashKeyProc) {

	hash = typePtr->hashKeyProc (tablePtr, (VOID *) key);

	if (typePtr->flags & TCL_HASH_KEY_RANDOMIZE_HASH) {

	    index = RANDOM_INDEX (tablePtr, hash);

	} else {

	    index = hash & tablePtr->mask;

	}

    } else {

	hash = (unsigned int) key;

	index = RANDOM_INDEX (tablePtr, hash);

    }

    /*

     * Search all of the entries in the appropriate bucket.

     */

    if (typePtr->compareKeysProc) {

	Tcl_CompareHashKeysProc *compareKeysProc = typePtr->compareKeysProc;

	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;

	        hPtr = hPtr->nextPtr) {

#if TCL_HASH_KEY_STORE_HASH

	    if (hash != (unsigned int) hPtr->hash) {

		continue;

	    }

#endif

	    if (compareKeysProc ((VOID *) key, hPtr)) {

		*newPtr = 0;

		return hPtr;

	    }

	}

    } else {

	for (hPtr = tablePtr->buckets[index]; hPtr != NULL;

	        hPtr = hPtr->nextPtr) {

#if TCL_HASH_KEY_STORE_HASH

	    if (hash != (unsigned int) hPtr->hash) {

		continue;

	    }

#endif

	    if (key == hPtr->key.oneWordValue) {

		*newPtr = 0;

		return hPtr;

	    }

	}

    }

    /*

     * Entry not found.  Add a new one to the bucket.

     */

    *newPtr = 1;

    if (typePtr->allocEntryProc) {

	hPtr = typePtr->allocEntryProc (tablePtr, (VOID *) key);

    } else {

	hPtr = (Tcl_HashEntry *) ckalloc((unsigned) sizeof(Tcl_HashEntry));

	hPtr->key.oneWordValue = (char *) key;

    }

    hPtr->tablePtr = tablePtr;

#if TCL_HASH_KEY_STORE_HASH

#   if TCL_PRESERVE_BINARY_COMPATABILITY

    hPtr->hash = (VOID *) hash;

#   else

    hPtr->hash = hash;

#   endif

    hPtr->nextPtr = tablePtr->buckets[index];

    tablePtr->buckets[index] = hPtr;

#else

    hPtr->bucketPtr = &(tablePtr->buckets[index]);

    hPtr->nextPtr = *hPtr->bucketPtr;

    *hPtr->bucketPtr = hPtr;

#endif

    hPtr->clientData = 0;

    tablePtr->numEntries++;

    /*

     * If the table has exceeded a decent size, rebuild it with many

     * more buckets.

     */

    if (tablePtr->numEntries >= tablePtr->rebuildSize) {

	RebuildTable(tablePtr);

    }

    return hPtr;

}

/*

 *----------------------------------------------------------------------

 *

 * Tcl_DeleteHashEntry --

 *

 *	Remove a single entry from a hash table.

 *

 * Results:

 *	None.

 *

 * Side effects:

 *	The entry given by entryPtr is deleted from its table and

 *	should never again be used by the caller.  It is up to the

 *	caller to free the clientData field of the entry, if that

 *	is relevant.

 *

 *----------------------------------------------------------------------

 */

EXPORT_C void

Tcl_DeleteHashEntry(entryPtr)

    Tcl_HashEntry *entryPtr;

{

    register Tcl_HashEntry *prevPtr;

    Tcl_HashKeyType *typePtr;

    Tcl_HashTable *tablePtr;

    Tcl_HashEntry **bucketPtr;

#if TCL_HASH_KEY_STORE_HASH

    int index;

#endif

    tablePtr = entryPtr->tablePtr;

#if TCL_PRESERVE_BINARY_COMPATABILITY

    if (tablePtr->keyType == TCL_STRING_KEYS) {

	typePtr = &tclStringHashKeyType;

    } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {

	typePtr = &tclOneWordHashKeyType;

    } else if (tablePtr->keyType == TCL_CUSTOM_TYPE_KEYS

	       || tablePtr->keyType == TCL_CUSTOM_PTR_KEYS) {

	typePtr = tablePtr->typePtr;

    } else {