projects / p5sagit/p5-mst-13.2.git / commitdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw (parent: 3c84c86)
Add a new function Perl_hv_common_key_len(), which contains the
Nicholas Clark [Thu, 20 Sep 2007 16:44:24 +0000 (16:44 +0000)]
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

embed.fnc patch | blob | blame | history
embed.h patch | blob | blame | history
global.sym patch | blob | blame | history
handy.h patch | blob | blame | history
hv.c patch | blob | blame | history
hv.h patch | blob | blame | history
mathoms.c patch | blob | blame | history
proto.h patch | blob | blame | history

diff --git a/embed.fnc b/embed.fnc
index 265c4ab..eae7f25 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -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
diff --git a/embed.h b/embed.h
index 1c64fea..af50800 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -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 0a09243..a260a86 100644 (file)
--- 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
diff --git a/handy.h b/handy.h
index 2f76f0a..c0cd4c8 100644 (file)
--- a/handy.h
+++ b/handy.h
@@ -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))
 
 
 /*
diff --git a/hv.c b/hv.c
index ab9cd12..9597db6 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -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
 
diff --git a/hv.h b/hv.h
index 8ca69fc..163c660 100644 (file)
--- a/hv.h
+++ b/hv.h
@@ -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
diff --git a/mathoms.c b/mathoms.c
index 32cb87b..9f179dd 100644 (file)
--- a/mathoms.c
+++ b/mathoms.c
@@ -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 */
 
 /*
diff --git a/proto.h b/proto.h
index e5cf5b7..3909b05 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -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__
Unnamed repository; edit this file to name it for gitweb.