This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
This is my patch patch.1n for perl5.001.
[perl5.git] / hv.c
CommitLineData
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
17static void hsplit _((HV *hv));
18static void hfreeentries _((HV *hv));
79072805
LW
19
20SV**
21hv_fetch(hv,key,klen,lval)
22HV *hv;
23char *key;
24U32 klen;
25I32 lval;
26{
27 register XPVHV* xhv;
28 register char *s;
29 register I32 i;
30 register I32 hash;
31 register HE *entry;
79072805 32 SV *sv;
79072805
LW
33
34 if (!hv)
35 return 0;
463ee0b2 36
8990e307 37 if (SvRMAGICAL(hv)) {
463ee0b2 38 if (mg_find((SV*)hv,'P')) {
8990e307 39 sv = sv_newmortal();
463ee0b2 40 mg_copy((SV*)hv, sv, key, klen);
463ee0b2
LW
41 Sv = sv;
42 return &Sv;
43 }
44 }
45
79072805
LW
46 xhv = (XPVHV*)SvANY(hv);
47 if (!xhv->xhv_array) {
a0d0e21e
LW
48 if (lval
49#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
50 || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
51#endif
52 )
463ee0b2 53 Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
79072805
LW
54 else
55 return 0;
56 }
57
463ee0b2
LW
58 i = klen;
59 hash = 0;
60 s = key;
61 while (i--)
62 hash = hash * 33 + *s++;
79072805 63
a0d0e21e 64 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
79072805
LW
65 for (; entry; entry = entry->hent_next) {
66 if (entry->hent_hash != hash) /* strings can't be equal */
67 continue;
68 if (entry->hent_klen != klen)
69 continue;
70 if (bcmp(entry->hent_key,key,klen)) /* is this it? */
71 continue;
72 return &entry->hent_val;
73 }
a0d0e21e
LW
74#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
75 if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
76 char *gotenv;
77
78 gotenv = my_getenv(key);
79 if (gotenv != NULL) {
80 sv = newSVpv(gotenv,strlen(gotenv));
81 return hv_store(hv,key,klen,sv,hash);
82 }
83 }
84#endif
79072805
LW
85 if (lval) { /* gonna assign to this, so it better be there */
86 sv = NEWSV(61,0);
87 return hv_store(hv,key,klen,sv,hash);
88 }
89 return 0;
90}
91
92SV**
93hv_store(hv,key,klen,val,hash)
94HV *hv;
95char *key;
96U32 klen;
97SV *val;
93a17b20 98register U32 hash;
79072805
LW
99{
100 register XPVHV* xhv;
101 register char *s;
102 register I32 i;
103 register HE *entry;
104 register HE **oentry;
79072805
LW
105
106 if (!hv)
107 return 0;
108
109 xhv = (XPVHV*)SvANY(hv);
463ee0b2 110 if (SvMAGICAL(hv)) {
463ee0b2 111 mg_copy((SV*)hv, val, key, klen);
a0d0e21e 112#ifndef OVERLOAD
463ee0b2
LW
113 if (!xhv->xhv_array)
114 return 0;
a0d0e21e
LW
115#else
116 if (!xhv->xhv_array && (SvMAGIC(hv)->mg_type != 'A'
117 || SvMAGIC(hv)->mg_moremagic))
118 return 0;
119#endif /* OVERLOAD */
463ee0b2
LW
120 }
121 if (!hash) {
122 i = klen;
123 s = key;
124 while (i--)
125 hash = hash * 33 + *s++;
79072805
LW
126 }
127
128 if (!xhv->xhv_array)
463ee0b2 129 Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
79072805 130
a0d0e21e 131 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
79072805
LW
132 i = 1;
133
79072805
LW
134 for (entry = *oentry; entry; i=0, entry = entry->hent_next) {
135 if (entry->hent_hash != hash) /* strings can't be equal */
136 continue;
137 if (entry->hent_klen != klen)
138 continue;
139 if (bcmp(entry->hent_key,key,klen)) /* is this it? */
140 continue;
8990e307 141 SvREFCNT_dec(entry->hent_val);
79072805
LW
142 entry->hent_val = val;
143 return &entry->hent_val;
144 }
145 New(501,entry, 1, HE);
146
147 entry->hent_klen = klen;
a0d0e21e 148 entry->hent_key = savepvn(key,klen);
79072805
LW
149 entry->hent_val = val;
150 entry->hent_hash = hash;
151 entry->hent_next = *oentry;
152 *oentry = entry;
153
463ee0b2 154 xhv->xhv_keys++;
79072805 155 if (i) { /* initial entry? */
463ee0b2
LW
156 ++xhv->xhv_fill;
157 if (xhv->xhv_keys > xhv->xhv_max)
79072805
LW
158 hsplit(hv);
159 }
79072805
LW
160
161 return &entry->hent_val;
162}
163
164SV *
748a9306 165hv_delete(hv,key,klen,flags)
79072805
LW
166HV *hv;
167char *key;
168U32 klen;
748a9306 169I32 flags;
79072805
LW
170{
171 register XPVHV* xhv;
172 register char *s;
173 register I32 i;
174 register I32 hash;
175 register HE *entry;
176 register HE **oentry;
177 SV *sv;
79072805
LW
178
179 if (!hv)
180 return Nullsv;
8990e307 181 if (SvRMAGICAL(hv)) {
463ee0b2
LW
182 sv = *hv_fetch(hv, key, klen, TRUE);
183 mg_clear(sv);
a0d0e21e
LW
184 if (mg_find(sv, 'p')) {
185 sv_unmagic(sv, 'p'); /* No longer an element */
186 return sv;
187 }
463ee0b2 188 }
79072805
LW
189 xhv = (XPVHV*)SvANY(hv);
190 if (!xhv->xhv_array)
191 return Nullsv;
463ee0b2
LW
192 i = klen;
193 hash = 0;
194 s = key;
195 while (i--)
196 hash = hash * 33 + *s++;
79072805 197
a0d0e21e 198 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
79072805
LW
199 entry = *oentry;
200 i = 1;
201 for (; entry; i=0, oentry = &entry->hent_next, entry = *oentry) {
202 if (entry->hent_hash != hash) /* strings can't be equal */
203 continue;
204 if (entry->hent_klen != klen)
205 continue;
206 if (bcmp(entry->hent_key,key,klen)) /* is this it? */
207 continue;
208 *oentry = entry->hent_next;
209 if (i && !*oentry)
210 xhv->xhv_fill--;
748a9306
LW
211 if (flags & G_DISCARD)
212 sv = Nullsv;
213 else
214 sv = sv_mortalcopy(entry->hent_val);
a0d0e21e
LW
215 if (entry == xhv->xhv_eiter)
216 entry->hent_klen = -1;
217 else
218 he_free(entry);
463ee0b2 219 --xhv->xhv_keys;
79072805
LW
220 return sv;
221 }
79072805 222 return Nullsv;
79072805
LW
223}
224
a0d0e21e
LW
225bool
226hv_exists(hv,key,klen)
227HV *hv;
228char *key;
229U32 klen;
230{
231 register XPVHV* xhv;
232 register char *s;
233 register I32 i;
234 register I32 hash;
235 register HE *entry;
236 SV *sv;
237
238 if (!hv)
239 return 0;
240
241 if (SvRMAGICAL(hv)) {
242 if (mg_find((SV*)hv,'P')) {
243 sv = sv_newmortal();
244 mg_copy((SV*)hv, sv, key, klen);
245 magic_existspack(sv, mg_find(sv, 'p'));
246 return SvTRUE(sv);
247 }
248 }
249
250 xhv = (XPVHV*)SvANY(hv);
251 if (!xhv->xhv_array)
252 return 0;
253
254 i = klen;
255 hash = 0;
256 s = key;
257 while (i--)
258 hash = hash * 33 + *s++;
259
260 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
261 for (; entry; entry = entry->hent_next) {
262 if (entry->hent_hash != hash) /* strings can't be equal */
263 continue;
264 if (entry->hent_klen != klen)
265 continue;
266 if (bcmp(entry->hent_key,key,klen)) /* is this it? */
267 continue;
268 return TRUE;
269 }
270 return FALSE;
271}
272
79072805
LW
273static void
274hsplit(hv)
275HV *hv;
276{
277 register XPVHV* xhv = (XPVHV*)SvANY(hv);
a0d0e21e 278 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
79072805
LW
279 register I32 newsize = oldsize * 2;
280 register I32 i;
281 register HE **a;
282 register HE **b;
283 register HE *entry;
284 register HE **oentry;
285
463ee0b2 286 a = (HE**)xhv->xhv_array;
79072805
LW
287 nomemok = TRUE;
288 Renew(a, newsize, HE*);
289 nomemok = FALSE;
79072805
LW
290 Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/
291 xhv->xhv_max = --newsize;
463ee0b2 292 xhv->xhv_array = (char*)a;
79072805
LW
293
294 for (i=0; i<oldsize; i++,a++) {
295 if (!*a) /* non-existent */
296 continue;
297 b = a+oldsize;
298 for (oentry = a, entry = *a; entry; entry = *oentry) {
299 if ((entry->hent_hash & newsize) != i) {
300 *oentry = entry->hent_next;
301 entry->hent_next = *b;
302 if (!*b)
303 xhv->xhv_fill++;
304 *b = entry;
305 continue;
306 }
307 else
308 oentry = &entry->hent_next;
309 }
310 if (!*a) /* everything moved */
311 xhv->xhv_fill--;
312 }
313}
314
315HV *
463ee0b2 316newHV()
79072805
LW
317{
318 register HV *hv;
319 register XPVHV* xhv;
320
a0d0e21e
LW
321 hv = (HV*)NEWSV(502,0);
322 sv_upgrade((SV *)hv, SVt_PVHV);
79072805
LW
323 xhv = (XPVHV*)SvANY(hv);
324 SvPOK_off(hv);
325 SvNOK_off(hv);
463ee0b2 326 xhv->xhv_max = 7; /* start with 8 buckets */
79072805
LW
327 xhv->xhv_fill = 0;
328 xhv->xhv_pmroot = 0;
79072805
LW
329 (void)hv_iterinit(hv); /* so each() will start off right */
330 return hv;
331}
332
333void
334he_free(hent)
335register HE *hent;
336{
337 if (!hent)
338 return;
8990e307 339 SvREFCNT_dec(hent->hent_val);
79072805
LW
340 Safefree(hent->hent_key);
341 Safefree(hent);
342}
343
344void
345he_delayfree(hent)
346register HE *hent;
347{
348 if (!hent)
349 return;
350 sv_2mortal(hent->hent_val); /* free between statements */
351 Safefree(hent->hent_key);
352 Safefree(hent);
353}
354
355void
463ee0b2 356hv_clear(hv)
79072805 357HV *hv;
79072805
LW
358{
359 register XPVHV* xhv;
360 if (!hv)
361 return;
362 xhv = (XPVHV*)SvANY(hv);
463ee0b2 363 hfreeentries(hv);
79072805 364 xhv->xhv_fill = 0;
a0d0e21e 365 xhv->xhv_keys = 0;
79072805 366 if (xhv->xhv_array)
463ee0b2 367 (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
a0d0e21e
LW
368
369 if (SvRMAGICAL(hv))
370 mg_clear((SV*)hv);
79072805
LW
371}
372
373static void
463ee0b2 374hfreeentries(hv)
79072805 375HV *hv;
79072805 376{
a0d0e21e 377 register HE **array;
79072805
LW
378 register HE *hent;
379 register HE *ohent = Null(HE*);
a0d0e21e
LW
380 I32 riter;
381 I32 max;
79072805
LW
382
383 if (!hv)
384 return;
a0d0e21e 385 if (!HvARRAY(hv))
79072805 386 return;
a0d0e21e
LW
387
388 riter = 0;
389 max = HvMAX(hv);
390 array = HvARRAY(hv);
391 hent = array[0];
392 for (;;) {
393 if (hent) {
394 ohent = hent;
395 hent = hent->hent_next;
396 he_free(ohent);
397 }
398 if (!hent) {
399 if (++riter > max)
400 break;
401 hent = array[riter];
402 }
79072805 403 }
a0d0e21e 404 (void)hv_iterinit(hv);
79072805
LW
405}
406
407void
463ee0b2 408hv_undef(hv)
79072805 409HV *hv;
79072805
LW
410{
411 register XPVHV* xhv;
412 if (!hv)
413 return;
414 xhv = (XPVHV*)SvANY(hv);
463ee0b2 415 hfreeentries(hv);
79072805 416 Safefree(xhv->xhv_array);
85e6fe83
LW
417 if (HvNAME(hv)) {
418 Safefree(HvNAME(hv));
419 HvNAME(hv) = 0;
420 }
79072805 421 xhv->xhv_array = 0;
463ee0b2 422 xhv->xhv_max = 7; /* it's a normal associative array */
79072805 423 xhv->xhv_fill = 0;
a0d0e21e
LW
424 xhv->xhv_keys = 0;
425
426 if (SvRMAGICAL(hv))
427 mg_clear((SV*)hv);
79072805
LW
428}
429
79072805
LW
430I32
431hv_iterinit(hv)
432HV *hv;
433{
434 register XPVHV* xhv = (XPVHV*)SvANY(hv);
a0d0e21e
LW
435 HE *entry = xhv->xhv_eiter;
436 if (entry && entry->hent_klen < 0) /* was deleted earlier? */
437 he_free(entry);
79072805
LW
438 xhv->xhv_riter = -1;
439 xhv->xhv_eiter = Null(HE*);
440 return xhv->xhv_fill;
441}
442
443HE *
444hv_iternext(hv)
445HV *hv;
446{
447 register XPVHV* xhv;
448 register HE *entry;
a0d0e21e 449 HE *oldentry;
463ee0b2 450 MAGIC* mg;
79072805
LW
451
452 if (!hv)
463ee0b2 453 croak("Bad associative array");
79072805 454 xhv = (XPVHV*)SvANY(hv);
a0d0e21e 455 oldentry = entry = xhv->xhv_eiter;
463ee0b2 456
8990e307
LW
457 if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
458 SV *key = sv_newmortal();
a0d0e21e
LW
459 if (entry) {
460 sv_usepvn(key, entry->hent_key, entry->hent_klen);
461 entry->hent_key = 0;
462 }
463 else {
464 Newz(504,entry, 1, HE);
465 xhv->xhv_eiter = entry;
466 }
467 magic_nextpack((SV*) hv,mg,key);
463ee0b2
LW
468 if (SvOK(key)) {
469 STRLEN len;
a0d0e21e 470 entry->hent_key = SvPV_force(key, len);
463ee0b2
LW
471 entry->hent_klen = len;
472 SvPOK_off(key);
473 SvPVX(key) = 0;
474 return entry;
475 }
476 if (entry->hent_val)
8990e307 477 SvREFCNT_dec(entry->hent_val);
463ee0b2
LW
478 Safefree(entry);
479 xhv->xhv_eiter = Null(HE*);
480 return Null(HE*);
79072805 481 }
463ee0b2 482
79072805 483 if (!xhv->xhv_array)
8e07c86e
AD
484 entry = Null(HE*);
485 else
79072805
LW
486 do {
487 if (entry)
488 entry = entry->hent_next;
489 if (!entry) {
a0d0e21e 490 ++xhv->xhv_riter;
79072805
LW
491 if (xhv->xhv_riter > xhv->xhv_max) {
492 xhv->xhv_riter = -1;
493 break;
494 }
463ee0b2 495 entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
79072805
LW
496 }
497 } while (!entry);
498
a0d0e21e
LW
499 if (oldentry && oldentry->hent_klen < 0) /* was deleted earlier? */
500 he_free(oldentry);
501
79072805
LW
502 xhv->xhv_eiter = entry;
503 return entry;
504}
505
506char *
507hv_iterkey(entry,retlen)
508register HE *entry;
509I32 *retlen;
510{
511 *retlen = entry->hent_klen;
512 return entry->hent_key;
513}
514
515SV *
516hv_iterval(hv,entry)
517HV *hv;
518register HE *entry;
519{
8990e307 520 if (SvRMAGICAL(hv)) {
463ee0b2 521 if (mg_find((SV*)hv,'P')) {
8990e307 522 SV* sv = sv_newmortal();
463ee0b2 523 mg_copy((SV*)hv, sv, entry->hent_key, entry->hent_klen);
463ee0b2
LW
524 return sv;
525 }
79072805 526 }
79072805
LW
527 return entry->hent_val;
528}
529
a0d0e21e
LW
530SV *
531hv_iternextsv(hv, key, retlen)
532 HV *hv;
533 char **key;
534 I32 *retlen;
535{
536 HE *he;
537 if ( (he = hv_iternext(hv)) == NULL)
538 return NULL;
539 *key = hv_iterkey(he, retlen);
540 return hv_iterval(hv, he);
541}
542
79072805
LW
543void
544hv_magic(hv, gv, how)
545HV* hv;
546GV* gv;
a0d0e21e 547int how;
79072805 548{
a0d0e21e 549 sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
79072805 550}