X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=hv.c;h=95df7c8fb4e2638a1d56dcfda30abcf2cb8ae3f3;hb=869efde7048cf4e4bafcc463f8d4209a63e0d41a;hp=1b8f74c6afc2a77d9f2165941fe162fac78fb0cd;hpb=4c2df08ca7dcec8d9dadbf994c085e23d96957a3;p=p5sagit%2Fp5-mst-13.2.git diff --git a/hv.c b/hv.c index 1b8f74c..95df7c8 100644 --- a/hv.c +++ b/hv.c @@ -236,39 +236,6 @@ hv_store_ent. See L for more information on how to use this function on tied hashes. -=cut -*/ - -SV** -Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash) -{ - HE *hek; - STRLEN klen; - int flags; - - if (klen_i32 < 0) { - klen = -klen_i32; - flags = HVhek_UTF8; - } else { - klen = klen_i32; - flags = 0; - } - hek = hv_common(hv, NULL, key, klen, flags, - (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash); - return hek ? &HeVAL(hek) : NULL; -} - -/* Tricky to inlike this because it needs a temporary variable */ -SV** -Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, - register U32 hash, int flags) -{ - HE * const hek = hv_common(hv, NULL, key, klen, flags, - (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash); - return hek ? &HeVAL(hek) : NULL; -} - -/* =for apidoc hv_store_ent Stores C in a hash. The hash key is specified as C. The C @@ -294,36 +261,11 @@ hv_store in preference to hv_store_ent. See L for more information on how to use this function on tied hashes. -=cut -*/ - -/* =for apidoc hv_exists Returns a boolean indicating whether the specified hash key exists. The C is the length of the key. -=cut -*/ - -bool -Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32) -{ - STRLEN klen; - int flags; - - if (klen_i32 < 0) { - klen = -klen_i32; - flags = HVhek_UTF8; - } else { - klen = klen_i32; - flags = 0; - } - return hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0) - ? TRUE : FALSE; -} - -/* =for apidoc hv_fetch Returns the SV which corresponds to the specified key in the hash. The @@ -334,30 +276,6 @@ dereferencing it to an C. See L for more information on how to use this function on tied hashes. -=cut -*/ - -SV** -Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval) -{ - HE *hek; - STRLEN klen; - int flags; - - if (klen_i32 < 0) { - klen = -klen_i32; - flags = HVhek_UTF8; - } else { - klen = klen_i32; - flags = 0; - } - hek = hv_common(hv, NULL, key, klen, flags, lval - ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) : HV_FETCH_JUST_SV, - NULL, 0); - return hek ? &HeVAL(hek) : NULL; -} - -/* =for apidoc hv_exists_ent Returns a boolean indicating whether the specified hash key exists. C @@ -386,7 +304,25 @@ information on how to use this function on tied hashes. =cut */ -HE * +/* Common code for hv_delete()/hv_exists()/hv_fetch()/hv_store() */ +void * +Perl_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 klen_i32, + const int action, SV *val, const U32 hash) +{ + STRLEN klen; + int flags; + + if (klen_i32 < 0) { + klen = -klen_i32; + flags = HVhek_UTF8; + } else { + klen = klen_i32; + flags = 0; + } + return hv_common(hv, NULL, key, klen, flags, action, val, hash); +} + +void * Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, int flags, int action, SV *val, register U32 hash) { @@ -397,6 +333,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, SV *sv; bool is_utf8; int masked_flags; + const int return_svp = action & HV_FETCH_JUST_SV; if (!hv) return NULL; @@ -441,9 +378,9 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } if (action & HV_DELETE) { - return (HE *) hv_delete_common(hv, keysv, key, klen, - flags | (is_utf8 ? HVhek_UTF8 : 0), - action, hash); + return (void *) hv_delete_common(hv, keysv, key, klen, + flags | (is_utf8 ? HVhek_UTF8 : 0), + action, hash); } xhv = (XPVHV*)SvANY(hv); @@ -451,7 +388,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS))) { if ( mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) { - /* XXX should be able to skimp on the HE/HEK here when + /* FIXME should be able to skimp on the HE/HEK here when HV_FETCH_JUST_SV is true. */ if (!keysv) { keysv = newSVpvn(key, klen); @@ -486,7 +423,10 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (flags & HVhek_FREEKEY) Safefree(key); - return entry; + if (return_svp) { + return entry ? (void *) &HeVAL(entry) : NULL; + } + return (void *) entry; } #ifdef ENV_IS_CASELESS else if (mg_find((SV*)hv, PERL_MAGIC_env)) { @@ -498,26 +438,27 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, const char * const nkey = strupr(savepvn(key,klen)); /* Note that this fetch is for nkey (the uppercased key) whereas the store is for key (the original) */ - entry = hv_common(hv, NULL, nkey, klen, - HVhek_FREEKEY, /* free nkey */ - 0 /* non-LVAL fetch */ - | HV_DISABLE_UVAR_XKEY, - NULL /* no value */, - 0 /* compute hash */); - if (!entry && (action & HV_FETCH_LVALUE)) { + void *result = hv_common(hv, NULL, nkey, klen, + HVhek_FREEKEY, /* free nkey */ + 0 /* non-LVAL fetch */ + | HV_DISABLE_UVAR_XKEY + | return_svp, + NULL /* no value */, + 0 /* compute hash */); + if (!result && (action & HV_FETCH_LVALUE)) { /* This call will free key if necessary. Do it this way to encourage compiler to tail call optimise. */ - entry = hv_common(hv, keysv, key, klen, - flags, - HV_FETCH_ISSTORE - | HV_DISABLE_UVAR_XKEY, - newSV(0), hash); + result = hv_common(hv, keysv, key, klen, flags, + HV_FETCH_ISSTORE + | HV_DISABLE_UVAR_XKEY + | return_svp, + newSV(0), hash); } else { if (flags & HVhek_FREEKEY) Safefree(key); } - return entry; + return result; } } #endif @@ -546,7 +487,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, /* This cast somewhat evil, but I'm merely using NULL/ not NULL to return the boolean exists. And I know hv is not NULL. */ - return SvTRUE(svret) ? (HE *)hv : NULL; + return SvTRUE(svret) ? (void *)hv : NULL; } #ifdef ENV_IS_CASELESS else if (mg_find((SV*)hv, PERL_MAGIC_env)) { @@ -635,7 +576,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (flags & HVhek_FREEKEY) Safefree(key); - return 0; + return NULL; } } @@ -751,6 +692,9 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } if (flags & HVhek_FREEKEY) Safefree(key); + if (return_svp) { + return entry ? (void *) &HeVAL(entry) : NULL; + } return entry; } #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */ @@ -762,7 +706,8 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, sv = newSVpvn(env,len); SvTAINTED_on(sv); return hv_common(hv, keysv, key, klen, flags, - HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY, sv, hash); + HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY|return_svp, + sv, hash); } } #endif @@ -776,7 +721,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, /* Not doing some form of store, so return failure. */ if (flags & HVhek_FREEKEY) Safefree(key); - return 0; + return NULL; } if (action & HV_FETCH_LVALUE) { val = newSV(0); @@ -792,7 +737,8 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, key, this would result in a double conversion, which would show up as a bug if the conversion routine is not idempotent. */ return hv_common(hv, keysv, key, klen, flags, - HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY, val, hash); + HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY|return_svp, + val, hash); /* XXX Surely that could leak if the fetch-was-store fails? Just like the hv_fetch. */ } @@ -863,7 +809,10 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, } } - return entry; + if (return_svp) { + return entry ? (void *) &HeVAL(entry) : NULL; + } + return (void *) entry; } STATIC void @@ -921,27 +870,6 @@ hash and returned to the caller. The C is the length of the key. The C value will normally be zero; if set to G_DISCARD then NULL will be returned. -=cut -*/ - -SV * -Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags) -{ - STRLEN klen; - int k_flags; - - if (klen_i32 < 0) { - klen = -klen_i32; - k_flags = HVhek_UTF8; - } else { - klen = klen_i32; - k_flags = 0; - } - return (SV *) hv_common(hv, NULL, key, klen, k_flags, flags | HV_DELETE, - NULL, 0); -} - -/* =for apidoc hv_delete_ent Deletes a key/value pair in the hash. The value SV is removed from the @@ -971,9 +899,10 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, if (needs_copy) { SV *sv; - entry = hv_common(hv, keysv, key, klen, k_flags & ~HVhek_FREEKEY, - HV_FETCH_LVALUE|HV_DISABLE_UVAR_XKEY, NULL, - hash); + entry = (HE *) hv_common(hv, keysv, key, klen, + k_flags & ~HVhek_FREEKEY, + HV_FETCH_LVALUE|HV_DISABLE_UVAR_XKEY, + NULL, hash); sv = entry ? HeVAL(entry) : NULL; if (sv) { if (SvMAGICAL(sv)) { @@ -1468,9 +1397,9 @@ Perl_newHVhv(pTHX_ HV *ohv) hv_iterinit(ohv); while ((entry = hv_iternext_flags(ohv, 0))) { - hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), - newSVsv(HeVAL(entry)), HeHASH(entry), - HeKFLAGS(entry)); + (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), + newSVsv(HeVAL(entry)), HeHASH(entry), + HeKFLAGS(entry)); } HvRITER_set(ohv, riter); HvEITER_set(ohv, eiter); @@ -1502,8 +1431,8 @@ Perl_hv_copy_hints_hv(pTHX_ HV *const ohv) SV *const sv = newSVsv(HeVAL(entry)); sv_magic(sv, NULL, PERL_MAGIC_hintselem, (char *)newSVhek (HeKEY_hek(entry)), HEf_SVKEY); - hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), - sv, HeHASH(entry), HeKFLAGS(entry)); + (void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), + sv, HeHASH(entry), HeKFLAGS(entry)); } HvRITER_set(ohv, riter); HvEITER_set(ohv, eiter); @@ -1848,8 +1777,8 @@ Perl_hv_undef(pTHX_ HV *hv) hfreeentries(hv); if (name) { - if(PL_stashcache) - hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD); + if (PL_stashcache) + (void)hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD); hv_name_set(hv, NULL, 0, 0); } SvFLAGS(hv) &= ~SVf_OOK;