X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mathoms.c;h=cccaa92485931814c8991065f008c972d5d31827;hb=f4b3c303600e3a7579627986f784c3ec9367abb3;hp=a8a28e626ebd006478ca3bf0f0d7406571a77d9a;hpb=83029685b27ec04c6417a2eb865ffed0921d39ae;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mathoms.c b/mathoms.c index a8a28e6..cccaa92 100644 --- a/mathoms.c +++ b/mathoms.c @@ -1,6 +1,6 @@ /* mathoms.c * - * Copyright (C) 2005, 2006, by Larry Wall and others + * Copyright (C) 2005, 2006, 2007, 2007, by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -1210,6 +1210,111 @@ Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV ** packlist(cat, pat, patend, beglist, endlist); } + +HE * +Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash) +{ + return (HE *)hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash); +} + +bool +Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash) +{ + return hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash) + ? TRUE : FALSE; +} + +HE * +Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, U32 hash) +{ + return (HE *)hv_common(hv, keysv, NULL, 0, 0, + (lval ? HV_FETCH_LVALUE : 0), NULL, hash); +} + +SV * +Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) +{ + return (SV *) hv_common(hv, keysv, NULL, 0, 0, flags | HV_DELETE, NULL, + hash); +} + +SV** +Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash, + int flags) +{ + return (SV**) hv_common(hv, NULL, key, klen, flags, + (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash); +} + +SV** +Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash) +{ + STRLEN klen; + int flags; + + if (klen_i32 < 0) { + klen = -klen_i32; + flags = HVhek_UTF8; + } else { + klen = klen_i32; + flags = 0; + } + return (SV **) hv_common(hv, NULL, key, klen, flags, + (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash); +} + +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; +} + +SV** +Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval) +{ + STRLEN klen; + int flags; + + if (klen_i32 < 0) { + klen = -klen_i32; + flags = HVhek_UTF8; + } else { + klen = klen_i32; + flags = 0; + } + return (SV **) hv_common(hv, NULL, key, klen, flags, + lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) + : HV_FETCH_JUST_SV, NULL, 0); +} + +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); +} + #endif /* NO_MATHOMS */ /*