ptable.h

   1 /* This file is part of the Lexical-Types Perl module.
   2  * See http://search.cpan.org/dist/Lexical-Types/ */
   3
   4 /* This is a pointer table implementation essentially copied from the ptr_table
   5  * implementation in perl's sv.c, except that it has been modified to use memory
   6  * shared across threads.
   7  * Copyright goes to the original authors, bug reports to me. */
   8
   9 #ifdef PERL_IMPLICIT_SYS
  10 # define pPTABLE  pTHX
  11 # define pPTABLE_ pTHX_
  12 # define aPTABLE  aTHX
  13 # define aPTABLE_ aTHX_
  14 #else
  15 # define pPTABLE
  16 # define pPTABLE_
  17 # define aPTABLE
  18 # define aPTABLE_
  19 #endif
  20
  21 typedef struct ptable_ent {
  22  struct ptable_ent *next;
  23  const void *       key;
  24  void *             val;
  25 } ptable_ent;
  26
  27 typedef struct ptable {
  28  ptable_ent **ary;
  29  UV           max;
  30  UV           items;
  31 } ptable;
  32
  33 #ifndef PTABLE_VAL_FREE
  34 # define PTABLE_VAL_FREE(V)
  35 #endif
  36
  37 STATIC ptable *ptable_new(pPTABLE) {
  38 #define ptable_new() ptable_new(aPTABLE)
  39  ptable *t = PerlMemShared_malloc(sizeof *t);
  40  t->max   = 127;
  41  t->items = 0;
  42  t->ary   = PerlMemShared_calloc(t->max + 1, sizeof *t->ary);
  43  return t;
  44 }
  45
  46 #define PTABLE_HASH(ptr) \
  47   ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))
  48
  49 STATIC ptable_ent *ptable_find(const ptable * const t, const void * const key) {
  50  ptable_ent *ent;
  51  const UV hash = PTABLE_HASH(key);
  52
  53  ent = t->ary[hash & t->max];
  54  for (; ent; ent = ent->next) {
  55   if (ent->key == key)
  56    return ent;
  57  }
  58
  59  return NULL;
  60 }
  61
  62 STATIC void *ptable_fetch(const ptable * const t, const void * const key) {
  63  const ptable_ent *const ent = ptable_find(t, key);
  64
  65  return ent ? ent->val : NULL;
  66 }
  67
  68 STATIC void ptable_split(pPTABLE_ ptable * const t) {
  69 #define ptable_split(T) ptable_split(aPTABLE_ (T))
  70  ptable_ent **ary = t->ary;
  71  const UV oldsize = t->max + 1;
  72  UV newsize = oldsize * 2;
  73  UV i;
  74
  75  ary = PerlMemShared_realloc(ary, newsize * sizeof(*ary));
  76  Zero(&ary[oldsize], newsize - oldsize, sizeof(*ary));
  77  t->max = --newsize;
  78  t->ary = ary;
  79
  80  for (i = 0; i < oldsize; i++, ary++) {
  81   ptable_ent **curentp, **entp, *ent;
  82   if (!*ary)
  83    continue;
  84   curentp = ary + oldsize;
  85   for (entp = ary, ent = *ary; ent; ent = *entp) {
  86    if ((newsize & PTABLE_HASH(ent->key)) != i) {
  87     *entp     = ent->next;
  88     ent->next = *curentp;
  89     *curentp  = ent;
  90     continue;
  91    } else
  92     entp = &ent->next;
  93   }
  94  }
  95 }
  96
  97 STATIC void ptable_store(pPTABLE_ ptable * const t, const void * const key, void * const val) {
  98 #define ptable_store(T, K, V) ptable_store(aPTABLE_ (T), (K), (V))
  99  ptable_ent *ent = ptable_find(t, key);
 100
 101  if (ent) {
 102   void *oldval = ent->val;
 103   PTABLE_VAL_FREE(oldval);
 104   ent->val = val;
 105  } else {
 106   const UV i = PTABLE_HASH(key) & t->max;
 107   ent = PerlMemShared_malloc(sizeof *ent);
 108   ent->key  = key;
 109   ent->val  = val;
 110   ent->next = t->ary[i];
 111   t->ary[i] = ent;
 112   t->items++;
 113   if (ent->next && t->items > t->max)
 114    ptable_split(t);
 115  }
 116 }
 117
 118 #if 0
 119
 120 STATIC void ptable_clear(pPTABLE_ ptable * const t) {
 121 #define ptable_clear(T) ptable_clear(aPTABLE_ (T))
 122  if (t && t->items) {
 123   register ptable_ent ** const array = t->ary;
 124   UV i = t->max;
 125
 126   do {
 127    ptable_ent *entry = array[i];
 128    while (entry) {
 129     ptable_ent * const oentry = entry;
 130     void *val = oentry->val;
 131     entry = entry->next;
 132     PTABLE_VAL_FREE(val);
 133     PerlMemShared_free(entry);
 134    }
 135    array[i] = NULL;
 136   } while (i--);
 137
 138   t->items = 0;
 139  }
 140 }
 141
 142 STATIC void ptable_free(pPTABLE_ ptable * const t) {
 143 #define ptable_free(T) ptable_free(aPTABLE_ (T))
 144  if (!t)
 145   return;
 146  ptable_clear(t);
 147  PerlMemShared_free(t->ary);
 148  PerlMemShared_free(t);
 149 }
 150
 151 #endif