Skip to content

Commit

Permalink
Add a new function Perl_hv_common_key_len(), which contains the
Browse files Browse the repository at this point in the history 
manipulations to convert negative lengths to positive length + UTF-8
flag. hv_delete(), hv_exists(), hv_fetch(), hv_store() and
hv_store_flags() all become mathoms. The macros hv_fetchs() and
hv_stores() call hv_common() directly.

p4raw-id: //depot/perl@31931
  • Loading branch information
@nwc10
nwc10 committed Sep 20, 2007
1 parent 3c84c86 commit a038e57
Show file tree
Hide file tree
Showing 8 changed files with 152 additions and 104 deletions.
19 changes: 12 additions & 7 deletions embed.fnc
View file
Expand Up @@ -298,15 +298,20 @@ Apd |HV* |gv_stashsv |NULLOK SV* sv|I32 flags
Apd |void |hv_clear |NULLOK HV* tb
poM |HV * |hv_copy_hints_hv|NN HV *const ohv
Ap |void |hv_delayfree_ent|NN HV* hv|NULLOK HE* entry
Apd |SV* |hv_delete |NULLOK HV* tb|NN const char* key|I32 klen|I32 flags
Abmd |SV* |hv_delete |NULLOK HV* tb|NN const char* key|I32 klen \
|I32 flags
Abmd |SV* |hv_delete_ent |NULLOK HV* tb|NN SV* key|I32 flags|U32 hash
ApdR |bool |hv_exists |NULLOK HV* tb|NN const char* key|I32 klen
AbmdR |bool |hv_exists |NULLOK HV* tb|NN const char* key|I32 klen
AbmdR |bool |hv_exists_ent |NULLOK HV* tb|NN SV* key|U32 hash
Apd |SV** |hv_fetch |NULLOK HV* tb|NN const char* key|I32 klen|I32 lval
Abmd |SV** |hv_fetch |NULLOK HV* tb|NN const char* key|I32 klen \
|I32 lval
Abmd |HE* |hv_fetch_ent |NULLOK HV* tb|NN SV* key|I32 lval|U32 hash
Ap |void* |hv_common |NULLOK HV* tb|NULLOK SV* keysv \
|NULLOK const char* key|STRLEN klen|int flags \
|int action|NULLOK SV* val|U32 hash
Ap |void* |hv_common_key_len|NULLOK HV *hv|NN const char *key \
|I32 klen_i32|const int action|NULLOK SV *val \
|const U32 hash
Ap |void |hv_free_ent |NN HV* hv|NULLOK HE* entryK
Apd |I32 |hv_iterinit |NN HV* tb
ApdR |char* |hv_iterkey |NN HE* entry|NN I32* retlen
Expand All @@ -325,11 +330,11 @@ dpoM |void |refcounted_he_free|NULLOK struct refcounted_he *he
XEdpoM |struct refcounted_he *|refcounted_he_new \
|NULLOK struct refcounted_he *const parent \
|NULLOK SV *const key|NULLOK SV *const value
Apd |SV** |hv_store |NULLOK HV* tb|NULLOK const char* key|I32 klen|NULLOK SV* val \
|U32 hash
Abmd |SV** |hv_store |NULLOK HV* tb|NULLOK const char* key \
|I32 klen|NULLOK SV* val|U32 hash
Abmd |HE* |hv_store_ent |NULLOK HV* tb|NULLOK SV* key|NULLOK SV* val|U32 hash
ApM |SV** |hv_store_flags |NULLOK HV* tb|NULLOK const char* key|I32 klen|NULLOK SV* val \
|U32 hash|int flags
AbmdM |SV** |hv_store_flags |NULLOK HV* tb|NULLOK const char* key \
|I32 klen|NULLOK SV* val|U32 hash|int flags
Apd |void |hv_undef |NULLOK HV* tb
ApP |I32 |ibcmp |NN const char* a|NN const char* b|I32 len
ApP |I32 |ibcmp_locale |NN const char* a|NN const char* b|I32 len
Expand Down
12 changes: 2 additions & 10 deletions embed.h
View file
Expand Up @@ -279,10 +279,8 @@
#define gv_stashsv Perl_gv_stashsv
#define hv_clear Perl_hv_clear
#define hv_delayfree_ent Perl_hv_delayfree_ent
#define hv_delete Perl_hv_delete
#define hv_exists Perl_hv_exists
#define hv_fetch Perl_hv_fetch
#define hv_common Perl_hv_common
#define hv_common_key_len Perl_hv_common_key_len
#define hv_free_ent Perl_hv_free_ent
#define hv_iterinit Perl_hv_iterinit
#define hv_iterkey Perl_hv_iterkey
Expand All @@ -291,8 +289,6 @@
#define hv_iternext_flags Perl_hv_iternext_flags
#define hv_iterval Perl_hv_iterval
#define hv_ksplit Perl_hv_ksplit
#define hv_store Perl_hv_store
#define hv_store_flags Perl_hv_store_flags
#define hv_undef Perl_hv_undef
#define ibcmp Perl_ibcmp
#define ibcmp_locale Perl_ibcmp_locale
Expand Down Expand Up @@ -2560,10 +2556,8 @@
#ifdef PERL_CORE
#endif
#define hv_delayfree_ent(a,b) Perl_hv_delayfree_ent(aTHX_ a,b)
#define hv_delete(a,b,c,d) Perl_hv_delete(aTHX_ a,b,c,d)
#define hv_exists(a,b,c) Perl_hv_exists(aTHX_ a,b,c)
#define hv_fetch(a,b,c,d) Perl_hv_fetch(aTHX_ a,b,c,d)
#define hv_common(a,b,c,d,e,f,g,h) Perl_hv_common(aTHX_ a,b,c,d,e,f,g,h)
#define hv_common_key_len(a,b,c,d,e,f) Perl_hv_common_key_len(aTHX_ a,b,c,d,e,f)
#define hv_free_ent(a,b) Perl_hv_free_ent(aTHX_ a,b)
#define hv_iterinit(a) Perl_hv_iterinit(aTHX_ a)
#define hv_iterkey(a,b) Perl_hv_iterkey(aTHX_ a,b)
Expand All @@ -2578,8 +2572,6 @@
#endif
#if defined(PERL_CORE) || defined(PERL_EXT)
#endif
#define hv_store(a,b,c,d,e) Perl_hv_store(aTHX_ a,b,c,d,e)
#define hv_store_flags(a,b,c,d,e,f) Perl_hv_store_flags(aTHX_ a,b,c,d,e,f)
#define hv_undef(a) Perl_hv_undef(aTHX_ a)
#define ibcmp(a,b,c) Perl_ibcmp(aTHX_ a,b,c)
#define ibcmp_locale(a,b,c) Perl_ibcmp_locale(aTHX_ a,b,c)
Expand Down
1 change: 1 addition & 0 deletions global.sym
View file
Expand Up @@ -157,6 +157,7 @@ Perl_hv_exists_ent
Perl_hv_fetch
Perl_hv_fetch_ent
Perl_hv_common
Perl_hv_common_key_len
Perl_hv_free_ent
Perl_hv_iterinit
Perl_hv_iterkey
Expand Down
10 changes: 8 additions & 2 deletions handy.h
View file
Expand Up @@ -290,8 +290,14 @@ and omits the hash parameter.
#define savepvs(str) Perl_savepvn(aTHX_ STR_WITH_LEN(str))
#define gv_stashpvs(str, create) Perl_gv_stashpvn(aTHX_ STR_WITH_LEN(str), create)
#define gv_fetchpvs(namebeg, add, sv_type) Perl_gv_fetchpvn_flags(aTHX_ STR_WITH_LEN(namebeg), add, sv_type)
#define hv_fetchs(hv,key,lval) Perl_hv_fetch(aTHX_ hv, STR_WITH_LEN(key), lval)
#define hv_stores(hv,key,val) Perl_hv_store(aTHX_ hv, STR_WITH_LEN(key), val, 0)
#define hv_fetchs(hv,key,lval) \
((SV **)Perl_hv_common(aTHX_ (hv), NULL, STR_WITH_LEN(key), 0, \
(lval) ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \
: HV_FETCH_JUST_SV, NULL, 0))

#define hv_stores(hv,key,val) \
((SV **)Perl_hv_common(aTHX_ (hv), NULL, STR_WITH_LEN(key), 0, \
(HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), (val), 0))


/*
Expand Down
95 changes: 18 additions & 77 deletions hv.c
View file
Expand Up @@ -239,31 +239,6 @@ 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)
{
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);
}

SV**
Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
register U32 hash, int flags)
{
return (SV**) hv_common(hv, NULL, key, klen, flags,
(HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
}

/*
=for apidoc hv_store_ent
Expand Down Expand Up @@ -302,23 +277,6 @@ C<klen> 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
Expand All @@ -333,24 +291,6 @@ 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)
{
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);
}

/*
=for apidoc hv_exists_ent
Expand Down Expand Up @@ -380,6 +320,24 @@ information on how to use this function on tied hashes.
=cut
*/

/* 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)
Expand Down Expand Up @@ -931,23 +889,6 @@ 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
Expand Down
23 changes: 23 additions & 0 deletions hv.h
View file
Expand Up @@ -426,6 +426,29 @@ C<SV*>.
((SV *) hv_common((zlonk), (awk), NULL, 0, 0, (touche) | HV_DELETE, \
NULL, (zgruppp)))

#define hv_store_flags(urkk, zamm, clunk, thwape, sploosh, eee_yow) \
((SV**) hv_common((urkk), NULL, (zamm), (clunk), (eee_yow), \
(HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), (thwape), \
(sploosh)))

#define hv_store(urkk, zamm, clunk, thwape, sploosh) \
((SV**) hv_common_key_len((urkk), (zamm), (clunk), \
(HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), \
(thwape), (sploosh)))

#define hv_exists(urkk, zamm, clunk) \
(hv_common_key_len((urkk), (zamm), (clunk), HV_FETCH_ISEXISTS, NULL, 0) \
? TRUE : FALSE)

#define hv_fetch(urkk, zamm, clunk, pam) \
((SV**) hv_common_key_len((urkk), (zamm), (clunk), (pam) \
? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \
: HV_FETCH_JUST_SV, NULL, 0))

#define hv_delete(urkk, zamm, clunk, pam) \
((SV*) hv_common_key_len((urkk), (zamm), (clunk), \
(pam) | HV_DELETE, NULL, 0))

/* This refcounted he structure is used for storing the hints used for lexical
pragmas. Without threads, it's basically struct he + refcount.
With threads, life gets more complex as the structure needs to be shared
Expand Down
77 changes: 77 additions & 0 deletions mathoms.c
View file
Expand Up @@ -1238,6 +1238,83 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
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 */

/*
Expand Down
19 changes: 11 additions & 8 deletions proto.h
View file
Expand Up @@ -684,27 +684,30 @@ PERL_CALLCONV HV * Perl_hv_copy_hints_hv(pTHX_ HV *const ohv)
PERL_CALLCONV void Perl_hv_delayfree_ent(pTHX_ HV* hv, HE* entry)
__attribute__nonnull__(pTHX_1);

PERL_CALLCONV SV* Perl_hv_delete(pTHX_ HV* tb, const char* key, I32 klen, I32 flags)
__attribute__nonnull__(pTHX_2);
/* PERL_CALLCONV SV* Perl_hv_delete(pTHX_ HV* tb, const char* key, I32 klen, I32 flags)
__attribute__nonnull__(pTHX_2); */

/* PERL_CALLCONV SV* Perl_hv_delete_ent(pTHX_ HV* tb, SV* key, I32 flags, U32 hash)
__attribute__nonnull__(pTHX_2); */

PERL_CALLCONV bool Perl_hv_exists(pTHX_ HV* tb, const char* key, I32 klen)
/* PERL_CALLCONV bool Perl_hv_exists(pTHX_ HV* tb, const char* key, I32 klen)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_2);
__attribute__nonnull__(pTHX_2); */

/* PERL_CALLCONV bool Perl_hv_exists_ent(pTHX_ HV* tb, SV* key, U32 hash)
__attribute__warn_unused_result__
__attribute__nonnull__(pTHX_2); */

PERL_CALLCONV SV** Perl_hv_fetch(pTHX_ HV* tb, const char* key, I32 klen, I32 lval)
__attribute__nonnull__(pTHX_2);
/* PERL_CALLCONV SV** Perl_hv_fetch(pTHX_ HV* tb, const char* key, I32 klen, I32 lval)
__attribute__nonnull__(pTHX_2); */

/* PERL_CALLCONV HE* Perl_hv_fetch_ent(pTHX_ HV* tb, SV* key, I32 lval, U32 hash)
__attribute__nonnull__(pTHX_2); */

PERL_CALLCONV void* Perl_hv_common(pTHX_ HV* tb, SV* keysv, const char* key, STRLEN klen, int flags, int action, SV* val, U32 hash);
PERL_CALLCONV void* Perl_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 klen_i32, const int action, SV *val, const U32 hash)
__attribute__nonnull__(pTHX_2);

PERL_CALLCONV void Perl_hv_free_ent(pTHX_ HV* hv, HE* entryK)
__attribute__nonnull__(pTHX_1);

Expand Down Expand Up @@ -749,9 +752,9 @@ PERL_CALLCONV HV * Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he
PERL_CALLCONV SV * Perl_refcounted_he_fetch(pTHX_ const struct refcounted_he *chain, SV *keysv, const char *key, STRLEN klen, int flags, U32 hash);
PERL_CALLCONV void Perl_refcounted_he_free(pTHX_ struct refcounted_he *he);
PERL_CALLCONV struct refcounted_he * Perl_refcounted_he_new(pTHX_ struct refcounted_he *const parent, SV *const key, SV *const value);
PERL_CALLCONV SV** Perl_hv_store(pTHX_ HV* tb, const char* key, I32 klen, SV* val, U32 hash);
/* PERL_CALLCONV SV** Perl_hv_store(pTHX_ HV* tb, const char* key, I32 klen, SV* val, U32 hash); */
/* PERL_CALLCONV HE* Perl_hv_store_ent(pTHX_ HV* tb, SV* key, SV* val, U32 hash); */
PERL_CALLCONV SV** Perl_hv_store_flags(pTHX_ HV* tb, const char* key, I32 klen, SV* val, U32 hash, int flags);
/* PERL_CALLCONV SV** Perl_hv_store_flags(pTHX_ HV* tb, const char* key, I32 klen, SV* val, U32 hash, int flags); */
PERL_CALLCONV void Perl_hv_undef(pTHX_ HV* tb);
PERL_CALLCONV I32 Perl_ibcmp(pTHX_ const char* a, const char* b, I32 len)
__attribute__pure__
Expand Down

0 comments on commit a038e57

Please sign in to comment.