This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Test $x=wait under arybase
[perl5.git] / ext / arybase / ptable.h
1 /* This is a pointer table implementation essentially copied from the ptr_table
2  * implementation in perl's sv.c, except that it has been modified to use memory
3  * shared across threads. */
4
5 /* This header is designed to be included several times with different
6  * definitions for PTABLE_NAME and PTABLE_VAL_FREE(). */
7
8 #undef pPTBLMS
9 #undef pPTBLMS_
10 #undef aPTBLMS
11 #undef aPTBLMS_
12
13 /* Context for PerlMemShared_* functions */
14
15 #ifdef PERL_IMPLICIT_SYS
16 # define pPTBLMS  pTHX
17 # define pPTBLMS_ pTHX_
18 # define aPTBLMS  aTHX
19 # define aPTBLMS_ aTHX_
20 #else
21 # define pPTBLMS
22 # define pPTBLMS_
23 # define aPTBLMS
24 # define aPTBLMS_
25 #endif
26
27 #ifndef pPTBL
28 # define pPTBL  pPTBLMS
29 #endif
30 #ifndef pPTBL_
31 # define pPTBL_ pPTBLMS_
32 #endif
33 #ifndef aPTBL
34 # define aPTBL  aPTBLMS
35 #endif
36 #ifndef aPTBL_
37 # define aPTBL_ aPTBLMS_
38 #endif
39
40 #ifndef PTABLE_NAME
41 # define PTABLE_NAME ptable
42 #endif
43
44 #ifndef PTABLE_VAL_FREE
45 # define PTABLE_VAL_FREE(V)
46 #endif
47
48 #ifndef PTABLE_JOIN
49 # define PTABLE_PASTE(A, B) A ## B
50 # define PTABLE_JOIN(A, B)  PTABLE_PASTE(A, B)
51 #endif
52
53 #ifndef PTABLE_PREFIX
54 # define PTABLE_PREFIX(X) PTABLE_JOIN(PTABLE_NAME, X)
55 #endif
56
57 #ifndef ptable_ent
58 typedef struct ptable_ent {
59  struct ptable_ent *next;
60  const void *       key;
61  void *             val;
62 } ptable_ent;
63 #define ptable_ent ptable_ent
64 #endif /* !ptable_ent */
65
66 #ifndef ptable
67 typedef struct ptable {
68  ptable_ent **ary;
69  UV           max;
70  UV           items;
71 } ptable;
72 #define ptable ptable
73 #endif /* !ptable */
74
75 #ifndef ptable_new
76 STATIC ptable *ptable_new(pPTBLMS) {
77 #define ptable_new() ptable_new(aPTBLMS)
78   ptable *t = (ptable *)PerlMemShared_malloc(sizeof *t);
79  t->max   = 63;
80  t->items = 0;
81  t->ary   = (ptable_ent **)PerlMemShared_calloc(t->max + 1, sizeof *t->ary);
82  return t;
83 }
84 #endif /* !ptable_new */
85
86 #ifndef PTABLE_HASH
87 # define PTABLE_HASH(ptr) \
88      ((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))
89 #endif
90
91 #ifndef ptable_find
92 STATIC ptable_ent *ptable_find(const ptable * const t, const void * const key) {
93 #define ptable_find ptable_find
94  ptable_ent *ent;
95  const UV hash = PTABLE_HASH(key);
96
97  ent = t->ary[hash & t->max];
98  for (; ent; ent = ent->next) {
99   if (ent->key == key)
100    return ent;
101  }
102
103  return NULL;
104 }
105 #endif /* !ptable_find */
106
107 #ifndef ptable_fetch
108 STATIC void *ptable_fetch(const ptable * const t, const void * const key) {
109 #define ptable_fetch ptable_fetch
110  const ptable_ent *const ent = ptable_find(t, key);
111
112  return ent ? ent->val : NULL;
113 }
114 #endif /* !ptable_fetch */
115
116 #ifndef ptable_split
117 STATIC void ptable_split(pPTBLMS_ ptable * const t) {
118 #define ptable_split(T) ptable_split(aPTBLMS_ (T))
119  ptable_ent **ary = t->ary;
120  const UV oldsize = t->max + 1;
121  UV newsize = oldsize * 2;
122  UV i;
123
124  ary = (ptable_ent **)PerlMemShared_realloc(ary, newsize * sizeof(*ary));
125  Zero(&ary[oldsize], newsize - oldsize, sizeof(*ary));
126  t->max = --newsize;
127  t->ary = ary;
128
129  for (i = 0; i < oldsize; i++, ary++) {
130   ptable_ent **curentp, **entp, *ent;
131   if (!*ary)
132    continue;
133   curentp = ary + oldsize;
134   for (entp = ary, ent = *ary; ent; ent = *entp) {
135    if ((newsize & PTABLE_HASH(ent->key)) != i) {
136     *entp     = ent->next;
137     ent->next = *curentp;
138     *curentp  = ent;
139     continue;
140    } else
141     entp = &ent->next;
142   }
143  }
144 }
145 #endif /* !ptable_split */
146
147 STATIC void PTABLE_PREFIX(_store)(pPTBL_ ptable * const t, const void * const key, void * const val) {
148  ptable_ent *ent = ptable_find(t, key);
149
150  if (ent) {
151   void *oldval = ent->val;
152   PTABLE_VAL_FREE(oldval);
153   ent->val = val;
154  } else if (val) {
155   const UV i = PTABLE_HASH(key) & t->max;
156   ent = (ptable_ent *)PerlMemShared_malloc(sizeof *ent);
157   ent->key  = key;
158   ent->val  = val;
159   ent->next = t->ary[i];
160   t->ary[i] = ent;
161   t->items++;
162   if (ent->next && t->items > t->max)
163    ptable_split(t);
164  }
165 }
166
167 #ifndef ptable_walk
168 STATIC void ptable_walk(pTHX_ ptable * const t, void (*cb)(pTHX_ ptable_ent *ent, void *userdata), void *userdata) {
169 #define ptable_walk(T, CB, UD) ptable_walk(aTHX_ (T), (CB), (UD))
170  if (t && t->items) {
171   register ptable_ent ** const array = t->ary;
172   UV i = t->max;
173   do {
174    ptable_ent *entry;
175    for (entry = array[i]; entry; entry = entry->next)
176     cb(aTHX_ entry, userdata);
177   } while (i--);
178  }
179 }
180 #endif /* !ptable_walk */
181
182 STATIC void PTABLE_PREFIX(_clear)(pPTBL_ ptable * const t) {
183  if (t && t->items) {
184   register ptable_ent ** const array = t->ary;
185   UV i = t->max;
186
187   do {
188    ptable_ent *entry = array[i];
189    while (entry) {
190     ptable_ent * const oentry = entry;
191     void *val = oentry->val;
192     entry = entry->next;
193     PTABLE_VAL_FREE(val);
194     PerlMemShared_free(oentry);
195    }
196    array[i] = NULL;
197   } while (i--);
198
199   t->items = 0;
200  }
201 }
202
203 STATIC void PTABLE_PREFIX(_free)(pPTBL_ ptable * const t) {
204  if (!t)
205   return;
206  PTABLE_PREFIX(_clear)(aPTBL_ t);
207  PerlMemShared_free(t->ary);
208  PerlMemShared_free(t);
209 }
210
211 #undef pPTBL
212 #undef pPTBL_
213 #undef aPTBL
214 #undef aPTBL_
215
216 #undef PTABLE_NAME
217 #undef PTABLE_VAL_FREE