1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
|
/*
ptr_table.h - ptr_table compatible functions for older perls
This file is originated from sv.c of 5.10.0.
*/
/*
* LISENCE AND COPYRIGHT in sv.c:
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
* 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
*/
#ifdef TESTING_PTR_TABLE_COMPAT
#undef ptr_table_new
#undef ptr_table_find
#undef ptr_table_fetch
#undef ptr_table_store
#undef ptr_table_split
#undef ptr_table_clear
#undef ptr_table_free
#endif
#ifndef ptr_table_new
/*
PTR_TBL_t and PTR_TBL_ENT_t are defined in perl.h
*/
#define PTE_SVSLOT
#define new_body_inline(pte, type) Newx(pte, 1, PTR_TBL_ENT_t)
#define del_pte(pte) Safefree(pte)
#define ptr_table_new() my_ptr_table_new(aTHX)
#define ptr_table_find(tbl, sv) my_ptr_table_find(aTHX_ tbl, sv)
#define ptr_table_fetch(tbl, key) my_ptr_table_fetch(aTHX_ tbl, key)
#define ptr_table_store(tbl, key, val) my_ptr_table_store(aTHX_ tbl, key, val)
#define ptr_table_split(tbl) my_ptr_table_split(aTHX_ tbl)
#define ptr_table_clear(tbl) my_ptr_table_clear(aTHX_ tbl)
#define ptr_table_free(tbl) my_ptr_table_free(aTHX_ tbl)
#define PTR_TABLE_HASH(ptr) \
((PTR2UV(ptr) >> 3) ^ (PTR2UV(ptr) >> (3 + 7)) ^ (PTR2UV(ptr) >> (3 + 17)))
static PTR_TBL_t *
my_ptr_table_new(pTHX)
{
PTR_TBL_t *tbl;
PERL_UNUSED_CONTEXT;
Newxz(tbl, 1, PTR_TBL_t);
tbl->tbl_max = 511;
tbl->tbl_items = 0;
Newxz(tbl->tbl_ary, tbl->tbl_max + 1, PTR_TBL_ENT_t*);
return tbl;
}
static void
my_ptr_table_split(pTHX_ PTR_TBL_t * const tbl)
{
PTR_TBL_ENT_t **ary = tbl->tbl_ary;
const UV oldsize = tbl->tbl_max + 1;
UV newsize = oldsize * 2;
UV i;
PERL_UNUSED_CONTEXT;
Renew(ary, newsize, PTR_TBL_ENT_t*);
Zero(&ary[oldsize], newsize-oldsize, PTR_TBL_ENT_t*);
tbl->tbl_max = --newsize;
tbl->tbl_ary = ary;
for (i=0; i < oldsize; i++, ary++) {
PTR_TBL_ENT_t **curentp, **entp, *ent;
if (!*ary)
continue;
curentp = ary + oldsize;
for (entp = ary, ent = *ary; ent; ent = *entp) {
if ((newsize & PTR_TABLE_HASH(ent->oldval)) != i) {
*entp = ent->next;
ent->next = *curentp;
*curentp = ent;
continue;
}
else
entp = &ent->next;
}
}
}
static PTR_TBL_ENT_t *
my_ptr_table_find(pTHX_ PTR_TBL_t const * const tbl, const void * const sv) {
PTR_TBL_ENT_t *tblent;
PERL_UNUSED_CONTEXT;
assert(tbl);
tblent = tbl->tbl_ary[PTR_TABLE_HASH(sv) & tbl->tbl_max];
for (; tblent; tblent = tblent->next) {
if (tblent->oldval == sv)
return tblent;
}
return NULL;
}
static void *
my_ptr_table_fetch(pTHX_ const PTR_TBL_t * const tbl, const void * const sv)
{
PTR_TBL_ENT_t const *const tblent = ptr_table_find(tbl, sv);
PERL_UNUSED_CONTEXT;
return tblent ? tblent->newval : NULL;
}
static void
my_ptr_table_store(pTHX_ PTR_TBL_t * const tbl, const void * const oldsv, void * const newsv)
{
PTR_TBL_ENT_t *tblent = ptr_table_find(tbl, oldsv);
if (tblent) {
tblent->newval = newsv;
} else {
const UV entry = PTR_TABLE_HASH(oldsv) & tbl->tbl_max;
new_body_inline(tblent, PTE_SVSLOT);
tblent->oldval = oldsv;
tblent->newval = newsv;
tblent->next = tbl->tbl_ary[entry];
tbl->tbl_ary[entry] = tblent;
tbl->tbl_items++;
if (tblent->next && tbl->tbl_items > tbl->tbl_max)
ptr_table_split(tbl);
}
}
static void
my_ptr_table_clear(pTHX_ PTR_TBL_t * const tbl)
{
assert(tbl);
if (tbl->tbl_items) {
PTR_TBL_ENT_t * const * const array = tbl->tbl_ary;
UV riter = tbl->tbl_max;
do {
PTR_TBL_ENT_t *entry = array[riter];
while (entry) {
PTR_TBL_ENT_t * const oentry = entry;
entry = entry->next;
del_pte(oentry);
}
} while (riter--);
tbl->tbl_items = 0;
}
}
static void
my_ptr_table_free(pTHX_ PTR_TBL_t * const tbl)
{
assert(tbl);
ptr_table_clear(tbl);
Safefree(tbl->tbl_ary);
Safefree(tbl);
}
#endif /* !ptr_table_new */
|
