1 /* This file is part of the Variable::Magic Perl module.
2 * See http://search.cpan.org/dist/Variable-Magic/ */
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. */
9 /* This header is designed to be included several times with different
10 * definitions for PTABLE_NAME and PTABLE_VAL_FREE(). */
17 /* Context for PerlMemShared_* functions */
19 #ifdef PERL_IMPLICIT_SYS
21 # define pPTBLMS_ pTHX_
23 # define aPTBLMS_ aTHX_
32 # define pPTBL pPTBLMS
35 # define pPTBL_ pPTBLMS_
38 # define aPTBL aPTBLMS
41 # define aPTBL_ aPTBLMS_
45 # define PTABLE_NAME ptable
48 #ifndef PTABLE_VAL_FREE
49 # define PTABLE_VAL_FREE(V)
53 # define PTABLE_PASTE(A, B) A ## B
54 # define PTABLE_JOIN(A, B) PTABLE_PASTE(A, B)
58 # define PTABLE_PREFIX(X) PTABLE_JOIN(PTABLE_NAME, X)
62 typedef struct ptable_ent {
63 struct ptable_ent *next;
67 #define ptable_ent ptable_ent
68 #endif /* !ptable_ent */
71 typedef struct ptable {
80 STATIC ptable *ptable_new(pPTBLMS) {
81 #define ptable_new() ptable_new(aPTBLMS)
82 ptable *t = PerlMemShared_malloc(sizeof *t);
85 t->ary = PerlMemShared_calloc(t->max + 1, sizeof *t->ary);
88 #endif /* !ptable_new */
91 # define PTABLE_HASH(ptr) \
92 ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))
96 STATIC ptable_ent *ptable_find(const ptable * const t, const void * const key) {
97 #define ptable_find ptable_find
99 const UV hash = PTABLE_HASH(key);
101 ent = t->ary[hash & t->max];
102 for (; ent; ent = ent->next) {
109 #endif /* !ptable_find */
112 STATIC 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);
116 return ent ? ent->val : NULL;
118 #endif /* !ptable_fetch */
121 STATIC void ptable_split(pPTBLMS_ ptable * const t) {
122 #define ptable_split(T) ptable_split(aPTBLMS_ (T))
123 ptable_ent **ary = t->ary;
124 const UV oldsize = t->max + 1;
125 UV newsize = oldsize * 2;
128 ary = PerlMemShared_realloc(ary, newsize * sizeof(*ary));
129 Zero(&ary[oldsize], newsize - oldsize, sizeof(*ary));
133 for (i = 0; i < oldsize; i++, ary++) {
134 ptable_ent **curentp, **entp, *ent;
137 curentp = ary + oldsize;
138 for (entp = ary, ent = *ary; ent; ent = *entp) {
139 if ((newsize & PTABLE_HASH(ent->key)) != i) {
141 ent->next = *curentp;
149 #endif /* !ptable_split */
151 STATIC void PTABLE_PREFIX(_store)(pPTBL_ ptable * const t, const void * const key, void * const val) {
152 ptable_ent *ent = ptable_find(t, key);
155 void *oldval = ent->val;
156 PTABLE_VAL_FREE(oldval);
159 const UV i = PTABLE_HASH(key) & t->max;
160 ent = PerlMemShared_malloc(sizeof *ent);
163 ent->next = t->ary[i];
166 if (ent->next && t->items > t->max)
172 STATIC 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))
175 register ptable_ent ** const array = t->ary;
179 for (entry = array[i]; entry; entry = entry->next)
180 cb(aTHX_ entry, userdata);
184 #endif /* !ptable_walk */
186 STATIC void PTABLE_PREFIX(_clear)(pPTBL_ ptable * const t) {
188 register ptable_ent ** const array = t->ary;
192 ptable_ent *entry = array[i];
194 ptable_ent * const oentry = entry;
195 void *val = oentry->val;
197 PTABLE_VAL_FREE(val);
198 PerlMemShared_free(oentry);
207 STATIC void PTABLE_PREFIX(_free)(pPTBL_ ptable * const t) {
210 PTABLE_PREFIX(_clear)(aPTBL_ t);
211 PerlMemShared_free(t->ary);
212 PerlMemShared_free(t);
221 #undef PTABLE_VAL_FREE