1 /* This file is part of the Lexical-Types Perl module.
2 * See http://search.cpan.org/dist/Lexical-Types/ */
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 #ifdef PERL_IMPLICIT_SYS
11 # define pPTABLE_ pTHX_
13 # define aPTABLE_ aTHX_
21 typedef struct ptable_ent {
22 struct ptable_ent *next;
27 typedef struct ptable {
33 #ifndef PTABLE_VAL_FREE
34 # define PTABLE_VAL_FREE(V)
37 STATIC ptable *ptable_new(pPTABLE) {
38 #define ptable_new() ptable_new(aPTABLE)
39 ptable *t = PerlMemShared_malloc(sizeof *t);
42 t->ary = PerlMemShared_calloc(t->max + 1, sizeof *t->ary);
46 #define PTABLE_HASH(ptr) \
47 ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))
49 STATIC ptable_ent *ptable_find(const ptable * const t, const void * const key) {
51 const UV hash = PTABLE_HASH(key);
53 ent = t->ary[hash & t->max];
54 for (; ent; ent = ent->next) {
62 STATIC void *ptable_fetch(const ptable * const t, const void * const key) {
63 const ptable_ent *const ent = ptable_find(t, key);
65 return ent ? ent->val : NULL;
68 STATIC void ptable_split(pPTABLE_ ptable * const t) {
69 #define ptable_split(T) ptable_split(aPTABLE_ (T))
70 ptable_ent **ary = t->ary;
71 const UV oldsize = t->max + 1;
72 UV newsize = oldsize * 2;
75 ary = PerlMemShared_realloc(ary, newsize * sizeof(*ary));
76 Zero(&ary[oldsize], newsize - oldsize, sizeof(*ary));
80 for (i = 0; i < oldsize; i++, ary++) {
81 ptable_ent **curentp, **entp, *ent;
84 curentp = ary + oldsize;
85 for (entp = ary, ent = *ary; ent; ent = *entp) {
86 if ((newsize & PTABLE_HASH(ent->key)) != i) {
97 STATIC void ptable_store(pPTABLE_ ptable * const t, const void * const key, void * const val) {
98 #define ptable_store(T, K, V) ptable_store(aPTABLE_ (T), (K), (V))
99 ptable_ent *ent = ptable_find(t, key);
102 void *oldval = ent->val;
103 PTABLE_VAL_FREE(oldval);
106 const UV i = PTABLE_HASH(key) & t->max;
107 ent = PerlMemShared_malloc(sizeof *ent);
110 ent->next = t->ary[i];
113 if (ent->next && t->items > t->max)
120 STATIC void ptable_clear(pPTABLE_ ptable * const t) {
121 #define ptable_clear(T) ptable_clear(aPTABLE_ (T))
123 register ptable_ent ** const array = t->ary;
127 ptable_ent *entry = array[i];
129 ptable_ent * const oentry = entry;
130 void *val = oentry->val;
132 PTABLE_VAL_FREE(val);
133 PerlMemShared_free(entry);
142 STATIC void ptable_free(pPTABLE_ ptable * const t) {
143 #define ptable_free(T) ptable_free(aPTABLE_ (T))
147 PerlMemShared_free(t->ary);
148 PerlMemShared_free(t);