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

yeti_hash.c

/*
 * yeti_hash.c --
 *
 *    Implement hash table objects in Yorick.
 *
 *-----------------------------------------------------------------------------
 *
 *    Copyright (C) 2001-2007 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.7 2007/03/23 11:53:53 eric Exp eric $
 *    $Log: yeti_hash.c,v $
 *    Revision 1.7  2007/03/23 11:53:53  eric
 *     - Hash table object can now have their own evaluator, which can be
 *       queried/set by the `h_evaluator` function.
 *     - New function `h_number` to query number of entries in a hash table.
 *     - Function `is_hash` returns 2 for a hash table object implementing
 *       its own evaluator.
 *     - h_clone, h_copy, h_info and h_show fixed to account for the
 *       evaluator of the object.
 *
 *    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"

#undef H_DEBUG

/*---------------------------------------------------------------------------*/
/* 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;

00104 struct h_table {
  int references;         /* reference counter */
  Operations *ops;        /* virtual function table */
  long        eval;       /* index to eval method (-1L if none) */
  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 */
};

00114 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) */
};

static h_uint_t h_code[256]; /* array of integer code to check consistency
                        of a symbol's name or, if YETI_HASH_RESTRICT
                        is defined, to compute a hash key */

#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. */

static void h_init(void);
/*----- Initialize internals of hash table manager. */

/*---------------------------------------------------------------------------*/
/* 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). */

static long get_method_index(Symbol *s, long defval);
/*----- Return index in globTab of contents of symbol S which must be
      a symbols'name or a function.  If S is the void symbol or a
      NULL string, DEFVAL is returned. If the symbol is invalid, -1L
      is returned. */

#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);

static long default_eval_index = -1; /* index of default eval method in globTab */

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);
  PrintFunc(" (evaluator=");
  if (obj->eval < 0L) {
    PrintFunc("(nil)");
  } else {
    PrintFunc("\"");
    PrintFunc(globalTable.names[obj->eval]);
    PrintFunc("\"");
  }
  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 *s, *owner;
  h_table_t *table;
  h_entry_t *entry = NULL;
  DataBlock *old, *db;
  OpTable *ops;
  Operations *oper;
  int i, nargs, offset;
 
  /* first get the hash table */
  owner = op->owner;
  nargs = sp - owner; /* number of arguments */
#if defined(H_DEBUG) && (H_DEBUG >= 1)
  s = owner;
  if (s->ops != &dataBlockSym) {
    fprintf(stderr, "unexpected non-DB in Eval method\n");
    while (s->ops == &referenceSym) {
      s = &globTab[owner->index];
    }
  }
  if (s->ops != &dataBlockSym || s->value.db->ops != &hashOps) {
    YError("unexpected non-hash table object (must be a BUG!)");
  }
  table = (h_table_t *)s->value.db;
#else
  table = (h_table_t *)owner->value.db;
#endif

  if (table->eval >= 0L) {
    /* this hash table implement its own eval method */
    s = &globTab[table->eval];
    while (s->ops == &referenceSym) {
      s = &globTab[s->index];
    }
    db = s->value.db; /* correctness checked below */
    if (s->ops != &dataBlockSym || ((oper = db->ops) != &functionOps &&
                            oper != &builtinOps &&
                            oper != &auto_ops)) {
      YError("non-function eval method");
    }

    /* shift stack to prepend reference to eval method */
    offset = owner - spBottom; /* stack may move */
    if (CheckStack(2)) {
      owner = spBottom + offset;
      op->owner = owner;
    }
    /*** CRITICAL CODE START ***/
    {
      volatile Symbol *stack = owner;
      ++nargs; /* one more argument: the object itself */
      i = nargs;
      stack[i].ops = &intScalar; /* set safe OpTable */
      sp = (Symbol *)stack + i; /* it is now safe to grow the stack */
      while (--i >= 0) {
      ops = stack[i].ops;
      stack[i].ops = &intScalar; /* set safe OpTable */
      stack[i + 1].value = stack[i].value;
      stack[i + 1].index = stack[i].index;
      stack[i + 1].ops = ops; /* set true OpTable *after* proper initialization */
      }
      stack->value.db = Ref(db);
      stack->ops = &dataBlockSym;
    }
    /*** CRITICAL CODE END ***/

    /* re-form operand and call Eval method */
    op->owner = owner; /* stack may have moved */
    op->references = nargs;   /* (see FormEvalOp in array.c) */
    op->ops = db->ops;
    op->value = db;
    op->ops->Eval(op);
    return;
  }

  /* got exactly one argument */
  if (nargs == 1) {
    /* 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 = (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 {
    /* NULLER_DATA_BLOCK NewRange(0L, 0L, 1L, R_NULLER); */
    owner->value.db = RefNC(&nilDB);
    ops = &dataBlockSym;
  }
  Unref(old);
  owner->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);
  if (s->ops == &dataBlockSym && s->value.db->ops == &hashOps) {
    if (((h_table_t *)s->value.db)->eval >= 0L) {
      result = 2;
    } else {
      result = 1;
    }
  } else {
    result = 0;
  }
  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_number(int nargs)
{
  Symbol *s;
  long result;

  if (nargs != 1) YError("h_number takes exactly one argument");
  s = YETI_DEREF_SYMBOL(sp);
  if (s->ops != &dataBlockSym || s->value.db->ops != &hashOps) {
    YError("inexpected non-hash table argument");
  }
  result = ((h_table_t *)s->value.db)->number;
  PushLongValue(result);
}

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
}

void Y_h_evaluator(int nargs)
{
  h_table_t *table;
  char *str;
  long new_index, old_index;
  int push_result;

  if (nargs < 1 || nargs > 2) YError("h_evaluator takes 1 or 2 arguments");
  push_result =  ! yarg_subroutine();
  table = get_hash(sp - nargs + 1);
  old_index = table->eval;

  if (nargs == 2) {
    new_index = get_method_index(sp, default_eval_index);
    if (new_index < 0L) {
      YError("evaluator must be a function or a valid symbol's name");
    }
    if (new_index == default_eval_index) {
      table->eval = -1L;
    } else {
      table->eval = new_index;
    }
  }
  if (push_result) {
    if (old_index >= 0L && old_index != default_eval_index) {
      str = globalTable.names[old_index];
    } else {
      str = (char *)0;
    }
    push_string_value(str);
  }
}

#if YETI_MUST_DEFINE_AUTOLOAD_TYPE
typedef struct autoload_t autoload_t;
struct autoload_t {
  int references;      /* reference counter */
  Operations *ops;     /* virtual function table */
  long ifile;          /* index into table of autoload files */
  long isymbol;        /* global symtab index */
  autoload_t *next;    /* linked list for each ifile */
};
#endif /* YETI_MUST_DEFINE_AUTOLOAD_TYPE */

static long get_method_index(Symbol *s, long defval)
{
  Operations *ops;
  unsigned char *str;
  int i;
  h_uint_t c;

  while (s->ops == &referenceSym) {
    s = &globTab[s->index];
  }
  if (s->ops == &dataBlockSym) {
    ops = s->value.db->ops;
    if (ops == &functionOps) {
      return ((Function *)s->value.db)->code[0].index;
    } else if (ops == &builtinOps) {
      return ((BIFunction *)s->value.db)->index;
    } else if (ops == &auto_ops) {
      return ((autoload_t *)s->value.db)->isymbol;
    } else if (ops == &stringOps) {
      if (((Array *)s->value.db)->type.dims) {
      return -1L;
      }
      str = (unsigned char *)((Array *)s->value.db)->value.q[0];
      if (! str) {
      /* nil symbol's name corresponds to default value */
      return defval;
      }
      i = 0;
      if (h_code[str[i]] <= 10U) {
      /* symbol's name must not have a zero length, nor start with
         an invalid character nor a digit */
      return -1L;
      }
      while ((c = str[++i])) {
      if (! h_code[c]) {
        /* symbol's must not contain an invalid character */
        return -1L;
      }
      }
      return Globalize((char *)str, i);
    } else if (ops == &voidOps) {
      /* void symbol corresponds to default value */
      return defval;
    }
  }
  return -1L;
}

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

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;
00937 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). */

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;
}

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

  /* Initialization of internals. */
  if (default_eval_index < 0L) {
    h_init();
    default_eval_index = Globalize("*hash_evaluator*", 0L);
  }

  /* 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->eval = -1L;
  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 */
}

/*---------------------------------------------------------------------------*
 * Local Variables:                                                          *
 * mode: C                                                                   *
 * tab-width: 8                                                              *
 * fill-column: 75                                                           *
 * coding: latin-1                                                           *
 * End:                                                                      *
 *---------------------------------------------------------------------------*/

Generated by  Doxygen 1.6.0   Back to index