Logo Search packages:      
Sourcecode: yorick-yeti version File versions

yeti_hash.c

/*
 * yeti_hash.c --
 *
 *    Implement hash table objects in Yorick.
 *
 *-----------------------------------------------------------------------------
 *
 *    Copyright (C) 2001-2006 Eric Thiébaut.
 *
 *    This file is part of Yeti.
 *
 *    Yeti is  free software;  you can redistribute  it and/or  modify it
 *    under  the terms of  the GNU  General Public  License version  2 as
 *    published by the Free Software Foundation.
 *
 *    Yeti is distributed in the hope that it will be useful, but WITHOUT
 *    ANY WARRANTY; without even  the implied warranty of MERCHANTABILITY
 *    or FITNESS  FOR A PARTICULAR  PURPOSE.  See the GNU  General Public
 *    License for more details.
 *
 *    You should have  received a copy of the  GNU General Public License
 *    along with  Yeti (file "COPYING"  in the top source  directory); if
 *    not, write to  the Free Software Foundation, Inc.,  51 Franklin St,
 *    Fifth Floor, Boston, MA 02110-1301 USA
 *
 *-----------------------------------------------------------------------------
 *
 * History:
 *    $Id: yeti_hash.c,v 1.6 2006/07/19 14:44:35 eric Exp $
 *    $Log: yeti_hash.c,v $
 *    Revision 1.6  2006/07/19 14:44:35  eric
 *    Copyright notice updated.
 *
 *    Revision 1.5  2005/08/31 13:51:24  eric
 *     - fixed signedness of strings to avoid compiler warnings
 *
 *    Revision 1.4  2005/08/31 08:09:07  eric
 *     - Moved code for built-in 'is_list' to 'yeti_misc.c'.
 *     - Minor changes to account for new macros YETI_PUSH_...
 *
 *    Revision 1.3  2005/05/24 13:24:29  eric
 *     - New built-in functions: h_first() and h_new() to travel
 *       a hash table.
 *
 *    Revision 1.2  2005/04/14 09:18:04  eric
 *     - Fix bugs caused by using a nil string (e.g. string(0)) as
 *       hash key and which trigger segmentation violation interrupt
 *       (SIGSEGV).
 *     - Hash table objects can now be invoked as a function with
 *       a member name (syntaxic shortcut for h_get) or with a nil
 *       argument to get the number of elements.
 *
 *    Revision 1.1  2003/04/10 23:32:03  eric
 *    Initial revision
 *
 */

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "config.h"
#include "yeti.h"
#include "yio.h"

/*---------------------------------------------------------------------------*/
/* DEFINITIONS FOR STRING HASH TABLES */

/* Define the following macro if you want to restrict key names to valid
   Yorick symbol's names, i.e. [_A-Za-z][_A-Za-z0-9]*, you will still be
   able to use reserved keywords such as "break", "if", ... thanks to key
   string notation.  Otherwise, undefine the macro and any string could be
   used as a key name. */
#undef YETI_HASH_RESTRICT

/* Define the following macro if you want to check that a hash table object
   does not contain a reference to itself (via a hash or list member).
   Unfortunately, there are many ways in Yorick to have cyclic references:
   via lists, pointers or hash tables (in Yeti).  Not all such cyclic
   references can be easily detected.  The default is therefore to not
   attempt to trap cyclic references.  This result in faster code but with
   potential memory leaks... */
#undef YETI_AVOID_CYCLIC_REFERENCES

/* Some macros to adapt implementation. */
#define h_error(MSG)     YError(MSG)
#define h_malloc(SIZE)   p_malloc(SIZE)
#define h_free(ADDR)     p_free(ADDR)

typedef unsigned int h_uint_t;
typedef struct h_table h_table_t;
typedef struct h_entry h_entry_t;

struct h_table {
  int references;         /* reference counter */
  Operations *ops;        /* virtual function table */
  h_uint_t    number;     /* number of entries */
  h_uint_t    size;       /* number of allocated slots */
  h_uint_t    mask;       /* size-1 */
  h_entry_t **slot;       /* dynamically malloc'ed slots */
};

struct h_entry {
  h_entry_t  *next;      /* next entry or NULL */
  OpTable    *sym_ops;   /* client data value = Yorick's symbol */
  SymbolValue sym_value;
  h_uint_t    key;       /* hash key */
  char        name[1];   /* entry name, actual size is large enough for
                      whole string name to fit (MUST BE LAST MEMBER) */
};

#ifdef YETI_HASH_RESTRICT
# define H_CODE(BYTE)    (h_code[BYTE])
#else
# define H_CODE(BYTE)    (BYTE)
#endif

/* Piece of code to randomize a string.  KEY, LEN, CODE and NAME must be
   variables.  KEY, LEN, CODE must be unsigned integers (h_uint_t) and NAME
   an unsigned character array. */
#define H_HASH(KEY, LEN, NAME, CODE) \
    for (KEY=LEN=0 ; (CODE=H_CODE(NAME[LEN])) ; ++LEN) KEY += (KEY<<3) + CODE

/*
 * Tests about the hashing method:
 *   ------------------ -------- ---------------------------------------------
 *   hash code           cost(*) histogram of slot occupation
 *   ------------------ -------- ---------------------------------------------
 *                   (with YETI_HASH_RESTRICT)
 *   KEY+=(KEY<<1)+CODE   1.47   [1413,497,119,15,4]
 *   KEY+=(KEY<<2)+CODE   1.46   [1413,496,117,22]
 *   KEY+=(KEY<<3)+CODE   1.37   [1383,551, 97,17]
 *   KEY =(KEY<<1)^CODE   1.69   [1412,510,107,15, 3, 0,0,0,0,0,0,0,0,0,0,1]
 *   KEY =(KEY<<2)^CODE   1.98   [1465,438,106,25,10, 3,0,0,0,0,0,0,0,0,0,0,1]
 *   KEY =(KEY<<3)^CODE   2.82   [1578,304, 95,33,17,11,4,2,1,2,0,0,0,0,0,0,1]
 *   ------------------ -------- ---------------------------------------------
 *                   (without YETI_HASH_RESTRICT)
 *   KEY+=(KEY<<1)+CODE   1.38   [1386,545,100,17]
 *   KEY+=(KEY<<2)+CODE   1.42   [1399,522,107,20]
 *   KEY+=(KEY<<3)+CODE   1.43   [1404,511,116,15, 2]
 *   KEY =(KEY<<1)^CODE   1.81   [1434,481, 99,31, 2, 0,0,0,0,0,0,0,0,0,0,0,1]
 *   KEY =(KEY<<2)^CODE   2.09   [1489,401,112,31, 9, 4,1,0,0,0,0,0,0,0,0,0,1]
 *   KEY =(KEY<<3)^CODE   2.82   [1575,310, 95,28,19,10,4,3,2,1,0,0,0,0,0,0,1]
 *   ------------------ -------- ---------------------------------------------
 *   (*) cost = mean # of tests to localize an item
 *   TCL randomize method is:     KEY += (KEY<<3) + C
 *   Yorick randomize method is:  KEY  = (KEY<<1) ^ C
 */

/* Use this macro to check if hash table ENTRY match string NAME.
   LEN is the length of NAME and KEY the hash key computed from NAME. */
#define H_MATCH(ENTRY, KEY, NAME, LEN) \
  ((ENTRY)->key == KEY && ! strncmp(NAME, (ENTRY)->name, LEN))


extern h_table_t *h_new(h_uint_t number);
/*----- Create a new empty hash table with at least NUMBER slots
      pre-allocated (rounded up to a power of 2). */

extern void h_delete(h_table_t *table);
/*----- Destroy hash table TABLE and its contents. */

extern h_entry_t *h_find(h_table_t *table, const char *name);
/*----- Returns the address of the entry in hash table TABLE that match NAME.
      If no entry is identified by NAME (or in case of error) NULL is
      returned. */

extern int h_remove(h_table_t *table, const char *name);
/*----- Remove entry identifed by NAME from hash table TABLE.  Return value
      is: 0 if no entry in TABLE match NAME, 1 if and entry matching NAME
      was found and unreferenced, -1 in case of error. */

extern int h_insert(h_table_t *table, const char *name, Symbol *sym);
/*----- Insert entry identifed by NAME with contents SYM in hash table
      TABLE.  Return value is: 0 if no former entry in TABLE matched NAME
      (hence a new entry was created); 1 if a former entry in TABLE matched
      NAME (which was properly unreferenced); -1 in case of error. */

/*---------------------------------------------------------------------------*/
/* PRIVATE ROUTINES */

extern BuiltIn Y_is_hash;
extern BuiltIn Y_h_new, Y_h_get, Y_h_set, Y_h_has, Y_h_pop, Y_h_stat;
extern BuiltIn Y_h_debug, Y_h_keys, Y_h_first, Y_h_next;

static h_table_t *get_hash(Symbol *stack);
/*----- Returns hash table stored by symbol STACK.  STACK get replaced by
      the referenced object if it is a reference symbol. */

static void set_members(h_table_t *obj, Symbol *stack, int nargs);
/*----- Parse arguments STACK[0]..STACK[NARGS-1] as key-value pairs to
      store in hash table OBJ. */

static int get_hash_and_key(int nargs, h_table_t **table,
                      const char **keystr);

static void get_member(Symbol *owner, h_table_t *table, const char *name);
/*----- Replace stack symbol OWNER by the contents of entry matching NAME
      in hash TABLE (taking care of UnRef/Ref properly). */

#ifdef YETI_AVOID_CYCLIC_REFERENCES
static void assert_no_cyclic_references(DataBlock *self, DataBlock *obj);
/*----- Call YError if OBJ contains a reference to SELF.   All hash/table
      encountered in OBJ are recursively traversed to search for SELF. */
#endif /* YETI_AVOID_CYCLIC_REFERENCES */

/*--------------------------------------------------------------------------*/
/* IMPLEMENTATION OF HASH TABLES AS OPAQUE YORICK OBJECTS */

extern PromoteOp PromXX;
extern UnaryOp ToAnyX, NegateX, ComplementX, NotX, TrueX;
extern BinaryOp AddX, SubtractX, MultiplyX, DivideX, ModuloX, PowerX;
extern BinaryOp EqualX, NotEqualX, GreaterX, GreaterEQX;
extern BinaryOp ShiftLX, ShiftRX, OrX, AndX, XorX;
extern BinaryOp AssignX, MatMultX;
extern UnaryOp EvalX, SetupX, PrintX;
static MemberOp GetMemberH;
static UnaryOp PrintH;
static void FreeH(void *addr);  /* ******* Use Unref(hash) ******* */
static void EvalH(Operand *op);

Operations hashOps = {
  &FreeH, T_OPAQUE, 0, /* promoteID = */T_STRING/* means illegal */,
  "hash_table",
  {&PromXX, &PromXX, &PromXX, &PromXX, &PromXX, &PromXX, &PromXX, &PromXX},
  &ToAnyX, &ToAnyX, &ToAnyX, &ToAnyX, &ToAnyX, &ToAnyX, &ToAnyX,
  &NegateX, &ComplementX, &NotX, &TrueX,
  &AddX, &SubtractX, &MultiplyX, &DivideX, &ModuloX, &PowerX,
  &EqualX, &NotEqualX, &GreaterX, &GreaterEQX,
  &ShiftLX, &ShiftRX, &OrX, &AndX, &XorX,
  &AssignX, &EvalH, &SetupX, &GetMemberH, &MatMultX, &PrintH
};

/* FreeH is automatically called by Yorick to delete an object instance
   that is no longer referenced. */
static void FreeH(void *addr) { h_delete((h_table_t *)addr); }

/* PrintH is used by Yorick's info command. */
static void PrintH(Operand *op)
{
  h_table_t *obj = (h_table_t *)op->value;
  char line[80];
  ForceNewline();
  PrintFunc("Object of type: ");
  PrintFunc(obj->ops->typeName);
  sprintf(line, " (references=%d, number=%u, size=%u, mask=0x%x)",
        obj->references, obj->number, obj->size, obj->mask);
  PrintFunc(line);
  ForceNewline();
}

/* GetMemberH implements the de-referencing '.' operator. */
static void GetMemberH(Operand *op, char *name)
{
  get_member(op->owner, (h_table_t *)op->value, name);
}

/* EvalH implements hash table used as a function or as an indexed array. */
static void EvalH(Operand *op)
{
  char *name;
  long index = -1L;
  Symbol *stack = op->owner;
  Symbol *sym;
  h_table_t *table;
  h_entry_t *entry = NULL;
  DataBlock *old;
  OpTable *ops;
 
  if (sp - stack == 1) {
    /* got exactly one argument */

    /* first get the hash table */
    sym = (stack->ops == &referenceSym) ? &globTab[stack->index] : stack;
    if (sym->ops != &dataBlockSym || sym->value.db->ops != &hashOps)
      YError("unexpected non-hash table object (must be a BUG!)");
    table = (h_table_t *)sym->value.db;
    
    /* parse the argument */
    if (sp->ops == &longScalar) {
      index = sp->value.l;
      goto indexed;
    } else if (sp->ops == &intScalar) {
      index = sp->value.i;
      goto indexed;
    } else if (sp->ops) {
      Operand arg;
      sp->ops->FormOperand(sp, &arg);
      if (! arg.type.dims) {
      switch (arg.ops->typeID) {
      case T_CHAR:
        index = *(unsigned char *)arg.value;
        goto indexed;
      case T_SHORT:
        index = *(short *)arg.value;
        goto indexed;
      case T_INT:
        index = *(int *)arg.value;
        goto indexed;
      case T_LONG:
        index = *(long *)arg.value;
        goto indexed;
      case T_STRING:
        name = *(char **)arg.value;
        entry = h_find(table, name);
        goto replace;
      case T_VOID:
        Drop(2);
        PushLongValue(table->number);
        return;
      }
      }
    }
  }
  YError("expecting or a single hash key name or nil");

 indexed:
  {
    h_entry_t **slot = table->slot;
    long size = table->size;
    long number = table->number;
    long i;
    if (index <= 0) index += number;
    if (index < 1 || index > number) YError("out of range hash table index");
    for (i=0 ; i<size ; ++i) {
      for (entry=slot[i] ; entry ; entry=entry->next) {
      if (--index == 0) goto replace;
      }
    }
    YError("corrupted hash table");
  }

 replace:
  Drop(1); /* discard key name or index (after using it) */
  old = (stack->ops == &dataBlockSym) ? stack->value.db : NULL;
  stack->ops = &intScalar;      /* avoid clash in case of interrupts */
  if (entry) {
    if ((ops = entry->sym_ops) == &dataBlockSym) {
      DataBlock *db = entry->sym_value.db;
      stack->value.db = Ref(db);
    } else {
      stack->value = entry->sym_value;
    }
  } else {
    /* NULLER_DATA_BLOCK NewRange(0L, 0L, 1L, R_NULLER); */
    stack->value.db = RefNC(&nilDB);
    ops = &dataBlockSym;
  }
  Unref(old);
  stack->ops = ops;           /* change ops only AFTER value updated */
}

/*---------------------------------------------------------------------------*/
/* BUILTIN ROUTINES */

static int is_nil(Symbol *s);
static void push_string_value(const char *value);

static int is_nil(Symbol *s)
{
  while (s->ops == &referenceSym) s = &globTab[s->index];
  return (s->ops == &dataBlockSym && s->value.db == &nilDB);
}

static void push_string_value(const char *value)
{
  ((Array *)PushDataBlock(NewArray(&stringStruct,  NULL)))->value.q[0] = 
    (value ? p_strcpy((char *)value) : NULL);
}

void Y_is_hash(int nargs)
{
  Symbol *s;
  int result;
  if (nargs != 1) YError("is_hash takes exactly one argument");
  s = YETI_DEREF_SYMBOL(sp);
  result = (s->ops == &dataBlockSym && s->value.db->ops == &hashOps);
  PushIntValue(result);
}

void Y_h_debug(int nargs)
{
  int i;
  for (i=1 ; i<=nargs ; ++i) yeti_debug_symbol(sp - nargs + i);
  Drop(nargs);
}

void Y_h_new(int nargs)
{
  h_table_t *obj;
  int initial_size, got_members;
  const int min_size = 16;
  Symbol *stack = sp-nargs+1; /* first argument (we know that the stack
                         will NOT be moved) */
  if (nargs == 0 || (nargs == 1 && is_nil(sp))) {
    got_members = 0;
    initial_size = 0;
  } else {
    got_members = 1;
    initial_size = nargs/2;
  }
  if (initial_size < min_size) initial_size = min_size;
  obj = h_new(initial_size);
  PushDataBlock(obj);
  if (got_members) set_members(obj, stack, nargs);
}

void Y_h_set(int nargs)
{
  h_table_t *table;
  if (nargs < 1 || nargs%2 != 1)
    YError("usage: h_set,table,\"key\",value,... -or- h_set,table,key=value,...");
  table = get_hash(sp-nargs+1);
  if (nargs > 1) {
    set_members(table, sp-nargs+2, nargs-1);
    Drop(nargs-1); /* just left the target object on top of the stack */
  }
}

void Y_h_get(int nargs)
{
  /* Get hash table object and key name, then replace first argument (the
     hash table object) by entry contents. */
  h_table_t *table;
  const char *name;
  if (get_hash_and_key(nargs, &table, &name)) {
    YError("usage: h_get(table, \"key\") -or- h_get(table, key=)");
  }
  Drop(nargs-1);               /* only left hash table on top of stack */
  get_member(sp, table, name); /* replace top of stack by entry contents */
}

void Y_h_has(int nargs)
{
  int result;
  h_table_t *table;
  const char *name;
  if (get_hash_and_key(nargs, &table, &name)) {
    YError("usage: h_has(table, \"key\") -or- h_has(table, key=)");
  }
  result = (h_find(table, name) != NULL);
  Drop(nargs);
  PushIntValue(result);
}

void Y_h_pop(int nargs)
{
  h_uint_t key, len, code, index;
  h_entry_t *entry, *prev;
  h_table_t *table;
  const char *sname;
  const unsigned char *uname;

  Symbol *stack = sp+1; /* location to put new element */
  if (get_hash_and_key(nargs, &table, &sname)) {
    YError("usage: h_pop(table, \"key\") -or- h_pop(table, key=)");
  }

  /* *** Code more or less stolen from 'h_remove' *** */

  if (sname) {
    /* Compute hash key. */
    uname = (const unsigned char *)sname;
    H_HASH(key, len, uname, code);
    
    /* Find the entry. */
    prev = NULL;
    index = key & table->mask;
    entry = table->slot[index];
    while (entry) {
      if (H_MATCH(entry, key, sname, len)) {
      /* Delete the entry: (1) remove entry from chained list of entries in
         its slot, (2) pop contents of entry, (3) free entry memory. */
      /* CRITICAL SECTION BEGIN */
      if (prev) prev->next = entry->next;
      else table->slot[index] = entry->next;
      stack->ops   = entry->sym_ops;
      stack->value = entry->sym_value;
      h_free(entry);
      --table->number;
      sp = stack; /* sp updated AFTER new stack element finalized */
      /* CRITICAL SECTION END */
      return; /* entry found and popped */
      }
      prev = entry;
      entry = entry->next;
    }
  }
  /* Not found (may be invalid hash key). */
#ifdef YETI_HASH_RESTRICT
  if (uname[len] || H_CODE(uname[0]) <= 10) {
    YError("invalid key name");
  }
#endif
  PushDataBlock(RefNC(&nilDB));
}

void Y_h_keys(int nargs)
{
  h_entry_t *entry;
  h_table_t *table;
  char **result;
  h_uint_t i, j, number;
  if (nargs != 1) YError("h_keys takes exactly one argument");
  table = get_hash(sp);
  number = table->number;
  if (number) {
    result = YETI_PUSH_NEW_Q(yeti_first_dimension(number, 1));
    j = 0;
    for (i=0 ; i<table->size ; ++i) {
      for (entry=table->slot[i] ; entry ; entry=entry->next) {
      if (j >= number) YError("corrupted hash table");
      result[j++] = p_strcpy(entry->name);
      }
    }
  } else {
    PushDataBlock(RefNC(&nilDB));
  }
}

void Y_h_first(int nargs)
{
  h_table_t *table;
  char *name;
  size_t i, n;
  h_entry_t **slot;

  if (nargs != 1) YError("h_first takes exactly one argument");
  table = get_hash(sp);
  name = NULL;
  slot = table->slot;
  n = table->size;
  for (i=0 ; i<n ; ++i) {
    if (slot[i]) {
      name = slot[i]->name;
      break;
    }
  }
  push_string_value(name);
}

void Y_h_next(int nargs)
{
  Operand arg;
  h_table_t *table;
  h_entry_t *entry, **slot;
  const unsigned char *name;
  size_t key, len, code, nslots, index;

  if (nargs != 2) YError("h_next takes exactly two argument");
  table = get_hash(sp - 1);

  /* Get scalar string argument. */
  if (! sp->ops) {
  bad_arg:
    YError("expecting a scalar string");
  }
  sp->ops->FormOperand(sp, &arg);
  if (arg.type.dims || arg.ops->typeID != T_STRING) goto bad_arg;
  name = *(unsigned char **)arg.value;
  if (! name) {
    /* Left current argument (nil) on top of stack. */
    return;
  }

  /* Compute hash key. */
  H_HASH(key, len, name, code);

  /* Locate matching entry. */
  index = (key & table->mask);
  slot = table->slot;
  entry = slot[index];
  for ( ; ; ) {
    if (! entry) YError("hash entry not found");
    if (H_MATCH(entry, key, (const char *)name, len)) break;
    entry = entry->next;
  }

  /* Get 'next' hash entry. */
  if (entry->next) {
    name = (const unsigned char *)entry->next->name;
  } else {
    nslots = table->size;
    name = (const unsigned char *)0;
    while (++index < nslots) {
      entry = slot[index];
      if (entry) {
      name = (const unsigned char *)entry->name;
      break;
      }
    }
  }
  push_string_value((const char *)name);
}

void Y_h_stat(int nargs)
{
  Array *array;
  h_entry_t *entry, **slot;
  h_table_t *table;
  long *result;
  h_uint_t i, number, max_count=0, sum_count=0;
  if (nargs != 1) YError("h_stat takes exactly one argument");
  table = get_hash(sp);
  number = table->number;
  slot = table->slot;
  array = YETI_PUSH_NEW_ARRAY_L(yeti_first_dimension(number + 1, 1));
  result = array->value.l;
  for (i=0 ; i<=number ; ++i) result[i] = 0;
  for (i=0 ; i<table->size ; ++i) {
    h_uint_t count=0;
    for (entry=slot[i] ; entry ; entry=entry->next) ++count;
    if (count <= number) ++result[count];
    if (count > max_count) max_count = count;
    sum_count += count;
  }
  if (sum_count != number) {
    table->number = sum_count;
    YError("corrupted hash table");
  }

#if 0
  /* I thought there was no hurt to pretend that an array is smaller than
     its actual size but this caused segmentation faults... */
  array->type.dims->number = max_count + 1;
#endif
}

/*---------------------------------------------------------------------------*/

static void get_member(Symbol *owner, h_table_t *table, const char *name)
{
  OpTable *ops;
  h_entry_t *entry = h_find(table, name);
  DataBlock *old = (owner->ops == &dataBlockSym) ? owner->value.db : NULL;
  owner->ops = &intScalar;     /* avoid clash in case of interrupts */
  if (entry) {
    if ((ops = entry->sym_ops) == &dataBlockSym) {
      DataBlock *db = entry->sym_value.db;
      owner->value.db = Ref(db);
    } else {
      owner->value = entry->sym_value;
    }
  } else {
    owner->value.db = RefNC(&nilDB);
    ops = &dataBlockSym;
  }
  Unref(old);
  owner->ops = ops;            /* change ops only AFTER value updated */
}

/* get args from the top of the stack: first arg is hash table, second arg
   should be key name or keyword followed by third nil arg */
static int get_hash_and_key(int nargs, h_table_t **table,
                      const char **keystr)
{
  Operand op;
  Symbol *s, *stack;

  stack = sp - nargs + 1;
  if (nargs == 2) {
    /* e.g.: foo(table, "key") */
    s = stack + 1; /* symbol for key */
    if (s->ops) {
      s->ops->FormOperand(s, &op);
      if (! op.type.dims && op.ops->typeID == T_STRING) {
      *table = get_hash(stack);
      *keystr = *(char **)op.value;
      return 0;
      }
    }
  } else if (nargs == 3) {
    /* e.g.: foo(table, key=) */
    if (! (stack + 1)->ops && is_nil(stack + 2)) {
      *table = get_hash(stack);
      *keystr = globalTable.names[(stack + 1)->index];
      return 0;
    }
  }
  return -1;
}

static h_table_t *get_hash(Symbol *stack)
{
  DataBlock *db;
  Symbol *sym = (stack->ops == &referenceSym) ? &globTab[stack->index] : stack;
  if (sym->ops != &dataBlockSym || sym->value.db->ops != &hashOps)
    YError("expected hash table object");
  db = sym->value.db;
  if (sym != stack) {
    /* Replace reference onto the stack (equivalent to the statement
       ReplaceRef(s); see ydata.c for actual code of this routine). */
    stack->value.db = Ref(db);
    stack->ops = &dataBlockSym;     /* change ops only AFTER value updated */
  }
  return (h_table_t *)db;
}

static void set_members(h_table_t *table, Symbol *stack, int nargs)
{
  Operand op;
  int i;
  const char *name;

  if (nargs%2) YError("last key has no value");
  for (i=0 ; i<nargs ; i+=2, stack+=2) {
    /* Get key name. */
    if (stack->ops) {
      stack->ops->FormOperand(stack, &op);
      if (! op.type.dims && op.ops == &stringOps) {
      name = *(char **)op.value;
      } else {
      name = NULL;
      }
    } else {
      name = globalTable.names[stack->index];
    }
    if (! name) {
      YError("bad key, expecting a non-nil scalar string name or a keyword");
    }

    /* Replace value. */
    h_insert(table, name, stack+1);
  }
}

/* Definitions stolen from 'yorick/list.c':  */
typedef struct List_Cell List_Cell;
struct List_Cell {
  int references;      /* reference counter */
  Operations *ops;     /* virtual function table */
  List_Cell *next;
  Symbol sym;
};
extern Operations listOps;

#ifdef YETI_AVOID_CYCLIC_REFERENCES
static void assert_no_cyclic_references(DataBlock *self, DataBlock *obj)
{
  if (self == obj) {
    YError("cyclic references forbidden in list/hash objects");
  } else if (obj->ops == &listOps) {
    List_Cell *list = (List_Cell *)obj;
    while (list) {
      if (list->sym.ops == &dataBlockSym)
      assert_no_cyclic_references(self, list->sym.value.db);
      list = list->next;
    }
  } else if (obj->ops == &hashOps) {
    h_table_t *table = (h_table_t *)obj;
    h_uint_t i;
    h_entry_t *entry;
    for (i=0 ; i<table->size ; ++i) {
      for (entry = table->slot[i] ; entry ; entry=entry->next) {
      if (entry->sym_ops == &dataBlockSym)
        assert_no_cyclic_references(self, entry->sym_value.db);
      }
    }
  }
}
#endif /* YETI_AVOID_CYCLIC_REFERENCES */

/*--------------------------------------------------------------------------*/
/* The following code implement management of hash tables with string keys
   and aimed at the storage of Yorick DataBlock.  The randomization
   algorithm is taken from Tcl (which is 25-30% more efficient than
   Yorick's algorithm). */

#ifdef YETI_HASH_RESTRICT
static h_uint_t h_code[256];
static int first_time = 1;

static void h_init(void);
/*----- Initialize internals of hash table manager.  Does nothing, if compiled
      with no restriction on hash key names. */

static void h_init(void)
{
  h_uint_t i, code = 0;
  for (i=0 ; i<256 ; ++i) h_code[i] = 0;
  for (i='0' ; i<='9' ; ++i) h_code[i] = ++code; /* must have lowest values */
  for (i='A' ; i<='Z' ; ++i) h_code[i] = ++code;
  h_code['_'] = ++code;
  for (i='a' ; i<='z' ; ++i) h_code[i] = ++code;
}
#endif

h_table_t *h_new(h_uint_t number)
{
  h_uint_t nbytes, size = 1;
  h_table_t *table;

#ifdef YETI_HASH_RESTRICT
  /* Initialization of internals. */
  if (first_time) {
    h_init();
    first_time = 0;
  }
#endif

  /* Member SIZE of a hash table is always a power of 2, greater or
     equal 2*NUMBER (twice the number of entries in the table). */
  while (size < number) size <<= 1;
  size <<= 1;
  nbytes = size*sizeof(h_entry_t *);
  if ((table = h_malloc(sizeof(h_table_t))) == NULL ||
      (table->slot = h_malloc(nbytes)) == NULL) {
    if (table) {
      if (table->slot) h_free(table->slot);
      h_free(table);
    }
    h_error("insufficient memory for new hash table");
    return NULL;
  }
  memset(table->slot, 0, nbytes);
  table->references = 0;
  table->ops = &hashOps;
  table->number = 0;
  table->size = size;
  table->mask = size - 1;
  return table;
}

void h_delete(h_table_t *table)
{
  if (table) {
    h_uint_t i, size = table->size;
    h_entry_t *entry, **slot = table->slot;
    for (i=0 ; i<size ; ++i) {
      entry = slot[i];
      while (entry) {
      void *addr = entry;
      if (entry->sym_ops == &dataBlockSym) {
        DataBlock *db = entry->sym_value.db;
        Unref(db);
      }
      entry = entry->next;
      h_free(addr);
      }
    }
    h_free(table);
  }
}

h_entry_t *h_find(h_table_t *table, const char *sname)
{
  const unsigned char *uname;
  h_uint_t key, len, code;
  h_entry_t *entry;

  /* Check key string and compute hash key. */
  if (! sname) return 0; /* not found */
  uname = (const unsigned char *)sname;
  H_HASH(key, len, uname, code);

  /* Locate matching entry. */
  for (entry = table->slot[key & table->mask] ; entry ; entry = entry->next) {
    if (H_MATCH(entry, key, sname, len)) return entry;
  }

  /* Not found (may be invalid hash key). */
#ifdef YETI_HASH_RESTRICT
  if (uname[len] || H_CODE(uname[0]) <= 10) {
    h_error("invalid key name");
  }
#endif
  return NULL;
}

int h_remove(h_table_t *table, const char *sname)
{
  const unsigned char *uname;
  h_uint_t key, len, code, index;
  h_entry_t *entry, *prev;

  /* Check key string and compute hash key. */
  if (! sname) return 0; /* not found */
  uname = (const unsigned char *)sname;
  H_HASH(key, len, uname, code);

  /* Find the entry. */
  prev = NULL;
  entry = table->slot[(index = key & table->mask)];
  while (entry) {
    if (H_MATCH(entry, key, sname, len)) {
      /* Delete the entry: (1) remove entry from chained list of entries in
         its slot, (2) unreference contents of entry, (3) free entry
         memory. */
      /* CRITICAL SECTION BEGIN */
      if (prev) prev->next = entry->next;
      else table->slot[index] = entry->next;
      if (entry->sym_ops == &dataBlockSym) {
      DataBlock *db = entry->sym_value.db;
      Unref(db);
      }
      h_free(entry);
      --table->number;
      /* CRITICAL SECTION END */
      return 1; /* entry found and deleted */
    }
    prev = entry;
    entry = entry->next;
  }

  /* Not found (may be invalid hash key). */
#ifdef YETI_HASH_RESTRICT
  if (uname[len] || H_CODE(uname[0]) <= 10) {
    h_error("invalid key name");
    return -1; /* error */
  }
#endif /* YETI_HASH_RESTRICT */
  return 0; /* not found */
}

int h_insert(h_table_t *table, const char *sname, Symbol *sym)
{
  const unsigned char *uname;
  h_uint_t key, len, code, index;
  h_entry_t *entry;
  DataBlock *db;

  /* Check key string. */
  if (! sname) {
    h_error("invalid nil key name");
    return -1; /* error */
  }

  /* Compute hash key and check name. */
  uname = (const unsigned char *)sname;
  H_HASH(key, len, uname, code);
#ifdef YETI_HASH_RESTRICT
  if (uname[len] || H_CODE(uname[0]) <= 10) {
    h_error("invalid key name");
    return -1; /* error */
  }
#endif /* YETI_HASH_RESTRICT */

  /* Prepare symbol for storage. */
  if (sym->ops == &referenceSym) {
    /* We do not need to call ReplaceRef because the referenced symbol will
       be properly inserted into the hash table and the stack symbol will
       be left unchanged. */
    sym = &globTab[sym->index];
  }
  if (sym->ops == &dataBlockSym && sym->value.db->ops == &lvalueOps) {
    /* Symbol is an LValue, e.g. part of an array, we fetch (make a private
       copy of) the data to release the link on the total array. */
    FetchLValue(sym->value.db, sym);
  }
#ifdef YETI_AVOID_CYCLIC_REFERENCES
  if (sym->ops == &dataBlockSym) {
    assert_no_cyclic_references((DataBlock *)table, sym->value.db);
  }
#endif /* YETI_AVOID_CYCLIC_REFERENCES */

  /* Replace contents of the entry with same key name if it already exists. */
  for (entry=table->slot[key&table->mask] ; entry ; entry = entry->next) {
    if (H_MATCH(entry, key, sname, len)) {
      /* CRITICAL SECTION BEGIN */
      db = (entry->sym_ops == &dataBlockSym) ? entry->sym_value.db : NULL;
      entry->sym_ops = &intScalar; /* avoid clash in case of interrupts */
      Unref(db);
      if (sym->ops == &dataBlockSym) {
      db = sym->value.db;
      entry->sym_value.db = Ref(db);
      } else entry->sym_value = sym->value;
      entry->sym_ops = sym->ops;   /* change ops only AFTER value updated */
      /* CRITICAL SECTION END */
      return 1; /* old entry replaced */
    }
  }

  /* Must create a new entry. */
  if (((table->number + 1)<<1) > table->size) {
    /* Must grow hash table slot array, i.e. "re-hash".  In principle,
       about half of the entries have to be moved in the upper part of the
       new slot array. It is however safer to insert every entries one by
       one in the new slot array, making sure that the new slot array is
       consistent.  Since the size of the slot array is doubled every time
       re-hash is needed, this operation is uncommon and speed performance
       is not an issue.  In case of interrupts during the re-hash
       operation, some entries may be missing (forever) in the hash table
       but, at least, there is little chance to broke hash table
       consistency. */
    h_entry_t **old = table->slot;
    h_entry_t **new;
    h_uint_t old_size = table->size;
    h_uint_t new_size = old_size<<1;
    h_uint_t mask = new_size - 1;
    unsigned int i, nbytes = new_size*sizeof(h_entry_t *);
    if ((new = h_malloc(nbytes)) == NULL) {
    not_enough_memory:
      h_error("insufficient memory to store new hash entry");
      return -1;
    }
    /* CRITICAL SECTION BEGIN */
    table->slot = memset(new, 0, nbytes); /* empty new slots */
    table->size = new_size;
    table->mask = mask;
    for (i=0 ; i<old_size ; ++i) {
      entry = old[i];
      while (entry) {
      h_entry_t *next = entry->next;
      index = entry->key & mask;
      entry->next = new[index];
      new[index] = entry;
      entry = next;
      }
    }
    h_free(old);
    /* CRITICAL SECTION END */
  }

  /* Create new entry. */
  entry = h_malloc(((unsigned int)&((h_entry_t*)0)->name) + 1 + len);
  if (entry == NULL) goto not_enough_memory;
  memcpy(entry->name, sname, len+1);
  entry->key = key;
  if (sym->ops == &dataBlockSym) {
    db = sym->value.db;
    entry->sym_value.db = Ref(db);
  } else entry->sym_value = sym->value;
  entry->sym_ops = sym->ops;

  /* Insert new entry. */
  index = key & table->mask;
  /* CRITICAL SECTION BEGIN */
  entry->next = table->slot[index];
  table->slot[index] = entry;
  ++table->number;
  /* CRITICAL SECTION BEGIN */
  return 0; /* a new entry was created */
}

/*---------------------------------------------------------------------------*/

Generated by  Doxygen 1.6.0   Back to index