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