diff options
| -rw-r--r-- | embed.fnc | 19 | ||||
| -rw-r--r-- | embed.h | 12 | ||||
| -rw-r--r-- | global.sym | 1 | ||||
| -rw-r--r-- | handy.h | 10 | ||||
| -rw-r--r-- | hv.c | 95 | ||||
| -rw-r--r-- | hv.h | 23 | ||||
| -rw-r--r-- | mathoms.c | 77 | ||||
| -rw-r--r-- | proto.h | 19 |
8 files changed, 152 insertions, 104 deletions
@@ -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 @@ -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 @@ -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 @@ -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 @@ -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) @@ -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) diff --git a/global.sym b/global.sym index 0a092433d2..a260a86378 100644 --- a/global.sym +++ b/global.sym @@ -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 @@ -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)) /* @@ -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 @@ -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 @@ -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 @@ -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) @@ -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 @@ -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 @@ -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 */ /* @@ -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); @@ -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__ |