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