added patch for overloading constants, made PERL_OBJECT-aware

[p5sagit/p5-mst-13.2.git] / hv.c

diff --git a/hv.c b/hv.c
index 5756b4b..3966b1f 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -14,12 +14,14 @@
 #include "EXTERN.h"
 #include "perl.h"
 
+static void hv_magic_check _((HV *hv, bool *needs_copy, bool *needs_store));
+#ifndef PERL_OBJECT
 static void hsplit _((HV *hv));
 static void hfreeentries _((HV *hv));
-static void hv_magic_check _((HV *hv, bool *needs_copy, bool *needs_store));
 static HE* more_he _((void));
+#endif
 
-static HE*
+STATIC HE*
 new_he(void)
 {
     HE* he;
@@ -31,14 +33,14 @@ new_he(void)
     return more_he();
 }
 
-static void
+STATIC void
 del_he(HE *p)
 {
     HeNEXT(p) = (HE*)he_root;
     he_root = p;
 }
 
-static HE*
+STATIC HE*
 more_he(void)
 {
     register HE* he;
@@ -54,7 +56,7 @@ more_he(void)
     return new_he();
 }
 
-static HEK *
+STATIC HEK *
 save_hek(char *str, I32 len, U32 hash)
 {
     char *k;
@@ -140,7 +142,7 @@ hv_fetch(HV *hv, char *key, U32 klen, I32 lval)
     if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
       char *gotenv;
 
-      if ((gotenv = ENV_getenv(key)) != Nullch) {
+      if ((gotenv = PerlEnv_getenv(key)) != Nullch) {
         sv = newSVpv(gotenv,strlen(gotenv));
         SvTAINTED_on(sv);
         return hv_store(hv,key,klen,sv,hash);
@@ -231,7 +233,7 @@ hv_fetch_ent(HV *hv, SV *keysv, I32 lval, register U32 hash)
     if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
       char *gotenv;
 
-      if ((gotenv = ENV_getenv(key)) != Nullch) {
+      if ((gotenv = PerlEnv_getenv(key)) != Nullch) {
         sv = newSVpv(gotenv,strlen(gotenv));
         SvTAINTED_on(sv);
         return hv_store_ent(hv,keysv,sv,hash);
@@ -656,14 +658,14 @@ hv_exists_ent(HV *hv, SV *keysv, U32 hash)
     return FALSE;
 }
 
-static void
+STATIC void
 hsplit(HV *hv)
 {
     register XPVHV* xhv = (XPVHV*)SvANY(hv);
     I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
     register I32 newsize = oldsize * 2;
     register I32 i;
-    register HE **a;
+    register HE **a = (HE**)xhv->xhv_array;
     register HE **b;
     register HE *entry;
     register HE **oentry;
@@ -671,9 +673,8 @@ hsplit(HV *hv)
     I32 tmp;
 #endif
 
-    a = (HE**)xhv->xhv_array;
     nomemok = TRUE;
-#ifdef STRANGE_MALLOC
+#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
     Renew(a, newsize, HE*);
     if (!a) {
       nomemok = FALSE;
@@ -754,7 +755,7 @@ hv_ksplit(HV *hv, IV newmax)
     a = (HE**)xhv->xhv_array;
     if (a) {
        nomemok = TRUE;
-#ifdef STRANGE_MALLOC
+#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
        Renew(a, newsize, HE*);
         if (!a) {
          nomemok = FALSE;
@@ -833,6 +834,45 @@ newHV(void)
     return hv;
 }
 
+HV *
+newHVhv(HV *ohv)
+{
+    register HV *hv;
+    register XPVHV* xhv;
+    STRLEN hv_max = ohv ? HvMAX(ohv) : 0;
+    STRLEN hv_fill = ohv ? HvFILL(ohv) : 0;
+
+    hv = newHV();
+    while (hv_max && hv_max + 1 >= hv_fill * 2)
+       hv_max = hv_max / 2;    /* Is always 2^n-1 */
+    ((XPVHV*)SvANY(hv))->xhv_max = hv_max;
+    if (!hv_fill)
+       return hv;
+
+#if 0
+    if (!SvRMAGICAL(ohv) || !mg_find((SV*)ohv,'P')) {
+       /* Quick way ???*/
+    } 
+    else 
+#endif
+    {
+       HE *entry;
+       I32 hv_riter = HvRITER(ohv);    /* current root of iterator */
+       HE *hv_eiter = HvEITER(ohv);    /* current entry of iterator */
+       
+       /* Slow way */
+       hv_iterinit(hv);
+       while (entry = hv_iternext(ohv)) {
+           hv_store(hv, HeKEY(entry), HeKLEN(entry), 
+                    SvREFCNT_inc(HeVAL(entry)), HeHASH(entry));
+       }
+       HvRITER(ohv) = hv_riter;
+       HvEITER(ohv) = hv_eiter;
+    }
+    
+    return hv;
+}
+
 void
 hv_free_ent(HV *hv, register HE *entry)
 {
@@ -891,7 +931,7 @@ hv_clear(HV *hv)
        mg_clear((SV*)hv); 
 }
 
-static void
+STATIC void
 hfreeentries(HV *hv)
 {
     register HE **array;