Move placeholders into a new rhash magic type.

p4raw-id: //depot/perl@24525

diff --git a/dump.c b/dump.c
index 1b565b3..f3d6657 100644 (file)
--- a/dump.c
+++ b/dump.c
@@ -890,6 +890,7 @@ Perl_gv_dump(pTHX_ GV *gv)
 static const struct { const char type; const char *name; } magic_names[] = {
        { PERL_MAGIC_sv,             "sv(\\0)" },
        { PERL_MAGIC_arylen,         "arylen(#)" },
+       { PERL_MAGIC_rhash,          "rhash(%)" },
        { PERL_MAGIC_glob,           "glob(*)" },
        { PERL_MAGIC_pos,            "pos(.)" },
        { PERL_MAGIC_symtab,         "symtab(:)" },

diff --git a/embed.fnc b/embed.fnc
index c774a42..11c362e 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1397,6 +1397,11 @@ sM       |HE*    |hv_fetch_common|HV* tb|SV* key_sv|const char* key|STRLEN klen|int flags
 Apd    |void   |hv_clear_placeholders|HV* hb
 
 Apd    |SV*    |hv_scalar      |HV* hv|
+
+Apo    |I32*   |hv_placeholders_p      |HV* hv
+Apo    |I32    |hv_placeholders_get    |HV* hv
+Apo    |void   |hv_placeholders_set    |HV* hv|I32 ph
+
 p      |SV*    |magic_scalarpack|HV* hv|MAGIC* mg
 #ifdef PERL_IN_SV_C
 sMd    |SV*    |find_uninit_var|OP* obase|SV* uninit_sv|bool top

diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index 87f94e1..68d8e26 100644 (file)
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -107,6 +107,10 @@ typedef double NV;                 /* Older perls lack the NV type */
 #define dVAR dNOOP
 #endif
 
+#ifndef HvPLACEHOLDERS_get
+#  define HvPLACEHOLDERS_get HvPLACEHOLDERS
+#endif
+
 #ifdef DEBUGME
 
 #ifndef DASSERT
@@ -2303,7 +2307,7 @@ static int store_hash(pTHX_ stcxt_t *cxt, HV *hv)
 
                for (i = 0; i < len; i++) {
 #ifdef HAS_RESTRICTED_HASHES
-                       int placeholders = (int)HvPLACEHOLDERS(hv);
+                       int placeholders = (int)HvPLACEHOLDERS_get(hv);
 #endif
                         unsigned char flags = 0;
                        char *keyval;

diff --git a/global.sym b/global.sym
index d1cfb99..c982795 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -675,6 +675,9 @@ Perl_save_set_svflags
 Perl_hv_assert
 Perl_hv_clear_placeholders
 Perl_hv_scalar
+Perl_hv_placeholders_p
+Perl_hv_placeholders_get
+Perl_hv_placeholders_set
 Perl_gv_fetchpvn_flags
 Perl_gv_fetchsv
 Perl_savesvpv

diff --git a/hv.c b/hv.c
index 3f100e6..c12d20e 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -680,11 +680,11 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                    }
                    /* LVAL fetch which actaully needs a store.  */
                    val = NEWSV(61,0);
-                   xhv->xhv_placeholders--;
+                   HvPLACEHOLDERS(hv)--;
                } else {
                    /* store */
                    if (val != &PL_sv_placeholder)
-                       xhv->xhv_placeholders--;
+                       HvPLACEHOLDERS(hv)--;
                }
                HeVAL(entry) = val;
            } else if (action & HV_FETCH_ISSTORE) {
@@ -764,7 +764,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     *oentry = entry;
 
     if (val == &PL_sv_placeholder)
-       xhv->xhv_placeholders++;
+       HvPLACEHOLDERS(hv)++;
     if (masked_flags & HVhek_ENABLEHVKFLAGS)
        HvHASKFLAGS_on(hv);
 
@@ -1022,7 +1022,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
            HeVAL(entry) = &PL_sv_placeholder;
            /* We'll be saving this slot, so the number of allocated keys
             * doesn't go down, but the number placeholders goes up */
-           xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
+           HvPLACEHOLDERS(hv)++;
        } else {
            *oentry = HeNEXT(entry);
            if (i && !*oentry)
@@ -1466,7 +1466,7 @@ Perl_hv_clear(pTHX_ HV *hv)
                    }
                    SvREFCNT_dec(HeVAL(entry));
                    HeVAL(entry) = &PL_sv_placeholder;
-                   xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
+                   HvPLACEHOLDERS(hv)++;
                }
            }
        }
@@ -1474,7 +1474,7 @@ Perl_hv_clear(pTHX_ HV *hv)
     }
 
     hfreeentries(hv);
-    xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
+    HvPLACEHOLDERS_set(hv, 0);
     if (xhv->xhv_array /* HvARRAY(hv) */)
        (void)memzero(xhv->xhv_array /* HvARRAY(hv) */,
                      (xhv->xhv_max+1 /* HvMAX(hv)+1 */) * sizeof(HE*));
@@ -1615,7 +1615,7 @@ Perl_hv_undef(pTHX_ HV *hv)
     }
     xhv->xhv_max   = 7;        /* HvMAX(hv) = 7 (it's a normal hash) */
     xhv->xhv_array = 0;        /* HvARRAY(hv) = 0 */
-    xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
+    HvPLACEHOLDERS_set(hv, 0);
 
     if (SvRMAGICAL(hv))
        mg_clear((SV*)hv);
@@ -2126,6 +2126,46 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
     return HeKEY_hek(entry);
 }
 
+I32 *
+Perl_hv_placeholders_p(pTHX_ HV *hv)
+{
+    dVAR;
+    MAGIC *mg = mg_find((SV*)hv, PERL_MAGIC_rhash);
+
+    if (!mg) {
+       mg = sv_magicext((SV*)hv, 0, PERL_MAGIC_rhash, 0, 0, 0);
+
+       if (!mg) {
+           Perl_die(aTHX_ "panic: hv_placeholders_p");
+       }
+    }
+    return &(mg->mg_len);
+}
+
+
+I32
+Perl_hv_placeholders_get(pTHX_ HV *hv)
+{
+    dVAR;
+    MAGIC *mg = mg_find((SV*)hv, PERL_MAGIC_rhash);
+
+    return mg ? mg->mg_len : 0;
+}
+
+void
+Perl_hv_placeholders_set(pTHX_ HV *hv, IV ph)
+{
+    dVAR;
+    MAGIC *mg = mg_find((SV*)hv, PERL_MAGIC_rhash);
+
+    if (mg) {
+       mg->mg_len = ph;
+    } else if (ph) {
+       if (!sv_magicext((SV*)hv, 0, PERL_MAGIC_rhash, 0, 0, ph))
+           Perl_die(aTHX_ "panic: hv_placeholders_set");
+    }
+    /* else we don't need to add magic to record 0 placeholders.  */
+}
 
 /*
 =for apidoc hv_assert

diff --git a/hv.h b/hv.h
index 7a6009b..da3e0e6 100644 (file)
--- a/hv.h
+++ b/hv.h
@@ -37,7 +37,6 @@ struct xpvhv {
     STRLEN     xhv_max;        /* subscript of last element of xhv_array */
     IV         xhv_keys;       /* how many elements in the array */
     NV         xnv_nv;         /* numeric value, if any */
-#define xhv_placeholders xnv_nv
     MAGIC*     xmg_magic;      /* magic for scalar array */
     HV*                xmg_stash;      /* class package */
 
@@ -186,21 +185,17 @@ C<SV*>.
 /* the number of keys (including any placeholers) */
 #define XHvTOTALKEYS(xhv)      ((xhv)->xhv_keys)
 
-/* The number of placeholders in the enumerated-keys hash */
-#define XHvPLACEHOLDERS(xhv)   ((xhv)->xhv_placeholders)
-
-/* the number of keys that exist() (i.e. excluding placeholders) */
-#define XHvUSEDKEYS(xhv)      (XHvTOTALKEYS(xhv) - (IV)XHvPLACEHOLDERS(xhv))
-
 /*
  * HvKEYS gets the number of keys that actually exist(), and is provided
  * for backwards compatibility with old XS code. The core uses HvUSEDKEYS
  * (keys, excluding placeholdes) and HvTOTALKEYS (including placeholders)
  */
-#define HvKEYS(hv)             XHvUSEDKEYS((XPVHV*)  SvANY(hv))
-#define HvUSEDKEYS(hv)         XHvUSEDKEYS((XPVHV*)  SvANY(hv))
+#define HvKEYS(hv)             HvUSEDKEYS(hv)
+#define HvUSEDKEYS(hv)         (HvTOTALKEYS(hv) - HvPLACEHOLDERS_get(hv))
 #define HvTOTALKEYS(hv)                XHvTOTALKEYS((XPVHV*)  SvANY(hv))
-#define HvPLACEHOLDERS(hv)     XHvPLACEHOLDERS((XPVHV*)  SvANY(hv))
+#define HvPLACEHOLDERS(hv)     (*Perl_hv_placeholders_p(aTHX_ (HV*)hv))
+#define HvPLACEHOLDERS_get(hv) (SvMAGIC(hv) ? Perl_hv_placeholders_get(aTHX_ (HV*)hv) : 0)
+#define HvPLACEHOLDERS_set(hv,p)       Perl_hv_placeholders_set(aTHX_ (HV*)hv, p)
 
 #define HvSHAREKEYS(hv)                (SvFLAGS(hv) & SVphv_SHAREKEYS)
 #define HvSHAREKEYS_on(hv)     (SvFLAGS(hv) |= SVphv_SHAREKEYS)

diff --git a/perl.h b/perl.h
index d8d3878..22b6af5 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -3170,6 +3170,7 @@ Gid_t getegid (void);
 #define PERL_MAGIC_pos           '.' /* pos() lvalue */
 #define PERL_MAGIC_backref       '<' /* for weak ref data */
 #define PERL_MAGIC_symtab        ':' /* extra data for symbol tables */
+#define PERL_MAGIC_rhash         '%' /* extra data for restricted hashes */
 #define PERL_MAGIC_ext           '~' /* Available for use by extensions */
 
 

diff --git a/proto.h b/proto.h
index 159ecf4..8f8ab0a 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -2311,6 +2311,11 @@ STATIC HE*       S_hv_fetch_common(pTHX_ HV* tb, SV* key_sv, const char* key, STRLEN k
 PERL_CALLCONV void     Perl_hv_clear_placeholders(pTHX_ HV* hb);
 
 PERL_CALLCONV SV*      Perl_hv_scalar(pTHX_ HV* hv);
+
+PERL_CALLCONV I32*     Perl_hv_placeholders_p(pTHX_ HV* hv);
+PERL_CALLCONV I32      Perl_hv_placeholders_get(pTHX_ HV* hv);
+PERL_CALLCONV void     Perl_hv_placeholders_set(pTHX_ HV* hv, I32 ph);
+
 PERL_CALLCONV SV*      Perl_magic_scalarpack(pTHX_ HV* hv, MAGIC*      mg);
 #ifdef PERL_IN_SV_C
 STATIC SV*     S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool top);

diff --git a/sv.c b/sv.c
index af471fb..49e02f2 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -1976,7 +1976,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, U32 mt)
        HvFILL(sv)      = 0;
        HvMAX(sv)       = 0;
        HvTOTALKEYS(sv) = 0;
-       HvPLACEHOLDERS(sv) = 0;
 
        /* Fall through...  */
        if (0) {