Commit | Line | Data |
a0d0e21e |
1 | /* hv.c |
79072805 |
2 | * |
a0d0e21e |
3 | * Copyright (c) 1991-1994, Larry Wall |
79072805 |
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 |
8 | */ |
9 | |
10 | /* |
11 | * "I sit beside the fire and think of all that I have seen." --Bilbo |
79072805 |
12 | */ |
13 | |
14 | #include "EXTERN.h" |
15 | #include "perl.h" |
16 | |
a0d0e21e |
17 | static void hsplit _((HV *hv)); |
18 | static void hfreeentries _((HV *hv)); |
79072805 |
19 | |
4633a7c4 |
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 |
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 |
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 |
52 | he++; |
53 | } |
fde52b5c |
54 | HeNEXT(he) = 0; |
4633a7c4 |
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 |
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 |
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 |
80 | Sv = sv; |
81 | return &Sv; |
82 | } |
83 | } |
84 | |
79072805 |
85 | xhv = (XPVHV*)SvANY(hv); |
86 | if (!xhv->xhv_array) { |
a0d0e21e |
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 |
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 |
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 |
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 | |
145 | xhv = (XPVHV*)SvANY(hv); |
146 | |
147 | if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) { |
fde52b5c |
148 | sv = sv_newmortal(); |
149 | mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); |
cd1469e6 |
150 | entry = &He; |
fde52b5c |
151 | HeVAL(entry) = sv; |
cd1469e6 |
152 | HeKEY(entry) = (char*)keysv; |
153 | HeKLEN(entry) = HEf_SVKEY; /* hent_key is holding an SV* */ |
fde52b5c |
154 | return entry; |
155 | } |
156 | |
157 | key = SvPV(keysv, klen); |
158 | |
159 | if (!hash) |
160 | PERL_HASH(hash, key, klen); |
161 | |
162 | if (!xhv->xhv_array) { |
163 | if (lval |
164 | #ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */ |
165 | || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) |
166 | #endif |
167 | ) |
168 | Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char); |
169 | else |
170 | return 0; |
171 | } |
172 | |
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 |
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 |
208 | { |
209 | register XPVHV* xhv; |
79072805 |
210 | register I32 i; |
211 | register HE *entry; |
212 | register HE **oentry; |
79072805 |
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 |
221 | if (!xhv->xhv_array) |
222 | return 0; |
a0d0e21e |
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 |
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)) { |
290 | mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY); |
291 | #ifndef OVERLOAD |
292 | if (!xhv->xhv_array) |
293 | return Nullhe; |
294 | #else |
295 | if (!xhv->xhv_array && (SvMAGIC(hv)->mg_type != 'A' |
296 | || SvMAGIC(hv)->mg_moremagic)) |
297 | return Nullhe; |
298 | #endif /* OVERLOAD */ |
299 | } |
300 | |
301 | key = SvPV(keysv, klen); |
302 | |
303 | if (!hash) |
304 | PERL_HASH(hash, key, klen); |
305 | |
79072805 |
306 | if (!xhv->xhv_array) |
463ee0b2 |
307 | Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char); |
79072805 |
308 | |
a0d0e21e |
309 | oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; |
79072805 |
310 | i = 1; |
311 | |
fde52b5c |
312 | for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { |
313 | if (HeHASH(entry) != hash) /* strings can't be equal */ |
79072805 |
314 | continue; |
fde52b5c |
315 | if (HeKLEN(entry) != klen) |
79072805 |
316 | continue; |
cd1469e6 |
317 | if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ |
79072805 |
318 | continue; |
fde52b5c |
319 | SvREFCNT_dec(HeVAL(entry)); |
320 | HeVAL(entry) = val; |
321 | return entry; |
79072805 |
322 | } |
79072805 |
323 | |
4633a7c4 |
324 | entry = new_he(); |
fde52b5c |
325 | HeKLEN(entry) = klen; |
326 | if (HvSHAREKEYS(hv)) |
327 | HeKEY(entry) = sharepvn(key, klen, hash); |
328 | else /* gotta do the real thing */ |
329 | HeKEY(entry) = savepvn(key,klen); |
330 | HeVAL(entry) = val; |
331 | HeHASH(entry) = hash; |
332 | HeNEXT(entry) = *oentry; |
79072805 |
333 | *oentry = entry; |
334 | |
463ee0b2 |
335 | xhv->xhv_keys++; |
79072805 |
336 | if (i) { /* initial entry? */ |
463ee0b2 |
337 | ++xhv->xhv_fill; |
338 | if (xhv->xhv_keys > xhv->xhv_max) |
79072805 |
339 | hsplit(hv); |
340 | } |
79072805 |
341 | |
fde52b5c |
342 | return entry; |
79072805 |
343 | } |
344 | |
345 | SV * |
748a9306 |
346 | hv_delete(hv,key,klen,flags) |
79072805 |
347 | HV *hv; |
348 | char *key; |
349 | U32 klen; |
748a9306 |
350 | I32 flags; |
79072805 |
351 | { |
352 | register XPVHV* xhv; |
79072805 |
353 | register I32 i; |
fde52b5c |
354 | register U32 hash; |
79072805 |
355 | register HE *entry; |
356 | register HE **oentry; |
357 | SV *sv; |
79072805 |
358 | |
359 | if (!hv) |
360 | return Nullsv; |
8990e307 |
361 | if (SvRMAGICAL(hv)) { |
463ee0b2 |
362 | sv = *hv_fetch(hv, key, klen, TRUE); |
363 | mg_clear(sv); |
fde52b5c |
364 | if (mg_find(sv, 's')) { |
365 | return Nullsv; /* %SIG elements cannot be deleted */ |
366 | } |
a0d0e21e |
367 | if (mg_find(sv, 'p')) { |
368 | sv_unmagic(sv, 'p'); /* No longer an element */ |
369 | return sv; |
370 | } |
463ee0b2 |
371 | } |
79072805 |
372 | xhv = (XPVHV*)SvANY(hv); |
373 | if (!xhv->xhv_array) |
374 | return Nullsv; |
fde52b5c |
375 | |
376 | PERL_HASH(hash, key, klen); |
79072805 |
377 | |
a0d0e21e |
378 | oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; |
79072805 |
379 | entry = *oentry; |
380 | i = 1; |
fde52b5c |
381 | for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { |
382 | if (HeHASH(entry) != hash) /* strings can't be equal */ |
79072805 |
383 | continue; |
fde52b5c |
384 | if (HeKLEN(entry) != klen) |
79072805 |
385 | continue; |
cd1469e6 |
386 | if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ |
79072805 |
387 | continue; |
fde52b5c |
388 | *oentry = HeNEXT(entry); |
79072805 |
389 | if (i && !*oentry) |
390 | xhv->xhv_fill--; |
748a9306 |
391 | if (flags & G_DISCARD) |
392 | sv = Nullsv; |
393 | else |
fde52b5c |
394 | sv = sv_mortalcopy(HeVAL(entry)); |
a0d0e21e |
395 | if (entry == xhv->xhv_eiter) |
fde52b5c |
396 | HeKLEN(entry) = HEf_LAZYDEL; |
a0d0e21e |
397 | else |
fde52b5c |
398 | he_free(entry, HvSHAREKEYS(hv)); |
399 | --xhv->xhv_keys; |
400 | return sv; |
401 | } |
402 | return Nullsv; |
403 | } |
404 | |
405 | SV * |
406 | hv_delete_ent(hv,keysv,flags,hash) |
407 | HV *hv; |
408 | SV *keysv; |
409 | I32 flags; |
410 | U32 hash; |
411 | { |
412 | register XPVHV* xhv; |
413 | register I32 i; |
414 | register char *key; |
415 | STRLEN klen; |
416 | register HE *entry; |
417 | register HE **oentry; |
418 | SV *sv; |
419 | |
420 | if (!hv) |
421 | return Nullsv; |
422 | if (SvRMAGICAL(hv)) { |
423 | entry = hv_fetch_ent(hv, keysv, TRUE, hash); |
424 | sv = HeVAL(entry); |
425 | mg_clear(sv); |
426 | if (mg_find(sv, 'p')) { |
427 | sv_unmagic(sv, 'p'); /* No longer an element */ |
428 | return sv; |
429 | } |
430 | } |
431 | xhv = (XPVHV*)SvANY(hv); |
432 | if (!xhv->xhv_array) |
433 | return Nullsv; |
434 | |
435 | key = SvPV(keysv, klen); |
436 | |
437 | if (!hash) |
438 | PERL_HASH(hash, key, klen); |
439 | |
440 | oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; |
441 | entry = *oentry; |
442 | i = 1; |
443 | for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { |
444 | if (HeHASH(entry) != hash) /* strings can't be equal */ |
445 | continue; |
446 | if (HeKLEN(entry) != klen) |
447 | continue; |
cd1469e6 |
448 | if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ |
fde52b5c |
449 | continue; |
450 | *oentry = HeNEXT(entry); |
451 | if (i && !*oentry) |
452 | xhv->xhv_fill--; |
453 | if (flags & G_DISCARD) |
454 | sv = Nullsv; |
455 | else |
456 | sv = sv_mortalcopy(HeVAL(entry)); |
457 | if (entry == xhv->xhv_eiter) |
458 | HeKLEN(entry) = HEf_LAZYDEL; |
459 | else |
460 | he_free(entry, HvSHAREKEYS(hv)); |
463ee0b2 |
461 | --xhv->xhv_keys; |
79072805 |
462 | return sv; |
463 | } |
79072805 |
464 | return Nullsv; |
79072805 |
465 | } |
466 | |
a0d0e21e |
467 | bool |
468 | hv_exists(hv,key,klen) |
469 | HV *hv; |
470 | char *key; |
471 | U32 klen; |
472 | { |
473 | register XPVHV* xhv; |
fde52b5c |
474 | register U32 hash; |
a0d0e21e |
475 | register HE *entry; |
476 | SV *sv; |
477 | |
478 | if (!hv) |
479 | return 0; |
480 | |
481 | if (SvRMAGICAL(hv)) { |
482 | if (mg_find((SV*)hv,'P')) { |
483 | sv = sv_newmortal(); |
484 | mg_copy((SV*)hv, sv, key, klen); |
485 | magic_existspack(sv, mg_find(sv, 'p')); |
486 | return SvTRUE(sv); |
487 | } |
488 | } |
489 | |
490 | xhv = (XPVHV*)SvANY(hv); |
491 | if (!xhv->xhv_array) |
492 | return 0; |
493 | |
fde52b5c |
494 | PERL_HASH(hash, key, klen); |
a0d0e21e |
495 | |
496 | entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; |
fde52b5c |
497 | for (; entry; entry = HeNEXT(entry)) { |
498 | if (HeHASH(entry) != hash) /* strings can't be equal */ |
a0d0e21e |
499 | continue; |
fde52b5c |
500 | if (HeKLEN(entry) != klen) |
a0d0e21e |
501 | continue; |
cd1469e6 |
502 | if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ |
fde52b5c |
503 | continue; |
504 | return TRUE; |
505 | } |
506 | return FALSE; |
507 | } |
508 | |
509 | |
510 | bool |
511 | hv_exists_ent(hv,keysv,hash) |
512 | HV *hv; |
513 | SV *keysv; |
514 | U32 hash; |
515 | { |
516 | register XPVHV* xhv; |
517 | register char *key; |
518 | STRLEN klen; |
519 | register HE *entry; |
520 | SV *sv; |
521 | |
522 | if (!hv) |
523 | return 0; |
524 | |
525 | if (SvRMAGICAL(hv)) { |
526 | if (mg_find((SV*)hv,'P')) { |
527 | sv = sv_newmortal(); |
528 | mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); |
529 | magic_existspack(sv, mg_find(sv, 'p')); |
530 | return SvTRUE(sv); |
531 | } |
532 | } |
533 | |
534 | xhv = (XPVHV*)SvANY(hv); |
535 | if (!xhv->xhv_array) |
536 | return 0; |
537 | |
538 | key = SvPV(keysv, klen); |
539 | if (!hash) |
540 | PERL_HASH(hash, key, klen); |
541 | |
542 | entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; |
543 | for (; entry; entry = HeNEXT(entry)) { |
544 | if (HeHASH(entry) != hash) /* strings can't be equal */ |
545 | continue; |
546 | if (HeKLEN(entry) != klen) |
547 | continue; |
cd1469e6 |
548 | if (memcmp(HeKEY(entry),key,klen)) /* is this it? */ |
a0d0e21e |
549 | continue; |
550 | return TRUE; |
551 | } |
552 | return FALSE; |
553 | } |
554 | |
79072805 |
555 | static void |
556 | hsplit(hv) |
557 | HV *hv; |
558 | { |
559 | register XPVHV* xhv = (XPVHV*)SvANY(hv); |
a0d0e21e |
560 | I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */ |
79072805 |
561 | register I32 newsize = oldsize * 2; |
562 | register I32 i; |
563 | register HE **a; |
564 | register HE **b; |
565 | register HE *entry; |
566 | register HE **oentry; |
c07a80fd |
567 | #ifndef STRANGE_MALLOC |
4633a7c4 |
568 | I32 tmp; |
c07a80fd |
569 | #endif |
79072805 |
570 | |
463ee0b2 |
571 | a = (HE**)xhv->xhv_array; |
79072805 |
572 | nomemok = TRUE; |
4633a7c4 |
573 | #ifdef STRANGE_MALLOC |
79072805 |
574 | Renew(a, newsize, HE*); |
4633a7c4 |
575 | #else |
576 | i = newsize * sizeof(HE*); |
577 | #define MALLOC_OVERHEAD 16 |
578 | tmp = MALLOC_OVERHEAD; |
579 | while (tmp - MALLOC_OVERHEAD < i) |
580 | tmp += tmp; |
581 | tmp -= MALLOC_OVERHEAD; |
582 | tmp /= sizeof(HE*); |
583 | assert(tmp >= newsize); |
584 | New(2,a, tmp, HE*); |
585 | Copy(xhv->xhv_array, a, oldsize, HE*); |
c07a80fd |
586 | if (oldsize >= 64 && !nice_chunk) { |
587 | nice_chunk = (char*)xhv->xhv_array; |
588 | nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD; |
4633a7c4 |
589 | } |
590 | else |
591 | Safefree(xhv->xhv_array); |
592 | #endif |
593 | |
79072805 |
594 | nomemok = FALSE; |
79072805 |
595 | Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/ |
596 | xhv->xhv_max = --newsize; |
463ee0b2 |
597 | xhv->xhv_array = (char*)a; |
79072805 |
598 | |
599 | for (i=0; i<oldsize; i++,a++) { |
600 | if (!*a) /* non-existent */ |
601 | continue; |
602 | b = a+oldsize; |
603 | for (oentry = a, entry = *a; entry; entry = *oentry) { |
fde52b5c |
604 | if ((HeHASH(entry) & newsize) != i) { |
605 | *oentry = HeNEXT(entry); |
606 | HeNEXT(entry) = *b; |
79072805 |
607 | if (!*b) |
608 | xhv->xhv_fill++; |
609 | *b = entry; |
610 | continue; |
611 | } |
612 | else |
fde52b5c |
613 | oentry = &HeNEXT(entry); |
79072805 |
614 | } |
615 | if (!*a) /* everything moved */ |
616 | xhv->xhv_fill--; |
617 | } |
618 | } |
619 | |
620 | HV * |
463ee0b2 |
621 | newHV() |
79072805 |
622 | { |
623 | register HV *hv; |
624 | register XPVHV* xhv; |
625 | |
a0d0e21e |
626 | hv = (HV*)NEWSV(502,0); |
627 | sv_upgrade((SV *)hv, SVt_PVHV); |
79072805 |
628 | xhv = (XPVHV*)SvANY(hv); |
629 | SvPOK_off(hv); |
630 | SvNOK_off(hv); |
fde52b5c |
631 | #ifndef NODEFAULT_SHAREKEYS |
632 | HvSHAREKEYS_on(hv); /* key-sharing on by default */ |
633 | #endif |
463ee0b2 |
634 | xhv->xhv_max = 7; /* start with 8 buckets */ |
79072805 |
635 | xhv->xhv_fill = 0; |
636 | xhv->xhv_pmroot = 0; |
79072805 |
637 | (void)hv_iterinit(hv); /* so each() will start off right */ |
638 | return hv; |
639 | } |
640 | |
641 | void |
fde52b5c |
642 | he_free(hent, shared) |
79072805 |
643 | register HE *hent; |
fde52b5c |
644 | I32 shared; |
79072805 |
645 | { |
646 | if (!hent) |
647 | return; |
fde52b5c |
648 | SvREFCNT_dec(HeVAL(hent)); |
649 | if (HeKLEN(hent) == HEf_SVKEY) |
650 | SvREFCNT_dec((SV*)HeKEY(hent)); |
651 | else if (shared) |
652 | unsharepvn(HeKEY(hent), HeKLEN(hent), HeHASH(hent)); |
653 | else |
654 | Safefree(HeKEY(hent)); |
4633a7c4 |
655 | del_he(hent); |
79072805 |
656 | } |
657 | |
658 | void |
fde52b5c |
659 | he_delayfree(hent, shared) |
79072805 |
660 | register HE *hent; |
fde52b5c |
661 | I32 shared; |
79072805 |
662 | { |
663 | if (!hent) |
664 | return; |
fde52b5c |
665 | sv_2mortal(HeVAL(hent)); /* free between statements */ |
666 | if (HeKLEN(hent) == HEf_SVKEY) |
667 | sv_2mortal((SV*)HeKEY(hent)); |
668 | else if (shared) |
669 | unsharepvn(HeKEY(hent), HeKLEN(hent), HeHASH(hent)); |
670 | else |
671 | Safefree(HeKEY(hent)); |
4633a7c4 |
672 | del_he(hent); |
79072805 |
673 | } |
674 | |
675 | void |
463ee0b2 |
676 | hv_clear(hv) |
79072805 |
677 | HV *hv; |
79072805 |
678 | { |
679 | register XPVHV* xhv; |
680 | if (!hv) |
681 | return; |
682 | xhv = (XPVHV*)SvANY(hv); |
463ee0b2 |
683 | hfreeentries(hv); |
79072805 |
684 | xhv->xhv_fill = 0; |
a0d0e21e |
685 | xhv->xhv_keys = 0; |
79072805 |
686 | if (xhv->xhv_array) |
463ee0b2 |
687 | (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*)); |
a0d0e21e |
688 | |
689 | if (SvRMAGICAL(hv)) |
690 | mg_clear((SV*)hv); |
79072805 |
691 | } |
692 | |
693 | static void |
463ee0b2 |
694 | hfreeentries(hv) |
79072805 |
695 | HV *hv; |
79072805 |
696 | { |
a0d0e21e |
697 | register HE **array; |
79072805 |
698 | register HE *hent; |
699 | register HE *ohent = Null(HE*); |
a0d0e21e |
700 | I32 riter; |
701 | I32 max; |
fde52b5c |
702 | I32 shared; |
79072805 |
703 | |
704 | if (!hv) |
705 | return; |
a0d0e21e |
706 | if (!HvARRAY(hv)) |
79072805 |
707 | return; |
a0d0e21e |
708 | |
709 | riter = 0; |
710 | max = HvMAX(hv); |
711 | array = HvARRAY(hv); |
712 | hent = array[0]; |
fde52b5c |
713 | shared = HvSHAREKEYS(hv); |
a0d0e21e |
714 | for (;;) { |
715 | if (hent) { |
716 | ohent = hent; |
fde52b5c |
717 | hent = HeNEXT(hent); |
718 | he_free(ohent, shared); |
a0d0e21e |
719 | } |
720 | if (!hent) { |
721 | if (++riter > max) |
722 | break; |
723 | hent = array[riter]; |
724 | } |
79072805 |
725 | } |
a0d0e21e |
726 | (void)hv_iterinit(hv); |
79072805 |
727 | } |
728 | |
729 | void |
463ee0b2 |
730 | hv_undef(hv) |
79072805 |
731 | HV *hv; |
79072805 |
732 | { |
733 | register XPVHV* xhv; |
734 | if (!hv) |
735 | return; |
736 | xhv = (XPVHV*)SvANY(hv); |
463ee0b2 |
737 | hfreeentries(hv); |
79072805 |
738 | Safefree(xhv->xhv_array); |
85e6fe83 |
739 | if (HvNAME(hv)) { |
740 | Safefree(HvNAME(hv)); |
741 | HvNAME(hv) = 0; |
742 | } |
79072805 |
743 | xhv->xhv_array = 0; |
463ee0b2 |
744 | xhv->xhv_max = 7; /* it's a normal associative array */ |
79072805 |
745 | xhv->xhv_fill = 0; |
a0d0e21e |
746 | xhv->xhv_keys = 0; |
747 | |
748 | if (SvRMAGICAL(hv)) |
749 | mg_clear((SV*)hv); |
79072805 |
750 | } |
751 | |
79072805 |
752 | I32 |
753 | hv_iterinit(hv) |
754 | HV *hv; |
755 | { |
756 | register XPVHV* xhv = (XPVHV*)SvANY(hv); |
a0d0e21e |
757 | HE *entry = xhv->xhv_eiter; |
fde52b5c |
758 | if (entry && HeKLEN(entry) == HEf_LAZYDEL) /* was deleted earlier? */ |
759 | he_free(entry, HvSHAREKEYS(hv)); |
79072805 |
760 | xhv->xhv_riter = -1; |
761 | xhv->xhv_eiter = Null(HE*); |
762 | return xhv->xhv_fill; |
763 | } |
764 | |
765 | HE * |
766 | hv_iternext(hv) |
767 | HV *hv; |
768 | { |
769 | register XPVHV* xhv; |
770 | register HE *entry; |
a0d0e21e |
771 | HE *oldentry; |
463ee0b2 |
772 | MAGIC* mg; |
79072805 |
773 | |
774 | if (!hv) |
463ee0b2 |
775 | croak("Bad associative array"); |
79072805 |
776 | xhv = (XPVHV*)SvANY(hv); |
a0d0e21e |
777 | oldentry = entry = xhv->xhv_eiter; |
463ee0b2 |
778 | |
8990e307 |
779 | if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) { |
780 | SV *key = sv_newmortal(); |
cd1469e6 |
781 | if (entry) { |
fde52b5c |
782 | sv_setsv(key, HeSVKEY_force(entry)); |
cd1469e6 |
783 | SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */ |
784 | } |
a0d0e21e |
785 | else { |
cd1469e6 |
786 | xhv->xhv_eiter = entry = new_he(); /* only one HE per MAGICAL hash */ |
4633a7c4 |
787 | Zero(entry, 1, HE); |
fde52b5c |
788 | HeKLEN(entry) = HEf_SVKEY; |
a0d0e21e |
789 | } |
790 | magic_nextpack((SV*) hv,mg,key); |
463ee0b2 |
791 | if (SvOK(key)) { |
cd1469e6 |
792 | /* force key to stay around until next time */ |
fde52b5c |
793 | HeKEY(entry) = (char*)SvREFCNT_inc(key); |
794 | return entry; /* beware, hent_val is not set */ |
463ee0b2 |
795 | } |
fde52b5c |
796 | if (HeVAL(entry)) |
797 | SvREFCNT_dec(HeVAL(entry)); |
4633a7c4 |
798 | del_he(entry); |
463ee0b2 |
799 | xhv->xhv_eiter = Null(HE*); |
800 | return Null(HE*); |
79072805 |
801 | } |
463ee0b2 |
802 | |
79072805 |
803 | if (!xhv->xhv_array) |
4633a7c4 |
804 | Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char); |
fde52b5c |
805 | if (entry) |
806 | entry = HeNEXT(entry); |
807 | while (!entry) { |
808 | ++xhv->xhv_riter; |
809 | if (xhv->xhv_riter > xhv->xhv_max) { |
810 | xhv->xhv_riter = -1; |
811 | break; |
79072805 |
812 | } |
fde52b5c |
813 | entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter]; |
814 | } |
79072805 |
815 | |
fde52b5c |
816 | if (oldentry && HeKLEN(oldentry) == HEf_LAZYDEL) /* was deleted earlier? */ |
817 | he_free(oldentry, HvSHAREKEYS(hv)); |
a0d0e21e |
818 | |
79072805 |
819 | xhv->xhv_eiter = entry; |
820 | return entry; |
821 | } |
822 | |
823 | char * |
824 | hv_iterkey(entry,retlen) |
825 | register HE *entry; |
826 | I32 *retlen; |
827 | { |
fde52b5c |
828 | if (HeKLEN(entry) == HEf_SVKEY) { |
829 | return SvPV((SV*)HeKEY(entry), *(STRLEN*)retlen); |
830 | } |
831 | else { |
832 | *retlen = HeKLEN(entry); |
833 | return HeKEY(entry); |
834 | } |
835 | } |
836 | |
837 | /* unlike hv_iterval(), this always returns a mortal copy of the key */ |
838 | SV * |
839 | hv_iterkeysv(entry) |
840 | register HE *entry; |
841 | { |
842 | if (HeKLEN(entry) == HEf_SVKEY) |
843 | return sv_mortalcopy((SV*)HeKEY(entry)); |
844 | else |
845 | return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""), |
846 | HeKLEN(entry))); |
79072805 |
847 | } |
848 | |
849 | SV * |
850 | hv_iterval(hv,entry) |
851 | HV *hv; |
852 | register HE *entry; |
853 | { |
8990e307 |
854 | if (SvRMAGICAL(hv)) { |
463ee0b2 |
855 | if (mg_find((SV*)hv,'P')) { |
8990e307 |
856 | SV* sv = sv_newmortal(); |
fde52b5c |
857 | mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry)); |
463ee0b2 |
858 | return sv; |
859 | } |
79072805 |
860 | } |
fde52b5c |
861 | return HeVAL(entry); |
79072805 |
862 | } |
863 | |
a0d0e21e |
864 | SV * |
865 | hv_iternextsv(hv, key, retlen) |
866 | HV *hv; |
867 | char **key; |
868 | I32 *retlen; |
869 | { |
870 | HE *he; |
871 | if ( (he = hv_iternext(hv)) == NULL) |
872 | return NULL; |
873 | *key = hv_iterkey(he, retlen); |
874 | return hv_iterval(hv, he); |
875 | } |
876 | |
79072805 |
877 | void |
878 | hv_magic(hv, gv, how) |
879 | HV* hv; |
880 | GV* gv; |
a0d0e21e |
881 | int how; |
79072805 |
882 | { |
a0d0e21e |
883 | sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0); |
79072805 |
884 | } |
fde52b5c |
885 | |
886 | /* get a (constant) string ptr from the global string table |
887 | * string will get added if it is not already there. |
888 | * len and hash must both be valid for str. |
889 | */ |
890 | char * |
891 | sharepvn(str, len, hash) |
892 | char *str; |
893 | I32 len; |
894 | register U32 hash; |
895 | { |
896 | register XPVHV* xhv; |
897 | register HE *entry; |
898 | register HE **oentry; |
899 | register I32 i = 1; |
900 | I32 found = 0; |
901 | |
902 | /* what follows is the moral equivalent of: |
903 | |
904 | if (!(Svp = hv_fetch(strtab, str, len, FALSE))) |
905 | hv_store(strtab, str, len, Nullsv, hash); |
906 | */ |
907 | xhv = (XPVHV*)SvANY(strtab); |
908 | /* assert(xhv_array != 0) */ |
909 | oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; |
910 | for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) { |
911 | if (HeHASH(entry) != hash) /* strings can't be equal */ |
912 | continue; |
913 | if (HeKLEN(entry) != len) |
914 | continue; |
cd1469e6 |
915 | if (memcmp(HeKEY(entry),str,len)) /* is this it? */ |
fde52b5c |
916 | continue; |
917 | found = 1; |
918 | break; |
919 | } |
920 | if (!found) { |
921 | entry = new_he(); |
922 | HeKLEN(entry) = len; |
923 | HeKEY(entry) = savepvn(str,len); |
924 | HeVAL(entry) = Nullsv; |
925 | HeHASH(entry) = hash; |
926 | HeNEXT(entry) = *oentry; |
927 | *oentry = entry; |
928 | xhv->xhv_keys++; |
929 | if (i) { /* initial entry? */ |
930 | ++xhv->xhv_fill; |
931 | if (xhv->xhv_keys > xhv->xhv_max) |
932 | hsplit(strtab); |
933 | } |
934 | } |
935 | |
936 | ++HeVAL(entry); /* use value slot as REFCNT */ |
937 | return HeKEY(entry); |
938 | } |
939 | |
940 | /* possibly free a shared string if no one has access to it |
941 | * len and hash must both be valid for str. |
942 | */ |
943 | void |
944 | unsharepvn(str, len, hash) |
945 | char *str; |
946 | I32 len; |
947 | register U32 hash; |
948 | { |
949 | register XPVHV* xhv; |
950 | register HE *entry; |
951 | register HE **oentry; |
952 | register I32 i = 1; |
953 | I32 found = 0; |
954 | |
955 | /* what follows is the moral equivalent of: |
956 | if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) { |
957 | if (--*Svp == Nullsv) |
958 | hv_delete(strtab, str, len, G_DISCARD, hash); |
959 | } */ |
960 | xhv = (XPVHV*)SvANY(strtab); |
961 | /* assert(xhv_array != 0) */ |
962 | oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max]; |
963 | for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) { |
964 | if (HeHASH(entry) != hash) /* strings can't be equal */ |
965 | continue; |
966 | if (HeKLEN(entry) != len) |
967 | continue; |
cd1469e6 |
968 | if (memcmp(HeKEY(entry),str,len)) /* is this it? */ |
fde52b5c |
969 | continue; |
970 | found = 1; |
971 | if (--HeVAL(entry) == Nullsv) { |
972 | *oentry = HeNEXT(entry); |
973 | if (i && !*oentry) |
974 | xhv->xhv_fill--; |
975 | Safefree(HeKEY(entry)); |
976 | del_he(entry); |
977 | --xhv->xhv_keys; |
978 | } |
979 | break; |
980 | } |
981 | |
982 | if (!found) |
983 | warn("Attempt to free non-existent shared string"); |
984 | } |
985 | |