hv.c: Check for being %ENV hash by comparing to GvHV(PL_envgv) rather than looking for PERL_MAGIC_env

Previous code would invoke an entire `mg_find()` call just to check if
the given HV happens to have `PERL_MAGIC_env`. This is a more expensive
lookup than simply comparing the pointer to the HV slot of the *ENV
glob. In addition, it hardcodes in knowledge of the `PERL_MAGIC_env`
type in a lot of places that don't really care about it.

Author: leonerd

hv.c

@@ -481,6 +481,8 @@ Perl_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 klen_i32,
     return hv_common(hv, NULL, key, klen, flags, action, val, hash);
 }
 
+#define hv_is_env(hv)  (PL_envgv && (hv) == GvHV(PL_envgv))
+
 void *
 Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                int flags, int action, SV *val, U32 hash)
@@ -604,7 +606,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 +671,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 +716,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 +739,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))
+                 || (SvRMAGICAL((const SV *)hv) && hv_is_env(hv))
 #endif
                                                                   ) {
             char *array;
@@ -946,7 +947,7 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 #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)) {
+        && hv_is_env(hv)) {
         unsigned long len;
         const char * const env = PerlEnv_ENVgetenv_len(key,&len);
         if (env) {
@@ -1196,7 +1197,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 +1349,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 +3064,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 && SvRMAGICAL((const SV *)hv) && hv_is_env(hv)) {
         prime_env_iter();
     }
 #endif

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 (SvRMAGICAL((const SV *)hv) && PL_envgv && (hv == GvHV(PL_envgv)) {
             prime_env_iter();
         }
 #endif