From: Marcus Holland-Moritz Date: Sun, 20 Jul 2003 22:36:02 +0000 (+0200) Subject: Re: [PATCH] Re: Storing &PL_sv_undef as a hash key with perl-5.8.x X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=7996736c5ecb6da6273386229ce113837049152c;p=p5sagit%2Fp5-mst-13.2.git Re: [PATCH] Re: Storing &PL_sv_undef as a hash key with perl-5.8.x From: "Marcus Holland-Moritz" Message-ID: <006801c34efe$8aac1920$0c2f1fac@R2D2> p4raw-id: //depot/perl@20224 --- diff --git a/dump.c b/dump.c index d6b6558..52a43a9 100644 --- a/dump.c +++ b/dump.c @@ -160,7 +160,7 @@ Perl_sv_peek(pTHX_ SV *sv) sv_catpv(t, "WILD"); goto finish; } - else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes) { + else if (sv == &PL_sv_undef || sv == &PL_sv_no || sv == &PL_sv_yes || sv == &PL_sv_placeholder) { if (sv == &PL_sv_undef) { sv_catpv(t, "SV_UNDEF"); if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT| @@ -178,7 +178,7 @@ Perl_sv_peek(pTHX_ SV *sv) SvNVX(sv) == 0.0) goto finish; } - else { + else if (sv == &PL_sv_yes) { sv_catpv(t, "SV_YES"); if (!(SvFLAGS(sv) & (SVf_ROK|SVf_OOK|SVs_OBJECT| SVs_GMG|SVs_SMG|SVs_RMG)) && @@ -189,6 +189,13 @@ Perl_sv_peek(pTHX_ SV *sv) SvNVX(sv) == 1.0) goto finish; } + else { + sv_catpv(t, "SV_PLACEHOLDER"); + if (!(SvFLAGS(sv) & (SVf_OK|SVf_OOK|SVs_OBJECT| + SVs_GMG|SVs_SMG|SVs_RMG)) && + SvREADONLY(sv)) + goto finish; + } sv_catpv(t, ":"); } else if (SvREFCNT(sv) == 0) { diff --git a/embedvar.h b/embedvar.h index 98d8b21..2fe4840 100644 --- a/embedvar.h +++ b/embedvar.h @@ -396,6 +396,7 @@ #define PL_sv_count (vTHX->Isv_count) #define PL_sv_no (vTHX->Isv_no) #define PL_sv_objcount (vTHX->Isv_objcount) +#define PL_sv_placeholder (vTHX->Isv_placeholder) #define PL_sv_root (vTHX->Isv_root) #define PL_sv_undef (vTHX->Isv_undef) #define PL_sv_yes (vTHX->Isv_yes) @@ -700,6 +701,7 @@ #define PL_Isv_count PL_sv_count #define PL_Isv_no PL_sv_no #define PL_Isv_objcount PL_sv_objcount +#define PL_Isv_placeholder PL_sv_placeholder #define PL_Isv_root PL_sv_root #define PL_Isv_undef PL_sv_undef #define PL_Isv_yes PL_sv_yes diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs index 19470cb..055aefc 100644 --- a/ext/Storable/Storable.xs +++ b/ext/Storable/Storable.xs @@ -1237,13 +1237,13 @@ static void clean_store_context(stcxt_t *cxt) if (cxt->hseen) { hv_iterinit(cxt->hseen); while ((he = hv_iternext(cxt->hseen))) /* Extra () for -Wall, grr.. */ - HeVAL(he) = &PL_sv_undef; + HeVAL(he) = &PL_sv_placeholder; } if (cxt->hclass) { hv_iterinit(cxt->hclass); while ((he = hv_iternext(cxt->hclass))) /* Extra () for -Wall, grr.. */ - HeVAL(he) = &PL_sv_undef; + HeVAL(he) = &PL_sv_placeholder; } /* @@ -2208,7 +2208,11 @@ static int store_hash(stcxt_t *cxt, HV *hv) = (((hash_flags & SHV_RESTRICTED) && SvREADONLY(val)) ? SHV_K_LOCKED : 0); +#ifdef PL_sv_placeholder + if (val == &PL_sv_placeholder) +#else if (val == &PL_sv_undef) +#endif flags |= SHV_K_PLACEHOLDER; keyval = SvPV(key, keylen_tmp); @@ -2304,7 +2308,11 @@ static int store_hash(stcxt_t *cxt, HV *hv) = (((hash_flags & SHV_RESTRICTED) && SvREADONLY(val)) ? SHV_K_LOCKED : 0); +#ifdef PL_sv_placeholder + if (val == &PL_sv_placeholder) +#else if (val == &PL_sv_undef) +#endif flags |= SHV_K_PLACEHOLDER; hek = HeKEY_hek(he); @@ -4896,7 +4904,7 @@ static SV *retrieve_flag_hash(stcxt_t *cxt, char *cname) if (flags & SHV_K_PLACEHOLDER) { SvREFCNT_dec (sv); - sv = &PL_sv_undef; + sv = &PL_sv_placeholder; store_flags |= HVhek_PLACEHOLD; } if (flags & SHV_K_UTF8) { diff --git a/hv.c b/hv.c index 0bbebc6..78082d0 100644 --- a/hv.c +++ b/hv.c @@ -312,7 +312,7 @@ S_hv_fetch_flags(pTHX_ HV *hv, const char *key, I32 klen, I32 lval, int flags) if (flags & HVhek_FREEKEY) Safefree(key); /* if we find a placeholder, we pretend we haven't found anything */ - if (HeVAL(entry) == &PL_sv_undef) + if (HeVAL(entry) == &PL_sv_placeholder) break; return &HeVAL(entry); @@ -482,7 +482,7 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash) if (key != keysave) Safefree(key); /* if we find a placeholder, we pretend we haven't found anything */ - if (HeVAL(entry) == &PL_sv_undef) + if (HeVAL(entry) == &PL_sv_placeholder) break; return entry; } @@ -645,7 +645,7 @@ Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, continue; if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8) continue; - if (HeVAL(entry) == &PL_sv_undef) + if (HeVAL(entry) == &PL_sv_placeholder) xhv->xhv_placeholders--; /* yes, can store into placeholder slot */ else SvREFCNT_dec(HeVAL(entry)); @@ -653,7 +653,7 @@ Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, /* We have been requested to insert a placeholder. Currently only Storable is allowed to do this. */ xhv->xhv_placeholders++; - HeVAL(entry) = &PL_sv_undef; + HeVAL(entry) = &PL_sv_placeholder; } else HeVAL(entry) = val; @@ -696,7 +696,7 @@ Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, /* We have been requested to insert a placeholder. Currently only Storable is allowed to do this. */ xhv->xhv_placeholders++; - HeVAL(entry) = &PL_sv_undef; + HeVAL(entry) = &PL_sv_placeholder; } else HeVAL(entry) = val; HeNEXT(entry) = *oentry; @@ -820,7 +820,7 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash) continue; if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8) continue; - if (HeVAL(entry) == &PL_sv_undef) + if (HeVAL(entry) == &PL_sv_placeholder) xhv->xhv_placeholders--; /* yes, can store into placeholder slot */ else SvREFCNT_dec(HeVAL(entry)); @@ -964,7 +964,7 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags) if (k_flags & HVhek_FREEKEY) Safefree(key); /* if placeholder is here, it's already been deleted.... */ - if (HeVAL(entry) == &PL_sv_undef) + if (HeVAL(entry) == &PL_sv_placeholder) { if (SvREADONLY(hv)) return Nullsv; /* if still SvREADONLY, leave it deleted. */ @@ -994,7 +994,7 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags) sv = Nullsv; else { sv = sv_2mortal(HeVAL(entry)); - HeVAL(entry) = &PL_sv_undef; + HeVAL(entry) = &PL_sv_placeholder; } /* @@ -1004,7 +1004,7 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags) * an error. */ if (SvREADONLY(hv)) { - HeVAL(entry) = &PL_sv_undef; + 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)++ */ @@ -1123,7 +1123,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) Safefree(key); /* if placeholder is here, it's already been deleted.... */ - if (HeVAL(entry) == &PL_sv_undef) + if (HeVAL(entry) == &PL_sv_placeholder) { if (SvREADONLY(hv)) return Nullsv; /* if still SvREADONLY, leave it deleted. */ @@ -1152,7 +1152,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) sv = Nullsv; else { sv = sv_2mortal(HeVAL(entry)); - HeVAL(entry) = &PL_sv_undef; + HeVAL(entry) = &PL_sv_placeholder; } /* @@ -1162,7 +1162,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) * an error. */ if (SvREADONLY(hv)) { - HeVAL(entry) = &PL_sv_undef; + 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)++ */ @@ -1271,7 +1271,7 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen) if (k_flags & HVhek_FREEKEY) Safefree(key); /* If we find the key, but the value is a placeholder, return false. */ - if (HeVAL(entry) == &PL_sv_undef) + if (HeVAL(entry) == &PL_sv_placeholder) return FALSE; return TRUE; @@ -1376,7 +1376,7 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash) if (k_flags & HVhek_FREEKEY) Safefree(key); /* If we find the key, but the value is a placeholder, return false. */ - if (HeVAL(entry) == &PL_sv_undef) + if (HeVAL(entry) == &PL_sv_placeholder) return FALSE; return TRUE; } @@ -1713,7 +1713,7 @@ Perl_hv_clear(pTHX_ HV *hv) entry = ((HE**)xhv->xhv_array)[i]; for (; entry; entry = HeNEXT(entry)) { /* not already placeholder */ - if (HeVAL(entry) != &PL_sv_undef) { + if (HeVAL(entry) != &PL_sv_placeholder) { if (HeVAL(entry) && SvREADONLY(HeVAL(entry))) { SV* keysv = hv_iterkeysv(entry); Perl_croak(aTHX_ @@ -1721,7 +1721,7 @@ Perl_hv_clear(pTHX_ HV *hv) keysv); } SvREFCNT_dec(HeVAL(entry)); - HeVAL(entry) = &PL_sv_undef; + HeVAL(entry) = &PL_sv_placeholder; xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */ } } @@ -1875,9 +1875,8 @@ Returns entries from a hash iterator. See C and C. The C value will normally be zero; if HV_ITERNEXT_WANTPLACEHOLDERS is set the placeholders keys (for restricted hashes) will be returned in addition to normal keys. By default placeholders are automatically skipped over. -Currently a placeholder is implemented with a value that is literally -<&Perl_sv_undef> (a regular C value is a normal read-write SV for which -C is false). Note that the implementation of placeholders and +Currently a placeholder is implemented with a value that is +C<&Perl_sv_placeholder>. Note that the implementation of placeholders and restricted hashes may change, and the implementation currently is insufficiently abstracted for any change to be tidy. @@ -1946,7 +1945,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) * Skip past any placeholders -- don't want to include them in * any iteration. */ - while (entry && HeVAL(entry) == &PL_sv_undef) { + while (entry && HeVAL(entry) == &PL_sv_placeholder) { entry = HeNEXT(entry); } } @@ -1966,7 +1965,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) { /* If we have an entry, but it's a placeholder, don't count it. Try the next. */ - while (entry && HeVAL(entry) == &PL_sv_undef) + while (entry && HeVAL(entry) == &PL_sv_placeholder) entry = HeNEXT(entry); } /* Will loop again if this linked list starts NULL diff --git a/intrpvar.h b/intrpvar.h index 6a34ea4..dbb9a12 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -531,6 +531,9 @@ PERLVAR(IDBassertion, SV *) PERLVARI(Icv_has_eval, I32, 0) /* PL_compcv includes an entereval or similar */ +/* Restricted hashes placeholder value */ +PERLVAR(Isv_placeholder, SV) + /* New variables must be added to the very end, before this comment, * for binary compatibility (the offsets of the old members must not change). * (Don't forget to add your variable also to perl_clone()!) diff --git a/perl.c b/perl.c index 0968e26..eb86c72 100644 --- a/perl.c +++ b/perl.c @@ -181,6 +181,9 @@ perl_construct(pTHXx) SvNV(&PL_sv_yes); SvREADONLY_on(&PL_sv_yes); SvREFCNT(&PL_sv_yes) = (~(U32)0)/2; + + SvREADONLY_on(&PL_sv_placeholder); + SvREFCNT(&PL_sv_placeholder) = (~(U32)0)/2; } PL_sighandlerp = Perl_sighandler; @@ -783,6 +786,9 @@ perl_destruct(pTHXx) SvREFCNT(&PL_sv_undef) = 0; SvREADONLY_off(&PL_sv_undef); + SvREFCNT(&PL_sv_placeholder) = 0; + SvREADONLY_off(&PL_sv_placeholder); + Safefree(PL_origfilename); Safefree(PL_reg_start_tmp); if (PL_reg_curpm) diff --git a/perlapi.h b/perlapi.h index 524e84b..9af1ede 100644 --- a/perlapi.h +++ b/perlapi.h @@ -550,6 +550,8 @@ END_EXTERN_C #define PL_sv_no (*Perl_Isv_no_ptr(aTHX)) #undef PL_sv_objcount #define PL_sv_objcount (*Perl_Isv_objcount_ptr(aTHX)) +#undef PL_sv_placeholder +#define PL_sv_placeholder (*Perl_Isv_placeholder_ptr(aTHX)) #undef PL_sv_root #define PL_sv_root (*Perl_Isv_root_ptr(aTHX)) #undef PL_sv_undef diff --git a/sv.c b/sv.c index c31ada7..45d09d0 100644 --- a/sv.c +++ b/sv.c @@ -10913,6 +10913,11 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, SvNVX(&PL_sv_yes) = 1; ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes); + SvANY(&PL_sv_placeholder) = NULL; + SvREFCNT(&PL_sv_placeholder)= (~(U32)0)/2; + SvFLAGS(&PL_sv_placeholder) = SVf_READONLY|SVt_NULL; + ptr_table_store(PL_ptr_table, &proto_perl->Isv_placeholder, &PL_sv_placeholder); + /* create (a non-shared!) shared string table */ PL_strtab = newHV(); HvSHAREKEYS_off(PL_strtab); diff --git a/universal.c b/universal.c index 9ee3e21..6ba5a13 100644 --- a/universal.c +++ b/universal.c @@ -755,7 +755,7 @@ XS(XS_Internals_hv_clear_placehold) && items) { SV *val = hv_iterval(hv, entry); - if (val == &PL_sv_undef) { + if (val == &PL_sv_placeholder) { /* It seems that I have to go back in the front of the hash API to delete a hash, even though I have a HE structure