Correct CODE block declaration
[p5sagit/p5-mst-13.2.git] / hv.c
diff --git a/hv.c b/hv.c
index 2468e87..d9cbe52 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1,35 +1,59 @@
-/* $RCSfile: hash.c,v $$Revision: 4.1 $$Date: 92/08/07 18:21:48 $
+/*    hv.c
  *
- *    Copyright (c) 1991, Larry Wall
+ *    Copyright (c) 1991-1994, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
  *
- * $Log:       hash.c,v $
- * Revision 4.1  92/08/07  18:21:48  lwall
- * 
- * Revision 4.0.1.3  92/06/08  13:26:29  lwall
- * patch20: removed implicit int declarations on functions
- * patch20: delete could cause %array to give too low a count of buckets filled
- * patch20: hash tables now split only if the memory is available to do so
- * 
- * Revision 4.0.1.2  91/11/05  17:24:13  lwall
- * patch11: saberized perl
- * 
- * Revision 4.0.1.1  91/06/07  11:10:11  lwall
- * patch4: new copyright notice
- * 
- * Revision 4.0  91/03/20  01:22:26  lwall
- * 4.0 baseline.
- * 
+ */
+
+/*
+ * "I sit beside the fire and think of all that I have seen."  --Bilbo
  */
 
 #include "EXTERN.h"
 #include "perl.h"
 
-static void hsplit();
+static void hsplit _((HV *hv));
+static void hfreeentries _((HV *hv));
+
+static HE* more_he();
+
+static HE*
+new_he()
+{
+    HE* he;
+    if (he_root) {
+        he = he_root;
+        he_root = (HE*)he->hent_next;
+        return he;
+    }
+    return more_he();
+}
+
+static void
+del_he(p)
+HE* p;
+{
+    p->hent_next = (HE*)he_root;
+    he_root = p;
+}
 
-static void hfreeentries();
+static HE*
+more_he()
+{
+    register HE* he;
+    register HE* heend;
+    he_root = (HE*)safemalloc(1008);
+    he = he_root;
+    heend = &he[1008 / sizeof(HE) - 1];
+    while (he < heend) {
+        he->hent_next = (HE*)(he + 1);
+        he++;
+    }
+    he->hent_next = 0;
+    return new_he();
+}
 
 SV**
 hv_fetch(hv,key,klen,lval)
@@ -52,10 +76,6 @@ I32 lval;
        if (mg_find((SV*)hv,'P')) {
            sv = sv_newmortal();
            mg_copy((SV*)hv, sv, key, klen);
-           if (!lval) {
-               mg_get(sv);
-               sv_unmagic(sv,'p');
-           }
            Sv = sv;
            return &Sv;
        }
@@ -63,7 +83,11 @@ I32 lval;
 
     xhv = (XPVHV*)SvANY(hv);
     if (!xhv->xhv_array) {
-       if (lval)
+       if (lval 
+#ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
+                || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
+#endif
+                                                                 )
            Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
        else
            return 0;
@@ -75,7 +99,7 @@ I32 lval;
     while (i--)
        hash = hash * 33 + *s++;
 
-    entry = ((HE**)xhv->xhv_array)[hash & xhv->xhv_max];
+    entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
     for (; entry; entry = entry->hent_next) {
        if (entry->hent_hash != hash)           /* strings can't be equal */
            continue;
@@ -85,6 +109,17 @@ I32 lval;
            continue;
        return &entry->hent_val;
     }
+#ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
+    if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
+      char *gotenv;
+
+      gotenv = my_getenv(key);
+      if (gotenv != NULL) {
+        sv = newSVpv(gotenv,strlen(gotenv));
+        return hv_store(hv,key,klen,sv,hash);
+      }
+    }
+#endif
     if (lval) {                /* gonna assign to this, so it better be there */
        sv = NEWSV(61,0);
        return hv_store(hv,key,klen,sv,hash);
@@ -112,8 +147,14 @@ register U32 hash;
     xhv = (XPVHV*)SvANY(hv);
     if (SvMAGICAL(hv)) {
        mg_copy((SV*)hv, val, key, klen);
+#ifndef OVERLOAD
        if (!xhv->xhv_array)
            return 0;
+#else
+       if (!xhv->xhv_array && (SvMAGIC(hv)->mg_type != 'A'
+                               || SvMAGIC(hv)->mg_moremagic))
+         return 0;
+#endif /* OVERLOAD */
     }
     if (!hash) {
     i = klen;
@@ -125,7 +166,7 @@ register U32 hash;
     if (!xhv->xhv_array)
        Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
 
-    oentry = &((HE**)xhv->xhv_array)[hash & xhv->xhv_max];
+    oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
     i = 1;
 
     for (entry = *oentry; entry; i=0, entry = entry->hent_next) {
@@ -139,10 +180,10 @@ register U32 hash;
        entry->hent_val = val;
        return &entry->hent_val;
     }
-    New(501,entry, 1, HE);
 
+    entry = new_he();
     entry->hent_klen = klen;
-    entry->hent_key = nsavestr(key,klen);
+    entry->hent_key = savepvn(key,klen);
     entry->hent_val = val;
     entry->hent_hash = hash;
     entry->hent_next = *oentry;
@@ -159,10 +200,11 @@ register U32 hash;
 }
 
 SV *
-hv_delete(hv,key,klen)
+hv_delete(hv,key,klen,flags)
 HV *hv;
 char *key;
 U32 klen;
+I32 flags;
 {
     register XPVHV* xhv;
     register char *s;
@@ -177,6 +219,10 @@ U32 klen;
     if (SvRMAGICAL(hv)) {
        sv = *hv_fetch(hv, key, klen, TRUE);
        mg_clear(sv);
+       if (mg_find(sv, 'p')) {
+           sv_unmagic(sv, 'p');        /* No longer an element */
+           return sv;
+       }
     }
     xhv = (XPVHV*)SvANY(hv);
     if (!xhv->xhv_array)
@@ -187,7 +233,7 @@ U32 klen;
     while (i--)
        hash = hash * 33 + *s++;
 
-    oentry = &((HE**)xhv->xhv_array)[hash & xhv->xhv_max];
+    oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
     entry = *oentry;
     i = 1;
     for (; entry; i=0, oentry = &entry->hent_next, entry = *oentry) {
@@ -200,30 +246,107 @@ U32 klen;
        *oentry = entry->hent_next;
        if (i && !*oentry)
            xhv->xhv_fill--;
-       sv = sv_mortalcopy(entry->hent_val);
-       he_free(entry);
+       if (flags & G_DISCARD)
+           sv = Nullsv;
+       else
+           sv = sv_mortalcopy(entry->hent_val);
+       if (entry == xhv->xhv_eiter)
+           entry->hent_klen = -1;
+       else
+           he_free(entry);
        --xhv->xhv_keys;
        return sv;
     }
     return Nullsv;
 }
 
+bool
+hv_exists(hv,key,klen)
+HV *hv;
+char *key;
+U32 klen;
+{
+    register XPVHV* xhv;
+    register char *s;
+    register I32 i;
+    register I32 hash;
+    register HE *entry;
+    SV *sv;
+
+    if (!hv)
+       return 0;
+
+    if (SvRMAGICAL(hv)) {
+       if (mg_find((SV*)hv,'P')) {
+           sv = sv_newmortal();
+           mg_copy((SV*)hv, sv, key, klen); 
+           magic_existspack(sv, mg_find(sv, 'p'));
+           return SvTRUE(sv);
+       }
+    }
+
+    xhv = (XPVHV*)SvANY(hv);
+    if (!xhv->xhv_array)
+       return 0; 
+
+    i = klen;
+    hash = 0;
+    s = key;
+    while (i--)
+       hash = hash * 33 + *s++;
+
+    entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
+    for (; entry; entry = entry->hent_next) {
+       if (entry->hent_hash != hash)           /* strings can't be equal */
+           continue;
+       if (entry->hent_klen != klen)
+           continue;
+       if (bcmp(entry->hent_key,key,klen))     /* is this it? */
+           continue;
+       return TRUE;
+    }
+    return FALSE;
+}
+
 static void
 hsplit(hv)
 HV *hv;
 {
     register XPVHV* xhv = (XPVHV*)SvANY(hv);
-    I32 oldsize = xhv->xhv_max + 1;
+    I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
     register I32 newsize = oldsize * 2;
     register I32 i;
     register HE **a;
     register HE **b;
     register HE *entry;
     register HE **oentry;
+#ifndef STRANGE_MALLOC
+    I32 tmp;
+#endif
 
     a = (HE**)xhv->xhv_array;
     nomemok = TRUE;
+#ifdef STRANGE_MALLOC
     Renew(a, newsize, HE*);
+#else
+    i = newsize * sizeof(HE*);
+#define MALLOC_OVERHEAD 16
+    tmp = MALLOC_OVERHEAD;
+    while (tmp - MALLOC_OVERHEAD < i)
+       tmp += tmp;
+    tmp -= MALLOC_OVERHEAD;
+    tmp /= sizeof(HE*);
+    assert(tmp >= newsize);
+    New(2,a, tmp, HE*);
+    Copy(xhv->xhv_array, a, oldsize, HE*);
+    if (oldsize >= 64 && !nice_chunk) {
+       nice_chunk = (char*)xhv->xhv_array;
+       nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD;
+    }
+    else
+       Safefree(xhv->xhv_array);
+#endif
+
     nomemok = FALSE;
     Zero(&a[oldsize], oldsize, HE*);           /* zero 2nd half*/
     xhv->xhv_max = --newsize;
@@ -256,9 +379,8 @@ newHV()
     register HV *hv;
     register XPVHV* xhv;
 
-    Newz(502,hv, 1, HV);
-    SvREFCNT(hv) = 1;
-    sv_upgrade(hv, SVt_PVHV);
+    hv = (HV*)NEWSV(502,0);
+    sv_upgrade((SV *)hv, SVt_PVHV);
     xhv = (XPVHV*)SvANY(hv);
     SvPOK_off(hv);
     SvNOK_off(hv);
@@ -277,7 +399,7 @@ register HE *hent;
        return;
     SvREFCNT_dec(hent->hent_val);
     Safefree(hent->hent_key);
-    Safefree(hent);
+    del_he(hent);
 }
 
 void
@@ -288,7 +410,7 @@ register HE *hent;
        return;
     sv_2mortal(hent->hent_val);        /* free between statements */
     Safefree(hent->hent_key);
-    Safefree(hent);
+    del_he(hent);
 }
 
 void
@@ -301,32 +423,46 @@ HV *hv;
     xhv = (XPVHV*)SvANY(hv);
     hfreeentries(hv);
     xhv->xhv_fill = 0;
+    xhv->xhv_keys = 0;
     if (xhv->xhv_array)
        (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
+
+    if (SvRMAGICAL(hv))
+       mg_clear((SV*)hv); 
 }
 
 static void
 hfreeentries(hv)
 HV *hv;
 {
-    register XPVHV* xhv;
+    register HE **array;
     register HE *hent;
     register HE *ohent = Null(HE*);
+    I32 riter;
+    I32 max;
 
     if (!hv)
        return;
-    xhv = (XPVHV*)SvANY(hv);
-    if (!xhv->xhv_array)
+    if (!HvARRAY(hv))
        return;
-    (void)hv_iterinit(hv);
-    /*SUPPRESS 560*/
-    while (hent = hv_iternext(hv)) {   /* concise but not very efficient */
-       he_free(ohent);
-       ohent = hent;
+
+    riter = 0;
+    max = HvMAX(hv);
+    array = HvARRAY(hv);
+    hent = array[0];
+    for (;;) {
+       if (hent) {
+           ohent = hent;
+           hent = hent->hent_next;
+           he_free(ohent);
+       }
+       if (!hent) {
+           if (++riter > max)
+               break;
+           hent = array[riter];
+       } 
     }
-    he_free(ohent);
-    if (SvMAGIC(hv))
-       mg_clear((SV*)hv);
+    (void)hv_iterinit(hv);
 }
 
 void
@@ -339,21 +475,17 @@ HV *hv;
     xhv = (XPVHV*)SvANY(hv);
     hfreeentries(hv);
     Safefree(xhv->xhv_array);
+    if (HvNAME(hv)) {
+       Safefree(HvNAME(hv));
+       HvNAME(hv) = 0;
+    }
     xhv->xhv_array = 0;
     xhv->xhv_max = 7;          /* it's a normal associative array */
     xhv->xhv_fill = 0;
-    (void)hv_iterinit(hv);     /* so each() will start off right */
-}
+    xhv->xhv_keys = 0;
 
-void
-hv_free(hv)
-register HV *hv;
-{
-    if (!hv)
-       return;
-    hfreeentries(hv);
-    Safefree(HvARRAY(hv));
-    Safefree(hv);
+    if (SvRMAGICAL(hv))
+       mg_clear((SV*)hv); 
 }
 
 I32
@@ -361,6 +493,9 @@ hv_iterinit(hv)
 HV *hv;
 {
     register XPVHV* xhv = (XPVHV*)SvANY(hv);
+    HE *entry = xhv->xhv_eiter;
+    if (entry && entry->hent_klen < 0) /* was deleted earlier? */
+       he_free(entry);
     xhv->xhv_riter = -1;
     xhv->xhv_eiter = Null(HE*);
     return xhv->xhv_fill;
@@ -372,25 +507,28 @@ HV *hv;
 {
     register XPVHV* xhv;
     register HE *entry;
+    HE *oldentry;
     MAGIC* mg;
 
     if (!hv)
        croak("Bad associative array");
     xhv = (XPVHV*)SvANY(hv);
-    entry = xhv->xhv_eiter;
+    oldentry = entry = xhv->xhv_eiter;
 
     if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
        SV *key = sv_newmortal();
-        if (entry)
-           sv_setpvn(key, entry->hent_key, entry->hent_klen);
-        else {
-            Newz(504,entry, 1, HE);
-            xhv->xhv_eiter = entry;
-        }
-       magic_nextpack(hv,mg,key);
+       if (entry) {
+           sv_usepvn(key, entry->hent_key, entry->hent_klen);
+           entry->hent_key = 0;
+       }
+       else {
+           xhv->xhv_eiter = entry = new_he();
+           Zero(entry, 1, HE);
+       }
+       magic_nextpack((SV*) hv,mg,key);
         if (SvOK(key)) {
            STRLEN len;
-           entry->hent_key = SvPV(key, len);
+           entry->hent_key = SvPV_force(key, len);
            entry->hent_klen = len;
            SvPOK_off(key);
            SvPVX(key) = 0;
@@ -398,7 +536,7 @@ HV *hv;
         }
        if (entry->hent_val)
            SvREFCNT_dec(entry->hent_val);
-       Safefree(entry);
+       del_he(entry);
        xhv->xhv_eiter = Null(HE*);
        return Null(HE*);
     }
@@ -409,7 +547,7 @@ HV *hv;
        if (entry)
            entry = entry->hent_next;
        if (!entry) {
-           xhv->xhv_riter++;
+           ++xhv->xhv_riter;
            if (xhv->xhv_riter > xhv->xhv_max) {
                xhv->xhv_riter = -1;
                break;
@@ -418,6 +556,9 @@ HV *hv;
        }
     } while (!entry);
 
+    if (oldentry && oldentry->hent_klen < 0)   /* was deleted earlier? */
+       he_free(oldentry);
+
     xhv->xhv_eiter = entry;
     return entry;
 }
@@ -440,19 +581,30 @@ register HE *entry;
        if (mg_find((SV*)hv,'P')) {
            SV* sv = sv_newmortal();
            mg_copy((SV*)hv, sv, entry->hent_key, entry->hent_klen);
-           mg_get(sv);
-           sv_unmagic(sv,'p');
            return sv;
        }
     }
     return entry->hent_val;
 }
 
+SV *
+hv_iternextsv(hv, key, retlen)
+    HV *hv;
+    char **key;
+    I32 *retlen;
+{
+    HE *he;
+    if ( (he = hv_iternext(hv)) == NULL)
+       return NULL;
+    *key = hv_iterkey(he, retlen);
+    return hv_iterval(hv, he);
+}
+
 void
 hv_magic(hv, gv, how)
 HV* hv;
 GV* gv;
-I32 how;
+int how;
 {
-    sv_magic((SV*)hv, (SV*)gv, how, 0, 0);
+    sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
 }