Commit | Line | Data |
---|---|---|
a0d0e21e | 1 | /* hv.c |
79072805 | 2 | * |
a0d0e21e | 3 | * Copyright (c) 1991-1994, Larry Wall |
79072805 LW |
4 | * |
5 | * You may distribute under the terms of either the GNU General Public | |
6 | * License or the Artistic License, as specified in the README file. | |
7 | * | |
a0d0e21e LW |
8 | */ |
9 | ||
10 | /* | |
11 | * "I sit beside the fire and think of all that I have seen." --Bilbo | |
79072805 LW |
12 | */ |
13 | ||
14 | #include "EXTERN.h" | |
15 | #include "perl.h" | |
16 | ||
a0d0e21e LW |
17 | static void hsplit _((HV *hv)); |
18 | static void hfreeentries _((HV *hv)); | |
79072805 | 19 | |
4633a7c4 LW |
20 | static HE* more_he(); |
21 | ||
22 | static HE* | |
23 | new_he() | |
24 | { | |
25 | HE* he; | |
26 | if (he_root) { | |
27 | he = he_root; | |
fde52b5c | 28 | he_root = HeNEXT(he); |
4633a7c4 LW |
29 | return he; |
30 | } | |
31 | return more_he(); | |
32 | } | |
33 | ||
34 | static void | |
35 | del_he(p) | |
36 | HE* p; | |
37 | { | |
fde52b5c | 38 | HeNEXT(p) = (HE*)he_root; |
4633a7c4 LW |
39 | he_root = p; |
40 | } | |
41 | ||
42 | static HE* | |
43 | more_he() | |
44 | { | |
45 | register HE* he; | |
46 | register HE* heend; | |
47 | he_root = (HE*)safemalloc(1008); | |
48 | he = he_root; | |
49 | heend = &he[1008 / sizeof(HE) - 1]; | |
50 | while (he < heend) { | |
fde52b5c | 51 | HeNEXT(he) = (HE*)(he + 1); |
4633a7c4 LW |
52 | he++; |
53 | } | |
fde52b5c | 54 | HeNEXT(he) = 0; |
4633a7c4 LW |
55 | return new_he(); |
56 | } | |
57 | ||
fde52b5c | 58 | /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot |
59 | * contains an SV* */ | |
60 | ||
79072805 LW |
61 | SV** |
62 | hv_fetch(hv,key,klen,lval) | |
63 | HV *hv; | |
64 | char *key; | |
65 | U32 klen; | |
66 | I32 lval; | |
67 | { | |
68 | register XPVHV* xhv; | |
fde52b5c | 69 | register U32 hash; |
79072805 | 70 | register HE *entry; |
79072805 | 71 | SV *sv; |
79072805 LW |
72 | |
73 | if (!hv) | |
74 | return 0; | |
463ee0b2 | 75 | |
8990e307 | 76 | if (SvRMAGICAL(hv)) { |
463ee0b2 | 77 | if (mg_find((SV*)hv,'P')) { |
8990e307 | 78 | sv = sv_newmortal(); |
463ee0b2 | 79 | mg_copy((SV*)hv, sv, key, klen); |
463ee0b2 LW |
80 | Sv = sv; |
81 | return &Sv; | |
82 | } | |
83 | } | |
84 | ||
79072805 LW |
85 | xhv = (XPVHV*)SvANY(hv); |
86 | if (!xhv->xhv_array) { | |
a0d0e21e LW |
87 | if (lval |
88 | #ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */ | |
89 | || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) | |
90 | #endif | |
91 | ) | |
463ee0b2 | 92 | Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char); |
79072805 LW |
93 | else |
94 | return 0; | |
95 | } | |
96 | ||
fde52b5c | 97 | PERL_HASH(hash, key, klen); |
79072805 | 98 | |
a0d0e21e | 99 | entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; |
fde52b5c | 100 | for (; entry; entry = HeNEXT(entry)) { |
101 | if (HeHASH(entry) != hash) /* strings can't be equal */ | |
79072805 | 102 | continue; |
fde52b5c | 103 | if (HeKLEN(entry) != klen) |
79072805 | 104 | continue; |
cd1469e6 | 105 | if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ |
79072805 | 106 | continue; |
fde52b5c | 107 | return &HeVAL(entry); |
79072805 | 108 | } |
a0d0e21e LW |
109 | #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */ |
110 | if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) { | |
111 | char *gotenv; | |
112 | ||
113 | gotenv = my_getenv(key); | |
114 | if (gotenv != NULL) { | |
115 | sv = newSVpv(gotenv,strlen(gotenv)); | |
116 | return hv_store(hv,key,klen,sv,hash); | |
117 | } | |
118 | } | |
119 | #endif | |
79072805 LW |
120 | if (lval) { /* gonna assign to this, so it better be there */ |
121 | sv = NEWSV(61,0); | |
122 | return hv_store(hv,key,klen,sv,hash); | |
123 | } | |
124 | return 0; | |
125 | } | |
126 | ||
fde52b5c | 127 | /* returns a HE * structure with the all fields set */ |
128 | /* note that hent_val will be a mortal sv for MAGICAL hashes */ | |
129 | HE * | |
130 | hv_fetch_ent(hv,keysv,lval,hash) | |
131 | HV *hv; | |
132 | SV *keysv; | |
133 | I32 lval; | |
134 | register U32 hash; | |
135 | { | |
136 | register XPVHV* xhv; | |
137 | register char *key; | |
138 | STRLEN klen; | |
139 | register HE *entry; | |
140 | SV *sv; | |
141 | ||
142 | if (!hv) | |
143 | return 0; | |
144 | ||
fde52b5c | 145 | if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) { |
fde52b5c | 146 | sv = sv_newmortal(); |
effa1e2d | 147 | keysv = sv_2mortal(newSVsv(keysv)); |
fde52b5c | 148 | mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); |
cd1469e6 | 149 | entry = &He; |
fde52b5c | 150 | HeVAL(entry) = sv; |
cd1469e6 | 151 | HeKEY(entry) = (char*)keysv; |
152 | HeKLEN(entry) = HEf_SVKEY; /* hent_key is holding an SV* */ | |
fde52b5c | 153 | return entry; |
154 | } | |
155 | ||
effa1e2d | 156 | xhv = (XPVHV*)SvANY(hv); |
fde52b5c | 157 | if (!xhv->xhv_array) { |
158 | if (lval | |
159 | #ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */ | |
160 | || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) | |
161 | #endif | |
162 | ) | |
163 | Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char); | |
164 | else | |
165 | return 0; | |
166 | } | |
167 | ||
effa1e2d | 168 | key = SvPV(keysv, klen); |
169 | ||
170 | if (!hash) | |
171 | PERL_HASH(hash, key, klen); | |
172 | ||
fde52b5c | 173 | entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; |
174 | for (; entry; entry = HeNEXT(entry)) { | |
175 | if (HeHASH(entry) != hash) /* strings can't be equal */ | |
176 | continue; | |
177 | if (HeKLEN(entry) != klen) | |
178 | continue; | |
cd1469e6 | 179 | if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ |
fde52b5c | 180 | continue; |
181 | return entry; | |
182 | } | |
183 | #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */ | |
184 | if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) { | |
185 | char *gotenv; | |
186 | ||
187 | gotenv = my_getenv(key); | |
188 | if (gotenv != NULL) { | |
189 | sv = newSVpv(gotenv,strlen(gotenv)); | |
190 | return hv_store_ent(hv,keysv,sv,hash); | |
191 | } | |
192 | } | |
193 | #endif | |
194 | if (lval) { /* gonna assign to this, so it better be there */ | |
195 | sv = NEWSV(61,0); | |
196 | return hv_store_ent(hv,keysv,sv,hash); | |
197 | } | |
198 | return 0; | |
199 | } | |
200 | ||
79072805 LW |
201 | SV** |
202 | hv_store(hv,key,klen,val,hash) | |
203 | HV *hv; | |
204 | char *key; | |
205 | U32 klen; | |
206 | SV *val; | |
93a17b20 | 207 | register U32 hash; |
79072805 LW |
208 | { |
209 | register XPVHV* xhv; | |
79072805 LW |
210 | register I32 i; |
211 | register HE *entry; | |
212 | register HE **oentry; | |
79072805 LW |
213 | |
214 | if (!hv) | |
215 | return 0; | |
216 | ||
217 | xhv = (XPVHV*)SvANY(hv); | |
463ee0b2 | 218 | if (SvMAGICAL(hv)) { |
463ee0b2 | 219 | mg_copy((SV*)hv, val, key, klen); |
a0d0e21e | 220 | #ifndef OVERLOAD |
463ee0b2 LW |
221 | if (!xhv->xhv_array) |
222 | return 0; | |
a0d0e21e LW |
223 | #else |
224 | if (!xhv->xhv_array && (SvMAGIC(hv)->mg_type != 'A' | |
225 | || SvMAGIC(hv)->mg_moremagic)) | |
226 | return 0; | |
227 | #endif /* OVERLOAD */ | |
463ee0b2 | 228 | } |
fde52b5c | 229 | if (!hash) |
230 | PERL_HASH(hash, key, klen); | |
231 | ||
232 | if (!xhv->xhv_array) | |
233 | Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char); | |
234 | ||
235 | oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; | |
236 | i = 1; | |
237 | ||
238 | for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { | |
239 | if (HeHASH(entry) != hash) /* strings can't be equal */ | |
240 | continue; | |
241 | if (HeKLEN(entry) != klen) | |
242 | continue; | |
cd1469e6 | 243 | if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ |
fde52b5c | 244 | continue; |
245 | SvREFCNT_dec(HeVAL(entry)); | |
246 | HeVAL(entry) = val; | |
247 | return &HeVAL(entry); | |
248 | } | |
249 | ||
250 | entry = new_he(); | |
251 | HeKLEN(entry) = klen; | |
252 | if (HvSHAREKEYS(hv)) | |
253 | HeKEY(entry) = sharepvn(key, klen, hash); | |
254 | else /* gotta do the real thing */ | |
255 | HeKEY(entry) = savepvn(key,klen); | |
256 | HeVAL(entry) = val; | |
257 | HeHASH(entry) = hash; | |
258 | HeNEXT(entry) = *oentry; | |
259 | *oentry = entry; | |
260 | ||
261 | xhv->xhv_keys++; | |
262 | if (i) { /* initial entry? */ | |
263 | ++xhv->xhv_fill; | |
264 | if (xhv->xhv_keys > xhv->xhv_max) | |
265 | hsplit(hv); | |
79072805 LW |
266 | } |
267 | ||
fde52b5c | 268 | return &HeVAL(entry); |
269 | } | |
270 | ||
271 | HE * | |
272 | hv_store_ent(hv,keysv,val,hash) | |
273 | HV *hv; | |
274 | SV *keysv; | |
275 | SV *val; | |
276 | register U32 hash; | |
277 | { | |
278 | register XPVHV* xhv; | |
279 | register char *key; | |
280 | STRLEN klen; | |
281 | register I32 i; | |
282 | register HE *entry; | |
283 | register HE **oentry; | |
284 | ||
285 | if (!hv) | |
286 | return 0; | |
287 | ||
288 | xhv = (XPVHV*)SvANY(hv); | |
289 | if (SvMAGICAL(hv)) { | |
effa1e2d | 290 | keysv = sv_2mortal(newSVsv(keysv)); |
fde52b5c | 291 | mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY); |
292 | #ifndef OVERLOAD | |
293 | if (!xhv->xhv_array) | |
294 | return Nullhe; | |
295 | #else | |
296 | if (!xhv->xhv_array && (SvMAGIC(hv)->mg_type != 'A' | |
297 | || SvMAGIC(hv)->mg_moremagic)) | |
298 | return Nullhe; | |
299 | #endif /* OVERLOAD */ | |
300 | } | |
301 | ||
302 | key = SvPV(keysv, klen); | |
303 | ||
304 | if (!hash) | |
305 | PERL_HASH(hash, key, klen); | |
306 | ||
79072805 | 307 | if (!xhv->xhv_array) |
463ee0b2 | 308 | Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char); |
79072805 | 309 | |
a0d0e21e | 310 | oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; |
79072805 LW |
311 | i = 1; |
312 | ||
fde52b5c | 313 | for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { |
314 | if (HeHASH(entry) != hash) /* strings can't be equal */ | |
79072805 | 315 | continue; |
fde52b5c | 316 | if (HeKLEN(entry) != klen) |
79072805 | 317 | continue; |
cd1469e6 | 318 | if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ |
79072805 | 319 | continue; |
fde52b5c | 320 | SvREFCNT_dec(HeVAL(entry)); |
321 | HeVAL(entry) = val; | |
322 | return entry; | |
79072805 | 323 | } |
79072805 | 324 | |
4633a7c4 | 325 | entry = new_he(); |
fde52b5c | 326 | HeKLEN(entry) = klen; |
327 | if (HvSHAREKEYS(hv)) | |
328 | HeKEY(entry) = sharepvn(key, klen, hash); | |
329 | else /* gotta do the real thing */ | |
330 | HeKEY(entry) = savepvn(key,klen); | |
331 | HeVAL(entry) = val; | |
332 | HeHASH(entry) = hash; | |
333 | HeNEXT(entry) = *oentry; | |
79072805 LW |
334 | *oentry = entry; |
335 | ||
463ee0b2 | 336 | xhv->xhv_keys++; |
79072805 | 337 | if (i) { /* initial entry? */ |
463ee0b2 LW |
338 | ++xhv->xhv_fill; |
339 | if (xhv->xhv_keys > xhv->xhv_max) | |
79072805 LW |
340 | hsplit(hv); |
341 | } | |
79072805 | 342 | |
fde52b5c | 343 | return entry; |
79072805 LW |
344 | } |
345 | ||
346 | SV * | |
748a9306 | 347 | hv_delete(hv,key,klen,flags) |
79072805 LW |
348 | HV *hv; |
349 | char *key; | |
350 | U32 klen; | |
748a9306 | 351 | I32 flags; |
79072805 LW |
352 | { |
353 | register XPVHV* xhv; | |
79072805 | 354 | register I32 i; |
fde52b5c | 355 | register U32 hash; |
79072805 LW |
356 | register HE *entry; |
357 | register HE **oentry; | |
358 | SV *sv; | |
79072805 LW |
359 | |
360 | if (!hv) | |
361 | return Nullsv; | |
8990e307 | 362 | if (SvRMAGICAL(hv)) { |
463ee0b2 LW |
363 | sv = *hv_fetch(hv, key, klen, TRUE); |
364 | mg_clear(sv); | |
fde52b5c | 365 | if (mg_find(sv, 's')) { |
366 | return Nullsv; /* %SIG elements cannot be deleted */ | |
367 | } | |
a0d0e21e LW |
368 | if (mg_find(sv, 'p')) { |
369 | sv_unmagic(sv, 'p'); /* No longer an element */ | |
370 | return sv; | |
371 | } | |
463ee0b2 | 372 | } |
79072805 LW |
373 | xhv = (XPVHV*)SvANY(hv); |
374 | if (!xhv->xhv_array) | |
375 | return Nullsv; | |
fde52b5c | 376 | |
377 | PERL_HASH(hash, key, klen); | |
79072805 | 378 | |
a0d0e21e | 379 | oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; |
79072805 LW |
380 | entry = *oentry; |
381 | i = 1; | |
fde52b5c | 382 | for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { |
383 | if (HeHASH(entry) != hash) /* strings can't be equal */ | |
79072805 | 384 | continue; |
fde52b5c | 385 | if (HeKLEN(entry) != klen) |
79072805 | 386 | continue; |
cd1469e6 | 387 | if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ |
79072805 | 388 | continue; |
fde52b5c | 389 | *oentry = HeNEXT(entry); |
79072805 LW |
390 | if (i && !*oentry) |
391 | xhv->xhv_fill--; | |
748a9306 LW |
392 | if (flags & G_DISCARD) |
393 | sv = Nullsv; | |
394 | else | |
fde52b5c | 395 | sv = sv_mortalcopy(HeVAL(entry)); |
a0d0e21e | 396 | if (entry == xhv->xhv_eiter) |
72940dca | 397 | HvLAZYDEL_on(hv); |
a0d0e21e | 398 | else |
fde52b5c | 399 | he_free(entry, HvSHAREKEYS(hv)); |
400 | --xhv->xhv_keys; | |
401 | return sv; | |
402 | } | |
403 | return Nullsv; | |
404 | } | |
405 | ||
406 | SV * | |
407 | hv_delete_ent(hv,keysv,flags,hash) | |
408 | HV *hv; | |
409 | SV *keysv; | |
410 | I32 flags; | |
411 | U32 hash; | |
412 | { | |
413 | register XPVHV* xhv; | |
414 | register I32 i; | |
415 | register char *key; | |
416 | STRLEN klen; | |
417 | register HE *entry; | |
418 | register HE **oentry; | |
419 | SV *sv; | |
420 | ||
421 | if (!hv) | |
422 | return Nullsv; | |
423 | if (SvRMAGICAL(hv)) { | |
424 | entry = hv_fetch_ent(hv, keysv, TRUE, hash); | |
425 | sv = HeVAL(entry); | |
426 | mg_clear(sv); | |
427 | if (mg_find(sv, 'p')) { | |
428 | sv_unmagic(sv, 'p'); /* No longer an element */ | |
429 | return sv; | |
430 | } | |
431 | } | |
432 | xhv = (XPVHV*)SvANY(hv); | |
433 | if (!xhv->xhv_array) | |
434 | return Nullsv; | |
435 | ||
436 | key = SvPV(keysv, klen); | |
437 | ||
438 | if (!hash) | |
439 | PERL_HASH(hash, key, klen); | |
440 | ||
441 | oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; | |
442 | entry = *oentry; | |
443 | i = 1; | |
444 | for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { | |
445 | if (HeHASH(entry) != hash) /* strings can't be equal */ | |
446 | continue; | |
447 | if (HeKLEN(entry) != klen) | |
448 | continue; | |
cd1469e6 | 449 | if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ |
fde52b5c | 450 | continue; |
451 | *oentry = HeNEXT(entry); | |
452 | if (i && !*oentry) | |
453 | xhv->xhv_fill--; | |
454 | if (flags & G_DISCARD) | |
455 | sv = Nullsv; | |
456 | else | |
457 | sv = sv_mortalcopy(HeVAL(entry)); | |
458 | if (entry == xhv->xhv_eiter) | |
72940dca | 459 | HvLAZYDEL_on(hv); |
fde52b5c | 460 | else |
461 | he_free(entry, HvSHAREKEYS(hv)); | |
463ee0b2 | 462 | --xhv->xhv_keys; |
79072805 LW |
463 | return sv; |
464 | } | |
79072805 | 465 | return Nullsv; |
79072805 LW |
466 | } |
467 | ||
a0d0e21e LW |
468 | bool |
469 | hv_exists(hv,key,klen) | |
470 | HV *hv; | |
471 | char *key; | |
472 | U32 klen; | |
473 | { | |
474 | register XPVHV* xhv; | |
fde52b5c | 475 | register U32 hash; |
a0d0e21e LW |
476 | register HE *entry; |
477 | SV *sv; | |
478 | ||
479 | if (!hv) | |
480 | return 0; | |
481 | ||
482 | if (SvRMAGICAL(hv)) { | |
483 | if (mg_find((SV*)hv,'P')) { | |
484 | sv = sv_newmortal(); | |
485 | mg_copy((SV*)hv, sv, key, klen); | |
486 | magic_existspack(sv, mg_find(sv, 'p')); | |
487 | return SvTRUE(sv); | |
488 | } | |
489 | } | |
490 | ||
491 | xhv = (XPVHV*)SvANY(hv); | |
492 | if (!xhv->xhv_array) | |
493 | return 0; | |
494 | ||
fde52b5c | 495 | PERL_HASH(hash, key, klen); |
a0d0e21e LW |
496 | |
497 | entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; | |
fde52b5c | 498 | for (; entry; entry = HeNEXT(entry)) { |
499 | if (HeHASH(entry) != hash) /* strings can't be equal */ | |
a0d0e21e | 500 | continue; |
fde52b5c | 501 | if (HeKLEN(entry) != klen) |
a0d0e21e | 502 | continue; |
cd1469e6 | 503 | if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ |
fde52b5c | 504 | continue; |
505 | return TRUE; | |
506 | } | |
507 | return FALSE; | |
508 | } | |
509 | ||
510 | ||
511 | bool | |
512 | hv_exists_ent(hv,keysv,hash) | |
513 | HV *hv; | |
514 | SV *keysv; | |
515 | U32 hash; | |
516 | { | |
517 | register XPVHV* xhv; | |
518 | register char *key; | |
519 | STRLEN klen; | |
520 | register HE *entry; | |
521 | SV *sv; | |
522 | ||
523 | if (!hv) | |
524 | return 0; | |
525 | ||
526 | if (SvRMAGICAL(hv)) { | |
527 | if (mg_find((SV*)hv,'P')) { | |
528 | sv = sv_newmortal(); | |
effa1e2d | 529 | keysv = sv_2mortal(newSVsv(keysv)); |
fde52b5c | 530 | mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); |
531 | magic_existspack(sv, mg_find(sv, 'p')); | |
532 | return SvTRUE(sv); | |
533 | } | |
534 | } | |
535 | ||
536 | xhv = (XPVHV*)SvANY(hv); | |
537 | if (!xhv->xhv_array) | |
538 | return 0; | |
539 | ||
540 | key = SvPV(keysv, klen); | |
541 | if (!hash) | |
542 | PERL_HASH(hash, key, klen); | |
543 | ||
544 | entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; | |
545 | for (; entry; entry = HeNEXT(entry)) { | |
546 | if (HeHASH(entry) != hash) /* strings can't be equal */ | |
547 | continue; | |
548 | if (HeKLEN(entry) != klen) | |
549 | continue; | |
cd1469e6 | 550 | if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ |
a0d0e21e LW |
551 | continue; |
552 | return TRUE; | |
553 | } | |
554 | return FALSE; | |
555 | } | |
556 | ||
79072805 LW |
557 | static void |
558 | hsplit(hv) | |
559 | HV *hv; | |
560 | { | |
561 | register XPVHV* xhv = (XPVHV*)SvANY(hv); | |
a0d0e21e | 562 | I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */ |
79072805 LW |
563 | register I32 newsize = oldsize * 2; |
564 | register I32 i; | |
565 | register HE **a; | |
566 | register HE **b; | |
567 | register HE *entry; | |
568 | register HE **oentry; | |
c07a80fd | 569 | #ifndef STRANGE_MALLOC |
4633a7c4 | 570 | I32 tmp; |
c07a80fd | 571 | #endif |
79072805 | 572 | |
463ee0b2 | 573 | a = (HE**)xhv->xhv_array; |
79072805 | 574 | nomemok = TRUE; |
4633a7c4 | 575 | #ifdef STRANGE_MALLOC |
79072805 | 576 | Renew(a, newsize, HE*); |
4633a7c4 LW |
577 | #else |
578 | i = newsize * sizeof(HE*); | |
579 | #define MALLOC_OVERHEAD 16 | |
580 | tmp = MALLOC_OVERHEAD; | |
581 | while (tmp - MALLOC_OVERHEAD < i) | |
582 | tmp += tmp; | |
583 | tmp -= MALLOC_OVERHEAD; | |
584 | tmp /= sizeof(HE*); | |
585 | assert(tmp >= newsize); | |
586 | New(2,a, tmp, HE*); | |
587 | Copy(xhv->xhv_array, a, oldsize, HE*); | |
c07a80fd | 588 | if (oldsize >= 64 && !nice_chunk) { |
589 | nice_chunk = (char*)xhv->xhv_array; | |
590 | nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD; | |
4633a7c4 LW |
591 | } |
592 | else | |
593 | Safefree(xhv->xhv_array); | |
594 | #endif | |
595 | ||
79072805 | 596 | nomemok = FALSE; |
79072805 LW |
597 | Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/ |
598 | xhv->xhv_max = --newsize; | |
463ee0b2 | 599 | xhv->xhv_array = (char*)a; |
79072805 LW |
600 | |
601 | for (i=0; i<oldsize; i++,a++) { | |
602 | if (!*a) /* non-existent */ | |
603 | continue; | |
604 | b = a+oldsize; | |
605 | for (oentry = a, entry = *a; entry; entry = *oentry) { | |
fde52b5c | 606 | if ((HeHASH(entry) & newsize) != i) { |
607 | *oentry = HeNEXT(entry); | |
608 | HeNEXT(entry) = *b; | |
79072805 LW |
609 | if (!*b) |
610 | xhv->xhv_fill++; | |
611 | *b = entry; | |
612 | continue; | |
613 | } | |
614 | else | |
fde52b5c | 615 | oentry = &HeNEXT(entry); |
79072805 LW |
616 | } |
617 | if (!*a) /* everything moved */ | |
618 | xhv->xhv_fill--; | |
619 | } | |
620 | } | |
621 | ||
72940dca | 622 | void |
623 | hv_ksplit(hv, newmax) | |
624 | HV *hv; | |
625 | IV newmax; | |
626 | { | |
627 | register XPVHV* xhv = (XPVHV*)SvANY(hv); | |
628 | I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */ | |
629 | register I32 newsize; | |
630 | register I32 i; | |
631 | register I32 j; | |
632 | register HE **a; | |
633 | register HE *entry; | |
634 | register HE **oentry; | |
635 | ||
636 | newsize = (I32) newmax; /* possible truncation here */ | |
637 | if (newsize != newmax || newmax <= oldsize) | |
638 | return; | |
639 | while ((newsize & (1 + ~newsize)) != newsize) { | |
640 | newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */ | |
641 | } | |
642 | if (newsize < newmax) | |
643 | newsize *= 2; | |
644 | if (newsize < newmax) | |
645 | return; /* overflow detection */ | |
646 | ||
647 | a = (HE**)xhv->xhv_array; | |
648 | if (a) { | |
649 | nomemok = TRUE; | |
650 | #ifdef STRANGE_MALLOC | |
651 | Renew(a, newsize, HE*); | |
652 | #else | |
653 | i = newsize * sizeof(HE*); | |
654 | j = MALLOC_OVERHEAD; | |
655 | while (j - MALLOC_OVERHEAD < i) | |
656 | j += j; | |
657 | j -= MALLOC_OVERHEAD; | |
658 | j /= sizeof(HE*); | |
659 | assert(j >= newsize); | |
660 | New(2, a, j, HE*); | |
661 | Copy(xhv->xhv_array, a, oldsize, HE*); | |
662 | if (oldsize >= 64 && !nice_chunk) { | |
663 | nice_chunk = (char*)xhv->xhv_array; | |
664 | nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD; | |
665 | } | |
666 | else | |
667 | Safefree(xhv->xhv_array); | |
668 | #endif | |
669 | nomemok = FALSE; | |
670 | Zero(&a[oldsize], newsize-oldsize, HE*); /* zero 2nd half*/ | |
671 | } | |
672 | else { | |
673 | Newz(0, a, newsize, HE*); | |
674 | } | |
675 | xhv->xhv_max = --newsize; | |
676 | xhv->xhv_array = (char*)a; | |
677 | if (!xhv->xhv_fill) /* skip rest if no entries */ | |
678 | return; | |
679 | ||
680 | for (i=0; i<oldsize; i++,a++) { | |
681 | if (!*a) /* non-existent */ | |
682 | continue; | |
683 | for (oentry = a, entry = *a; entry; entry = *oentry) { | |
684 | if ((j = (HeHASH(entry) & newsize)) != i) { | |
685 | j -= i; | |
686 | *oentry = HeNEXT(entry); | |
687 | if (!(HeNEXT(entry) = a[j])) | |
688 | xhv->xhv_fill++; | |
689 | a[j] = entry; | |
690 | continue; | |
691 | } | |
692 | else | |
693 | oentry = &HeNEXT(entry); | |
694 | } | |
695 | if (!*a) /* everything moved */ | |
696 | xhv->xhv_fill--; | |
697 | } | |
698 | } | |
699 | ||
79072805 | 700 | HV * |
463ee0b2 | 701 | newHV() |
79072805 LW |
702 | { |
703 | register HV *hv; | |
704 | register XPVHV* xhv; | |
705 | ||
a0d0e21e LW |
706 | hv = (HV*)NEWSV(502,0); |
707 | sv_upgrade((SV *)hv, SVt_PVHV); | |
79072805 LW |
708 | xhv = (XPVHV*)SvANY(hv); |
709 | SvPOK_off(hv); | |
710 | SvNOK_off(hv); | |
fde52b5c | 711 | #ifndef NODEFAULT_SHAREKEYS |
712 | HvSHAREKEYS_on(hv); /* key-sharing on by default */ | |
713 | #endif | |
463ee0b2 | 714 | xhv->xhv_max = 7; /* start with 8 buckets */ |
79072805 LW |
715 | xhv->xhv_fill = 0; |
716 | xhv->xhv_pmroot = 0; | |
79072805 LW |
717 | (void)hv_iterinit(hv); /* so each() will start off right */ |
718 | return hv; | |
719 | } | |
720 | ||
721 | void | |
fde52b5c | 722 | he_free(hent, shared) |
79072805 | 723 | register HE *hent; |
fde52b5c | 724 | I32 shared; |
79072805 LW |
725 | { |
726 | if (!hent) | |
727 | return; | |
fde52b5c | 728 | SvREFCNT_dec(HeVAL(hent)); |
729 | if (HeKLEN(hent) == HEf_SVKEY) | |
730 | SvREFCNT_dec((SV*)HeKEY(hent)); | |
731 | else if (shared) | |
732 | unsharepvn(HeKEY(hent), HeKLEN(hent), HeHASH(hent)); | |
733 | else | |
734 | Safefree(HeKEY(hent)); | |
4633a7c4 | 735 | del_he(hent); |
79072805 LW |
736 | } |
737 | ||
738 | void | |
fde52b5c | 739 | he_delayfree(hent, shared) |
79072805 | 740 | register HE *hent; |
fde52b5c | 741 | I32 shared; |
79072805 LW |
742 | { |
743 | if (!hent) | |
744 | return; | |
fde52b5c | 745 | sv_2mortal(HeVAL(hent)); /* free between statements */ |
746 | if (HeKLEN(hent) == HEf_SVKEY) | |
747 | sv_2mortal((SV*)HeKEY(hent)); | |
748 | else if (shared) | |
749 | unsharepvn(HeKEY(hent), HeKLEN(hent), HeHASH(hent)); | |
750 | else | |
751 | Safefree(HeKEY(hent)); | |
4633a7c4 | 752 | del_he(hent); |
79072805 LW |
753 | } |
754 | ||
755 | void | |
463ee0b2 | 756 | hv_clear(hv) |
79072805 | 757 | HV *hv; |
79072805 LW |
758 | { |
759 | register XPVHV* xhv; | |
760 | if (!hv) | |
761 | return; | |
762 | xhv = (XPVHV*)SvANY(hv); | |
463ee0b2 | 763 | hfreeentries(hv); |
79072805 | 764 | xhv->xhv_fill = 0; |
a0d0e21e | 765 | xhv->xhv_keys = 0; |
79072805 | 766 | if (xhv->xhv_array) |
463ee0b2 | 767 | (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*)); |
a0d0e21e LW |
768 | |
769 | if (SvRMAGICAL(hv)) | |
770 | mg_clear((SV*)hv); | |
79072805 LW |
771 | } |
772 | ||
773 | static void | |
463ee0b2 | 774 | hfreeentries(hv) |
79072805 | 775 | HV *hv; |
79072805 | 776 | { |
a0d0e21e | 777 | register HE **array; |
79072805 LW |
778 | register HE *hent; |
779 | register HE *ohent = Null(HE*); | |
a0d0e21e LW |
780 | I32 riter; |
781 | I32 max; | |
fde52b5c | 782 | I32 shared; |
79072805 LW |
783 | |
784 | if (!hv) | |
785 | return; | |
a0d0e21e | 786 | if (!HvARRAY(hv)) |
79072805 | 787 | return; |
a0d0e21e LW |
788 | |
789 | riter = 0; | |
790 | max = HvMAX(hv); | |
791 | array = HvARRAY(hv); | |
792 | hent = array[0]; | |
fde52b5c | 793 | shared = HvSHAREKEYS(hv); |
a0d0e21e LW |
794 | for (;;) { |
795 | if (hent) { | |
796 | ohent = hent; | |
fde52b5c | 797 | hent = HeNEXT(hent); |
798 | he_free(ohent, shared); | |
a0d0e21e LW |
799 | } |
800 | if (!hent) { | |
801 | if (++riter > max) | |
802 | break; | |
803 | hent = array[riter]; | |
804 | } | |
79072805 | 805 | } |
a0d0e21e | 806 | (void)hv_iterinit(hv); |
79072805 LW |
807 | } |
808 | ||
809 | void | |
463ee0b2 | 810 | hv_undef(hv) |
79072805 | 811 | HV *hv; |
79072805 LW |
812 | { |
813 | register XPVHV* xhv; | |
814 | if (!hv) | |
815 | return; | |
816 | xhv = (XPVHV*)SvANY(hv); | |
463ee0b2 | 817 | hfreeentries(hv); |
79072805 | 818 | Safefree(xhv->xhv_array); |
85e6fe83 LW |
819 | if (HvNAME(hv)) { |
820 | Safefree(HvNAME(hv)); | |
821 | HvNAME(hv) = 0; | |
822 | } | |
79072805 | 823 | xhv->xhv_array = 0; |
463ee0b2 | 824 | xhv->xhv_max = 7; /* it's a normal associative array */ |
79072805 | 825 | xhv->xhv_fill = 0; |
a0d0e21e LW |
826 | xhv->xhv_keys = 0; |
827 | ||
828 | if (SvRMAGICAL(hv)) | |
829 | mg_clear((SV*)hv); | |
79072805 LW |
830 | } |
831 | ||
79072805 LW |
832 | I32 |
833 | hv_iterinit(hv) | |
834 | HV *hv; | |
835 | { | |
836 | register XPVHV* xhv = (XPVHV*)SvANY(hv); | |
a0d0e21e | 837 | HE *entry = xhv->xhv_eiter; |
effa1e2d | 838 | #ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */ |
839 | if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) prime_env_iter(); | |
840 | #endif | |
72940dca | 841 | if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */ |
842 | HvLAZYDEL_off(hv); | |
fde52b5c | 843 | he_free(entry, HvSHAREKEYS(hv)); |
72940dca | 844 | } |
79072805 LW |
845 | xhv->xhv_riter = -1; |
846 | xhv->xhv_eiter = Null(HE*); | |
847 | return xhv->xhv_fill; | |
848 | } | |
849 | ||
850 | HE * | |
851 | hv_iternext(hv) | |
852 | HV *hv; | |
853 | { | |
854 | register XPVHV* xhv; | |
855 | register HE *entry; | |
a0d0e21e | 856 | HE *oldentry; |
463ee0b2 | 857 | MAGIC* mg; |
79072805 LW |
858 | |
859 | if (!hv) | |
463ee0b2 | 860 | croak("Bad associative array"); |
79072805 | 861 | xhv = (XPVHV*)SvANY(hv); |
a0d0e21e | 862 | oldentry = entry = xhv->xhv_eiter; |
463ee0b2 | 863 | |
8990e307 LW |
864 | if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) { |
865 | SV *key = sv_newmortal(); | |
cd1469e6 | 866 | if (entry) { |
fde52b5c | 867 | sv_setsv(key, HeSVKEY_force(entry)); |
cd1469e6 | 868 | SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */ |
869 | } | |
a0d0e21e | 870 | else { |
cd1469e6 | 871 | xhv->xhv_eiter = entry = new_he(); /* only one HE per MAGICAL hash */ |
4633a7c4 | 872 | Zero(entry, 1, HE); |
fde52b5c | 873 | HeKLEN(entry) = HEf_SVKEY; |
a0d0e21e LW |
874 | } |
875 | magic_nextpack((SV*) hv,mg,key); | |
463ee0b2 | 876 | if (SvOK(key)) { |
cd1469e6 | 877 | /* force key to stay around until next time */ |
fde52b5c | 878 | HeKEY(entry) = (char*)SvREFCNT_inc(key); |
879 | return entry; /* beware, hent_val is not set */ | |
463ee0b2 | 880 | } |
fde52b5c | 881 | if (HeVAL(entry)) |
882 | SvREFCNT_dec(HeVAL(entry)); | |
4633a7c4 | 883 | del_he(entry); |
463ee0b2 LW |
884 | xhv->xhv_eiter = Null(HE*); |
885 | return Null(HE*); | |
79072805 | 886 | } |
463ee0b2 | 887 | |
79072805 | 888 | if (!xhv->xhv_array) |
4633a7c4 | 889 | Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char); |
fde52b5c | 890 | if (entry) |
891 | entry = HeNEXT(entry); | |
892 | while (!entry) { | |
893 | ++xhv->xhv_riter; | |
894 | if (xhv->xhv_riter > xhv->xhv_max) { | |
895 | xhv->xhv_riter = -1; | |
896 | break; | |
79072805 | 897 | } |
fde52b5c | 898 | entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter]; |
899 | } | |
79072805 | 900 | |
72940dca | 901 | if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */ |
902 | HvLAZYDEL_off(hv); | |
fde52b5c | 903 | he_free(oldentry, HvSHAREKEYS(hv)); |
72940dca | 904 | } |
a0d0e21e | 905 | |
79072805 LW |
906 | xhv->xhv_eiter = entry; |
907 | return entry; | |
908 | } | |
909 | ||
910 | char * | |
911 | hv_iterkey(entry,retlen) | |
912 | register HE *entry; | |
913 | I32 *retlen; | |
914 | { | |
fde52b5c | 915 | if (HeKLEN(entry) == HEf_SVKEY) { |
916 | return SvPV((SV*)HeKEY(entry), *(STRLEN*)retlen); | |
917 | } | |
918 | else { | |
919 | *retlen = HeKLEN(entry); | |
920 | return HeKEY(entry); | |
921 | } | |
922 | } | |
923 | ||
924 | /* unlike hv_iterval(), this always returns a mortal copy of the key */ | |
925 | SV * | |
926 | hv_iterkeysv(entry) | |
927 | register HE *entry; | |
928 | { | |
929 | if (HeKLEN(entry) == HEf_SVKEY) | |
930 | return sv_mortalcopy((SV*)HeKEY(entry)); | |
931 | else | |
932 | return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""), | |
933 | HeKLEN(entry))); | |
79072805 LW |
934 | } |
935 | ||
936 | SV * | |
937 | hv_iterval(hv,entry) | |
938 | HV *hv; | |
939 | register HE *entry; | |
940 | { | |
8990e307 | 941 | if (SvRMAGICAL(hv)) { |
463ee0b2 | 942 | if (mg_find((SV*)hv,'P')) { |
8990e307 | 943 | SV* sv = sv_newmortal(); |
fde52b5c | 944 | mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry)); |
463ee0b2 LW |
945 | return sv; |
946 | } | |
79072805 | 947 | } |
fde52b5c | 948 | return HeVAL(entry); |
79072805 LW |
949 | } |
950 | ||
a0d0e21e LW |
951 | SV * |
952 | hv_iternextsv(hv, key, retlen) | |
953 | HV *hv; | |
954 | char **key; | |
955 | I32 *retlen; | |
956 | { | |
957 | HE *he; | |
958 | if ( (he = hv_iternext(hv)) == NULL) | |
959 | return NULL; | |
960 | *key = hv_iterkey(he, retlen); | |
961 | return hv_iterval(hv, he); | |
962 | } | |
963 | ||
79072805 LW |
964 | void |
965 | hv_magic(hv, gv, how) | |
966 | HV* hv; | |
967 | GV* gv; | |
a0d0e21e | 968 | int how; |
79072805 | 969 | { |
a0d0e21e | 970 | sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0); |
79072805 | 971 | } |
fde52b5c | 972 | |
973 | /* get a (constant) string ptr from the global string table | |
974 | * string will get added if it is not already there. | |
975 | * len and hash must both be valid for str. | |
976 | */ | |
977 | char * | |
978 | sharepvn(str, len, hash) | |
979 | char *str; | |
980 | I32 len; | |
981 | register U32 hash; | |
982 | { | |
983 | register XPVHV* xhv; | |
984 | register HE *entry; | |
985 | register HE **oentry; | |
986 | register I32 i = 1; | |
987 | I32 found = 0; | |
988 | ||
989 | /* what follows is the moral equivalent of: | |
990 | ||
991 | if (!(Svp = hv_fetch(strtab, str, len, FALSE))) | |
992 | hv_store(strtab, str, len, Nullsv, hash); | |
993 | */ | |
994 | xhv = (XPVHV*)SvANY(strtab); | |
995 | /* assert(xhv_array != 0) */ | |
996 | oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; | |
997 | for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { | |
998 | if (HeHASH(entry) != hash) /* strings can't be equal */ | |
999 | continue; | |
1000 | if (HeKLEN(entry) != len) | |
1001 | continue; | |
cd1469e6 | 1002 | if (memcmp(HeKEY(entry),str,len)) /* is this it? */ |
fde52b5c | 1003 | continue; |
1004 | found = 1; | |
1005 | break; | |
1006 | } | |
1007 | if (!found) { | |
1008 | entry = new_he(); | |
1009 | HeKLEN(entry) = len; | |
1010 | HeKEY(entry) = savepvn(str,len); | |
1011 | HeVAL(entry) = Nullsv; | |
1012 | HeHASH(entry) = hash; | |
1013 | HeNEXT(entry) = *oentry; | |
1014 | *oentry = entry; | |
1015 | xhv->xhv_keys++; | |
1016 | if (i) { /* initial entry? */ | |
1017 | ++xhv->xhv_fill; | |
1018 | if (xhv->xhv_keys > xhv->xhv_max) | |
1019 | hsplit(strtab); | |
1020 | } | |
1021 | } | |
1022 | ||
1023 | ++HeVAL(entry); /* use value slot as REFCNT */ | |
1024 | return HeKEY(entry); | |
1025 | } | |
1026 | ||
1027 | /* possibly free a shared string if no one has access to it | |
1028 | * len and hash must both be valid for str. | |
1029 | */ | |
1030 | void | |
1031 | unsharepvn(str, len, hash) | |
1032 | char *str; | |
1033 | I32 len; | |
1034 | register U32 hash; | |
1035 | { | |
1036 | register XPVHV* xhv; | |
1037 | register HE *entry; | |
1038 | register HE **oentry; | |
1039 | register I32 i = 1; | |
1040 | I32 found = 0; | |
1041 | ||
1042 | /* what follows is the moral equivalent of: | |
1043 | if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) { | |
1044 | if (--*Svp == Nullsv) | |
1045 | hv_delete(strtab, str, len, G_DISCARD, hash); | |
1046 | } */ | |
1047 | xhv = (XPVHV*)SvANY(strtab); | |
1048 | /* assert(xhv_array != 0) */ | |
1049 | oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; | |
1050 | for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { | |
1051 | if (HeHASH(entry) != hash) /* strings can't be equal */ | |
1052 | continue; | |
1053 | if (HeKLEN(entry) != len) | |
1054 | continue; | |
cd1469e6 | 1055 | if (memcmp(HeKEY(entry),str,len)) /* is this it? */ |
fde52b5c | 1056 | continue; |
1057 | found = 1; | |
1058 | if (--HeVAL(entry) == Nullsv) { | |
1059 | *oentry = HeNEXT(entry); | |
1060 | if (i && !*oentry) | |
1061 | xhv->xhv_fill--; | |
1062 | Safefree(HeKEY(entry)); | |
1063 | del_he(entry); | |
1064 | --xhv->xhv_keys; | |
1065 | } | |
1066 | break; | |
1067 | } | |
1068 | ||
1069 | if (!found) | |
1070 | warn("Attempt to free non-existent shared string"); | |
1071 | } | |
1072 |