hv.c: Inline macro to test if an HV has env magic

Previous code would invoke an entire `mg_find()` call just to check if
the given HV happens to have `PERL_MAGIC_env`. This hardcodes knowledge
of the `PERL_MAGIC_env` type in a lot of places that don't really care
about it.

Author: leonerd

embed.fnc

@@ -4564,6 +4564,9 @@ opx	|void	|sv_kill_backrefs					\
 				|NN SV * const sv			\
 				|NULLOK NOCHECK AV * const av
 #endif
+#if defined(PERL_IN_HV_C) || defined(PERL_IN_PP_HOT_C)
+S	|bool	|hv_is_env	|NN HV *hv
+#endif
 #if defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C)
 op	|SV *	|hfree_next_entry					\
 				|NN HV *hv				\

embed.h

@@ -1425,6 +1425,9 @@
 #       define new_he()                         S_new_he(aTHX)
 #     endif
 #   endif /* defined(PERL_IN_HV_C) */
+#   if defined(PERL_IN_HV_C) || defined(PERL_IN_PP_HOT_C)
+#     define hv_is_env(a)                       S_hv_is_env(aTHX_ a)
+#   endif
 #   if defined(PERL_IN_LOCALE_C)
 #     define get_locale_string_utf8ness_i(a,b,c,d) S_get_locale_string_utf8ness_i(aTHX_ a,b,c,d)
 #     define ints_to_tm(a,b,c,d,e,f,g,h,i)      S_ints_to_tm(aTHX_ a,b,c,d,e,f,g,h,i)

hv.c

@@ -604,7 +604,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                 return (void *) entry;
             }
 #ifdef ENV_IS_CASELESS
-            else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
+            else if (hv_is_env(hv)) {
                 U32 i;
                 for (i = 0; i < klen; ++i)
                     if (isLOWER(key[i])) {
@@ -669,7 +669,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                 return SvTRUE_NN(svret) ? (void *)hv : NULL;
                 }
 #ifdef ENV_IS_CASELESS
-            else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
+            else if (hv_is_env(hv)) {
                 /* XXX This code isn't UTF8 clean.  */
                 char * const keysave = (char * const)key;
                 /* Will need to free this, so set FREEKEY flag.  */
@@ -714,7 +714,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                     return NULL;
                 }
 #ifdef ENV_IS_CASELESS
-                else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
+                else if (hv_is_env(hv)) {
                     /* XXX This code isn't UTF8 clean.  */
                     const char *keysave = key;
                     /* Will need to free this, so set FREEKEY flag.  */
@@ -737,8 +737,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     if (!HvARRAY(hv)) {
         if ((action & (HV_FETCH_LVALUE | HV_FETCH_ISSTORE))
 #ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
-                 || (SvRMAGICAL((const SV *)hv)
-                     && mg_find((const SV *)hv, PERL_MAGIC_env))
+                 || (hv_is_env(hv))
 #endif
                                                                   ) {
             char *array;
@@ -944,9 +943,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 
   not_found:
 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
-    if (!(action & HV_FETCH_ISSTORE)
-        && SvRMAGICAL((const SV *)hv)
-        && mg_find((const SV *)hv, PERL_MAGIC_env)) {
+    if (!(action & HV_FETCH_ISSTORE) && hv_is_env(hv)) {
         unsigned long len;
         const char * const env = PerlEnv_ENVgetenv_len(key,&len);
         if (env) {
@@ -1196,7 +1193,7 @@ Perl_hv_pushkv(pTHX_ HV *hv, U32 flags)
     HE *entry;
     bool tied = SvRMAGICAL(hv) && (mg_find(MUTABLE_SV(hv), PERL_MAGIC_tied)
 #ifdef DYNAMIC_ENV_FETCH  /* might not know number of keys yet */
-                                   || mg_find(MUTABLE_SV(hv), PERL_MAGIC_env)
+                                   || hv_is_env(hv)
 #endif
                                   );
     PERL_ARGS_ASSERT_HV_PUSHKV;
@@ -1348,7 +1345,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                     return NULL;		/* element cannot be deleted */
                 }
 #ifdef ENV_IS_CASELESS
-                else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
+                else if (hv_is_env(hv)) {
                     /* XXX This code isn't UTF8 clean.  */
                     keysv = newSVpvn_flags(key, klen, SVs_TEMP);
                     if (k_flags & HVhek_FREEKEY) {
@@ -3063,8 +3060,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
         }
     }
 #if defined(DYNAMIC_ENV_FETCH) && defined(VMS)  /* set up %ENV for iteration */
-    if (!entry && SvRMAGICAL((const SV *)hv)
-        && mg_find((const SV *)hv, PERL_MAGIC_env)) {
+    if (!entry && hv_is_env(hv)) {
         prime_env_iter();
     }
 #endif

inline.h

@@ -283,6 +283,18 @@ S_strip_spaces(pTHX_ const char * orig, STRLEN * const len)
 }
 #endif
 
+/* ------------------------------- hv.h ------------------------------- */
+
+#if defined(PERL_IN_HV_C) || defined(PERL_IN_PP_HOT_C)
+PERL_STATIC_INLINE bool
+S_hv_is_env(pTHX_ HV *hv)
+{
+    PERL_ARGS_ASSERT_HV_IS_ENV;
+
+    return SvRMAGICAL((SV *)hv) && (bool)mg_find((SV *)hv, PERL_MAGIC_env);
+}
+#endif
+
 /* ------------------------------- iperlsys.h ------------------------------- */
 #if ! defined(PERL_IMPLICIT_SYS) && defined(USE_ITHREADS)
 

pp_hot.c

@@ -2266,8 +2266,7 @@ S_padhv_rv2hv_common(pTHX_ HV *hv, U8 gimme, bool is_keys, bool has_targ)
            keys then check its length, and whether we do either with or without
            an %ENV lookup first. prime_env_iter() returns quickly if nothing
            needs doing. */
-        if (SvRMAGICAL((const SV *)hv)
-            && mg_find((const SV *)hv, PERL_MAGIC_env)) {
+        if (hv_is_env(hv))
             prime_env_iter();
         }
 #endif