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 | |
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 |
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)) { |
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 |
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 |
334 | *oentry = entry; |
335 | |
463ee0b2 |
336 | xhv->xhv_keys++; |
79072805 |
337 | if (i) { /* initial entry? */ |
463ee0b2 |
338 | ++xhv->xhv_fill; |
339 | if (xhv->xhv_keys > xhv->xhv_max) |
79072805 |
340 | hsplit(hv); |
341 | } |
79072805 |
342 | |
fde52b5c |
343 | return entry; |
79072805 |
344 | } |
345 | |
346 | SV * |
748a9306 |
347 | hv_delete(hv,key,klen,flags) |
79072805 |
348 | HV *hv; |
349 | char *key; |
350 | U32 klen; |
748a9306 |
351 | I32 flags; |
79072805 |
352 | { |
353 | register XPVHV* xhv; |
79072805 |
354 | register I32 i; |
fde52b5c |
355 | register U32 hash; |
79072805 |
356 | register HE *entry; |
357 | register HE **oentry; |
358 | SV *sv; |
79072805 |
359 | |
360 | if (!hv) |
361 | return Nullsv; |
8990e307 |
362 | if (SvRMAGICAL(hv)) { |
463ee0b2 |
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 |
368 | if (mg_find(sv, 'p')) { |
369 | sv_unmagic(sv, 'p'); /* No longer an element */ |
370 | return sv; |
371 | } |
463ee0b2 |
372 | } |
79072805 |
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 |
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 |
390 | if (i && !*oentry) |
391 | xhv->xhv_fill--; |
748a9306 |
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 |
463 | return sv; |
464 | } |
79072805 |
465 | return Nullsv; |
79072805 |
466 | } |
467 | |
a0d0e21e |
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 |
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 |
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 |
551 | continue; |
552 | return TRUE; |
553 | } |
554 | return FALSE; |
555 | } |
556 | |
79072805 |
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 |
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 |
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 |
591 | } |
592 | else |
593 | Safefree(xhv->xhv_array); |
594 | #endif |
595 | |
79072805 |
596 | nomemok = FALSE; |
79072805 |
597 | Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/ |
598 | xhv->xhv_max = --newsize; |
463ee0b2 |
599 | xhv->xhv_array = (char*)a; |
79072805 |
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 |
609 | if (!*b) |
610 | xhv->xhv_fill++; |
611 | *b = entry; |
612 | continue; |
613 | } |
614 | else |
fde52b5c |
615 | oentry = &HeNEXT(entry); |
79072805 |
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 |
702 | { |
703 | register HV *hv; |
704 | register XPVHV* xhv; |
705 | |
a0d0e21e |
706 | hv = (HV*)NEWSV(502,0); |
707 | sv_upgrade((SV *)hv, SVt_PVHV); |
79072805 |
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 |
715 | xhv->xhv_fill = 0; |
716 | xhv->xhv_pmroot = 0; |
79072805 |
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 |
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 |
736 | } |
737 | |
738 | void |
fde52b5c |
739 | he_delayfree(hent, shared) |
79072805 |
740 | register HE *hent; |
fde52b5c |
741 | I32 shared; |
79072805 |
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 |
753 | } |
754 | |
755 | void |
463ee0b2 |
756 | hv_clear(hv) |
79072805 |
757 | HV *hv; |
79072805 |
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 |
768 | |
769 | if (SvRMAGICAL(hv)) |
770 | mg_clear((SV*)hv); |
79072805 |
771 | } |
772 | |
773 | static void |
463ee0b2 |
774 | hfreeentries(hv) |
79072805 |
775 | HV *hv; |
79072805 |
776 | { |
a0d0e21e |
777 | register HE **array; |
79072805 |
778 | register HE *hent; |
779 | register HE *ohent = Null(HE*); |
a0d0e21e |
780 | I32 riter; |
781 | I32 max; |
fde52b5c |
782 | I32 shared; |
79072805 |
783 | |
784 | if (!hv) |
785 | return; |
a0d0e21e |
786 | if (!HvARRAY(hv)) |
79072805 |
787 | return; |
a0d0e21e |
788 | |
789 | riter = 0; |
790 | max = HvMAX(hv); |
791 | array = HvARRAY(hv); |
792 | hent = array[0]; |
fde52b5c |
793 | shared = HvSHAREKEYS(hv); |
a0d0e21e |
794 | for (;;) { |
795 | if (hent) { |
796 | ohent = hent; |
fde52b5c |
797 | hent = HeNEXT(hent); |
798 | he_free(ohent, shared); |
a0d0e21e |
799 | } |
800 | if (!hent) { |
801 | if (++riter > max) |
802 | break; |
803 | hent = array[riter]; |
804 | } |
79072805 |
805 | } |
a0d0e21e |
806 | (void)hv_iterinit(hv); |
79072805 |
807 | } |
808 | |
809 | void |
463ee0b2 |
810 | hv_undef(hv) |
79072805 |
811 | HV *hv; |
79072805 |
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 |
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 |
826 | xhv->xhv_keys = 0; |
827 | |
828 | if (SvRMAGICAL(hv)) |
829 | mg_clear((SV*)hv); |
79072805 |
830 | } |
831 | |
79072805 |
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 |
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 |
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 |
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 |
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 |
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 |
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 |
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 |
945 | return sv; |
946 | } |
79072805 |
947 | } |
fde52b5c |
948 | return HeVAL(entry); |
79072805 |
949 | } |
950 | |
a0d0e21e |
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 |
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 | |