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