X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FLexical-Types.git;a=blobdiff_plain;f=ptable.h;h=72a98bd07888e47425d18e8d22fe173ed75ef17f;hp=5cd5a90f374e3b43c389e14abe5ef2b4df950862;hb=c530c61ff04bdbd8bc101a3e88273fc4219d963e;hpb=99eb2ccae4e9aee5fa8996755211028b9934722b

diff --git a/ptable.h b/ptable.h
index 5cd5a90..72a98bd 100644
--- a/ptable.h
+++ b/ptable.h
@@ -1,4 +1,4 @@
-/* This file is part of the Lexical-Types Perl module.
+/* This file is part of the Lexical::Types Perl module.
  * See http://search.cpan.org/dist/Lexical-Types/ */
 
 /* This is a pointer table implementation essentially copied from the ptr_table
@@ -6,34 +6,95 @@
  * shared across threads.
  * Copyright goes to the original authors, bug reports to me. */
 
+/* This header is designed to be included several times with different
+ * definitions for PTABLE_NAME and PTABLE_VAL_FREE(). */
+
+#undef pPTBLMS
+#undef pPTBLMS_
+#undef aPTBLMS
+#undef aPTBLMS_
+
+/* Context for PerlMemShared_* functions */
+
+#ifdef PERL_IMPLICIT_SYS
+# define pPTBLMS  pTHX
+# define pPTBLMS_ pTHX_
+# define aPTBLMS  aTHX
+# define aPTBLMS_ aTHX_
+#else
+# define pPTBLMS
+# define pPTBLMS_
+# define aPTBLMS
+# define aPTBLMS_
+#endif
+
+#ifndef pPTBL
+# define pPTBL  pPTBLMS
+#endif
+#ifndef pPTBL_
+# define pPTBL_ pPTBLMS_
+#endif
+#ifndef aPTBL
+# define aPTBL  aPTBLMS
+#endif
+#ifndef aPTBL_
+# define aPTBL_ aPTBLMS_
+#endif
+
+#ifndef PTABLE_NAME
+# define PTABLE_NAME ptable
+#endif
+
+#ifndef PTABLE_VAL_FREE
+# define PTABLE_VAL_FREE(V)
+#endif
+
+#ifndef PTABLE_JOIN
+# define PTABLE_PASTE(A, B) A ## B
+# define PTABLE_JOIN(A, B)  PTABLE_PASTE(A, B)
+#endif
+
+#ifndef PTABLE_PREFIX
+# define PTABLE_PREFIX(X) PTABLE_JOIN(PTABLE_NAME, X)
+#endif
+
+#ifndef ptable_ent
 typedef struct ptable_ent {
  struct ptable_ent *next;
  const void *       key;
  void *             val;
 } ptable_ent;
+#define ptable_ent ptable_ent
+#endif /* !ptable_ent */
 
+#ifndef ptable
 typedef struct ptable {
  ptable_ent **ary;
- UV           max;
- UV           items;
+ size_t       max;
+ size_t       items;
 } ptable;
+#define ptable ptable
+#endif /* !ptable */
 
-#ifndef PTABLE_VAL_FREE
-# define PTABLE_VAL_FREE(V)
-#endif
-
-STATIC ptable *ptable_new(void) {
+#ifndef ptable_new
+STATIC ptable *ptable_new(pPTBLMS) {
+#define ptable_new() ptable_new(aPTBLMS)
  ptable *t = PerlMemShared_malloc(sizeof *t);
- t->max   = 127;
+ t->max   = 15;
  t->items = 0;
  t->ary   = PerlMemShared_calloc(t->max + 1, sizeof *t->ary);
  return t;
 }
+#endif /* !ptable_new */
 
-#define PTABLE_HASH(ptr) \
-  ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))
+#ifndef PTABLE_HASH
+# define PTABLE_HASH(ptr) \
+     ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))
+#endif
 
+#ifndef ptable_find
 STATIC ptable_ent *ptable_find(const ptable * const t, const void * const key) {
+#define ptable_find ptable_find
  ptable_ent *ent;
  const UV hash = PTABLE_HASH(key);
 
@@ -45,18 +106,24 @@ STATIC ptable_ent *ptable_find(const ptable * const t, const void * const key) {
 
  return NULL;
 }
+#endif /* !ptable_find */
 
+#ifndef ptable_fetch
 STATIC void *ptable_fetch(const ptable * const t, const void * const key) {
+#define ptable_fetch ptable_fetch
  const ptable_ent *const ent = ptable_find(t, key);
 
  return ent ? ent->val : NULL;
 }
+#endif /* !ptable_fetch */
 
-STATIC void ptable_split(ptable * const t) {
+#ifndef ptable_split
+STATIC void ptable_split(pPTBLMS_ ptable * const t) {
+#define ptable_split(T) ptable_split(aPTBLMS_ (T))
  ptable_ent **ary = t->ary;
- const UV oldsize = t->max + 1;
- UV newsize = oldsize * 2;
- UV i;
+ const size_t oldsize = t->max + 1;
+ size_t newsize = oldsize * 2;
+ size_t i;
 
  ary = PerlMemShared_realloc(ary, newsize * sizeof(*ary));
  Zero(&ary[oldsize], newsize - oldsize, sizeof(*ary));
@@ -79,16 +146,17 @@ STATIC void ptable_split(ptable * const t) {
   }
  }
 }
+#endif /* !ptable_split */
 
-STATIC void ptable_store(ptable * const t, const void * const key, void * const val) {
+STATIC void PTABLE_PREFIX(_store)(pPTBL_ ptable * const t, const void * const key, void * const val) {
  ptable_ent *ent = ptable_find(t, key);
 
  if (ent) {
   void *oldval = ent->val;
   PTABLE_VAL_FREE(oldval);
   ent->val = val;
- } else {
-  const UV i = PTABLE_HASH(key) & t->max;
+ } else if (val) {
+  const size_t i = PTABLE_HASH(key) & t->max;
   ent = PerlMemShared_malloc(sizeof *ent);
   ent->key  = key;
   ent->val  = val;
@@ -100,12 +168,25 @@ STATIC void ptable_store(ptable * const t, const void * const key, void * const
  }
 }
 
-#if 0
+#ifndef ptable_walk
+STATIC void ptable_walk(pTHX_ ptable * const t, void (*cb)(pTHX_ ptable_ent *ent, void *userdata), void *userdata) {
+#define ptable_walk(T, CB, UD) ptable_walk(aTHX_ (T), (CB), (UD))
+ if (t && t->items) {
+  register ptable_ent ** const array = t->ary;
+  size_t i = t->max;
+  do {
+   ptable_ent *entry;
+   for (entry = array[i]; entry; entry = entry->next)
+    cb(aTHX_ entry, userdata);
+  } while (i--);
+ }
+}
+#endif /* !ptable_walk */
 
-STATIC void ptable_clear(ptable * const t) {
+STATIC void PTABLE_PREFIX(_clear)(pPTBL_ ptable * const t) {
  if (t && t->items) {
   register ptable_ent ** const array = t->ary;
-  UV i = t->max;
+  size_t i = t->max;
 
   do {
    ptable_ent *entry = array[i];
@@ -114,7 +195,7 @@ STATIC void ptable_clear(ptable * const t) {
     void *val = oentry->val;
     entry = entry->next;
     PTABLE_VAL_FREE(val);
-    PerlMemShared_free(entry);
+    PerlMemShared_free(oentry);
    }
    array[i] = NULL;
   } while (i--);
@@ -123,12 +204,18 @@ STATIC void ptable_clear(ptable * const t) {
  }
 }
 
-STATIC void ptable_free(ptable * const t) {
+STATIC void PTABLE_PREFIX(_free)(pPTBL_ ptable * const t) {
  if (!t)
   return;
- ptable_clear(t);
+ PTABLE_PREFIX(_clear)(aPTBL_ t);
  PerlMemShared_free(t->ary);
  PerlMemShared_free(t);
 }
 
-#endif
+#undef pPTBL
+#undef pPTBL_
+#undef aPTBL
+#undef aPTBL_
+
+#undef PTABLE_NAME
+#undef PTABLE_VAL_FREE