Test interaction with eval STRING
[perl/modules/indirect.git] / ptable.h
1 /* This file is part of the indirect Perl module.
2  * See http://search.cpan.org/dist/indirect/ */
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 /* This header is designed to be included several times with different
10  * definitions for PTABLE_NAME and PTABLE_VAL_FREE(). */
11
12 #undef VOID2
13 #ifdef __cplusplus
14 # define VOID2(T, P) static_cast<T>(P)
15 #else
16 # define VOID2(T, P) (P)
17 #endif
18
19 #undef pPTBLMS
20 #undef pPTBLMS_
21 #undef aPTBLMS
22 #undef aPTBLMS_
23
24 /* Context for PerlMemShared_* functions */
25
26 #ifdef PERL_IMPLICIT_SYS
27 # define pPTBLMS  pTHX
28 # define pPTBLMS_ pTHX_
29 # define aPTBLMS  aTHX
30 # define aPTBLMS_ aTHX_
31 #else
32 # define pPTBLMS  void
33 # define pPTBLMS_
34 # define aPTBLMS
35 # define aPTBLMS_
36 #endif
37
38 #ifndef pPTBL
39 # define pPTBL  pPTBLMS
40 #endif
41 #ifndef pPTBL_
42 # define pPTBL_ pPTBLMS_
43 #endif
44 #ifndef aPTBL
45 # define aPTBL  aPTBLMS
46 #endif
47 #ifndef aPTBL_
48 # define aPTBL_ aPTBLMS_
49 #endif
50
51 #ifndef PTABLE_NAME
52 # define PTABLE_NAME ptable
53 #endif
54
55 #ifndef PTABLE_VAL_FREE
56 # define PTABLE_VAL_FREE(V)
57 #endif
58
59 #ifndef PTABLE_JOIN
60 # define PTABLE_PASTE(A, B) A ## B
61 # define PTABLE_JOIN(A, B)  PTABLE_PASTE(A, B)
62 #endif
63
64 #ifndef PTABLE_PREFIX
65 # define PTABLE_PREFIX(X) PTABLE_JOIN(PTABLE_NAME, X)
66 #endif
67
68 #ifndef ptable_ent
69 typedef struct ptable_ent {
70  struct ptable_ent *next;
71  const void *       key;
72  void *             val;
73 } ptable_ent;
74 #define ptable_ent ptable_ent
75 #endif /* !ptable_ent */
76
77 #ifndef ptable
78 typedef struct ptable {
79  ptable_ent **ary;
80  size_t       max;
81  size_t       items;
82 } ptable;
83 #define ptable ptable
84 #endif /* !ptable */
85
86 #ifndef ptable_new
87 STATIC ptable *ptable_new(pPTBLMS) {
88 #define ptable_new() ptable_new(aPTBLMS)
89  ptable *t = VOID2(ptable *, PerlMemShared_malloc(sizeof *t));
90  t->max    = 15;
91  t->items  = 0;
92  t->ary    = VOID2(ptable_ent **,
93                               PerlMemShared_calloc(t->max + 1, sizeof *t->ary));
94  return t;
95 }
96 #endif /* !ptable_new */
97
98 #ifndef PTABLE_HASH
99 # define PTABLE_HASH(ptr) \
100      ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))
101 #endif
102
103 #ifndef ptable_find
104 STATIC ptable_ent *ptable_find(const ptable * const t, const void * const key) {
105 #define ptable_find ptable_find
106  ptable_ent *ent;
107  const UV hash = PTABLE_HASH(key);
108
109  ent = t->ary[hash & t->max];
110  for (; ent; ent = ent->next) {
111   if (ent->key == key)
112    return ent;
113  }
114
115  return NULL;
116 }
117 #endif /* !ptable_find */
118
119 #ifndef ptable_fetch
120 STATIC void *ptable_fetch(const ptable * const t, const void * const key) {
121 #define ptable_fetch ptable_fetch
122  const ptable_ent *const ent = ptable_find(t, key);
123
124  return ent ? ent->val : NULL;
125 }
126 #endif /* !ptable_fetch */
127
128 #ifndef ptable_split
129 STATIC void ptable_split(pPTBLMS_ ptable * const t) {
130 #define ptable_split(T) ptable_split(aPTBLMS_ (T))
131  ptable_ent **ary = t->ary;
132  const size_t oldsize = t->max + 1;
133  size_t newsize = oldsize * 2;
134  size_t i;
135
136  ary = VOID2(ptable_ent **, PerlMemShared_realloc(ary, newsize * sizeof(*ary)));
137  Zero(&ary[oldsize], newsize - oldsize, sizeof(*ary));
138  t->max = --newsize;
139  t->ary = ary;
140
141  for (i = 0; i < oldsize; i++, ary++) {
142   ptable_ent **curentp, **entp, *ent;
143   if (!*ary)
144    continue;
145   curentp = ary + oldsize;
146   for (entp = ary, ent = *ary; ent; ent = *entp) {
147    if ((newsize & PTABLE_HASH(ent->key)) != i) {
148     *entp     = ent->next;
149     ent->next = *curentp;
150     *curentp  = ent;
151     continue;
152    } else
153     entp = &ent->next;
154   }
155  }
156 }
157 #endif /* !ptable_split */
158
159 STATIC void PTABLE_PREFIX(_store)(pPTBL_ ptable * const t, const void * const key, void * const val) {
160  ptable_ent *ent = ptable_find(t, key);
161
162  if (ent) {
163   void *oldval = ent->val;
164   PTABLE_VAL_FREE(oldval);
165   ent->val = val;
166  } else if (val) {
167   const size_t i = PTABLE_HASH(key) & t->max;
168   ent = VOID2(ptable_ent *, PerlMemShared_malloc(sizeof *ent));
169   ent->key  = key;
170   ent->val  = val;
171   ent->next = t->ary[i];
172   t->ary[i] = ent;
173   t->items++;
174   if (ent->next && t->items > t->max)
175    ptable_split(t);
176  }
177 }
178
179 STATIC void PTABLE_PREFIX(_delete)(pPTBL_ ptable * const t, const void * const key) {
180  ptable_ent *prev, *ent;
181  const size_t i = PTABLE_HASH(key) & t->max;
182
183  prev = NULL;
184  ent  = t->ary[i];
185  for (; ent; prev = ent, ent = ent->next) {
186   if (ent->key == key)
187    break;
188  }
189
190  if (ent) {
191   if (prev)
192    prev->next = ent->next;
193   else
194    t->ary[i]  = ent->next;
195   PTABLE_VAL_FREE(ent->val);
196   PerlMemShared_free(ent);
197  }
198 }
199
200 #ifndef ptable_walk
201 STATIC void ptable_walk(pTHX_ ptable * const t, void (*cb)(pTHX_ ptable_ent *ent, void *userdata), void *userdata) {
202 #define ptable_walk(T, CB, UD) ptable_walk(aTHX_ (T), (CB), (UD))
203  if (t && t->items) {
204   register ptable_ent ** const array = t->ary;
205   size_t i = t->max;
206   do {
207    ptable_ent *entry;
208    for (entry = array[i]; entry; entry = entry->next)
209     if (entry->val)
210      cb(aTHX_ entry, userdata);
211   } while (i--);
212  }
213 }
214 #endif /* !ptable_walk */
215
216 STATIC void PTABLE_PREFIX(_clear)(pPTBL_ ptable * const t) {
217  if (t && t->items) {
218   register ptable_ent ** const array = t->ary;
219   size_t i = t->max;
220
221   do {
222    ptable_ent *entry = array[i];
223    while (entry) {
224     ptable_ent * const oentry = entry;
225     void *val = oentry->val;
226     entry = entry->next;
227     PTABLE_VAL_FREE(val);
228     PerlMemShared_free(oentry);
229    }
230    array[i] = NULL;
231   } while (i--);
232
233   t->items = 0;
234  }
235 }
236
237 STATIC void PTABLE_PREFIX(_free)(pPTBL_ ptable * const t) {
238  if (!t)
239   return;
240  PTABLE_PREFIX(_clear)(aPTBL_ t);
241  PerlMemShared_free(t->ary);
242  PerlMemShared_free(t);
243 }
244
245 #undef pPTBL
246 #undef pPTBL_
247 #undef aPTBL
248 #undef aPTBL_
249
250 #undef PTABLE_NAME
251 #undef PTABLE_VAL_FREE