This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
An alternative way of structuring ptr_table_clear so that the variables
[perl5.git] / sv.c
diff --git a/sv.c b/sv.c
index 740f2de..9ed37cb 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -357,7 +357,7 @@ and split it into a list of free SVs.
 void
 Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags)
 {
 void
 Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags)
 {
-    SV* sva = (SV*)ptr;
+    SV* const sva = (SV*)ptr;
     register SV* sv;
     register SV* svend;
 
     register SV* sv;
     register SV* svend;
 
@@ -1625,71 +1625,14 @@ S_sv_2iuv_non_preserve(pTHX_ register SV *sv, I32 numtype)
 }
 #endif /* !NV_PRESERVES_UV*/
 
 }
 #endif /* !NV_PRESERVES_UV*/
 
-/*
-=for apidoc sv_2iv_flags
-
-Return the integer value of an SV, doing any necessary string
-conversion.  If flags includes SV_GMAGIC, does an mg_get() first.
-Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
-
-=cut
-*/
-
-IV
-Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
-{
-    if (!sv)
-       return 0;
-    if (SvGMAGICAL(sv)) {
-       if (flags & SV_GMAGIC)
-           mg_get(sv);
-       if (SvIOKp(sv))
-           return SvIVX(sv);
-       if (SvNOKp(sv)) {
-           return I_V(SvNVX(sv));
-       }
-       if (SvPOKp(sv) && SvLEN(sv))
-           return asIV(sv);
-       if (!SvROK(sv)) {
-           if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-               if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
-                   report_uninit(sv);
-           }
-           return 0;
-       }
-    }
-    if (SvTHINKFIRST(sv)) {
-       if (SvROK(sv)) {
-           if (SvAMAGIC(sv)) {
-               SV * const tmpstr=AMG_CALLun(sv,numer);
-               if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
-                   return SvIV(tmpstr);
-               }
-           }
-           return PTR2IV(SvRV(sv));
-       }
-       if (SvIsCOW(sv)) {
-           sv_force_normal_flags(sv, 0);
-       }
-       if (SvREADONLY(sv) && !SvOK(sv)) {
-           if (ckWARN(WARN_UNINITIALIZED))
-               report_uninit(sv);
-           return 0;
-       }
-    }
-    if (SvIOKp(sv)) {
-       if (SvIsUV(sv)) {
-           return (IV)(SvUVX(sv));
-       }
-       else {
-           return SvIVX(sv);
-       }
-    }
+STATIC bool
+S_sv_2iuv_common(pTHX_ SV *sv) {
     if (SvNOKp(sv)) {
        /* erm. not sure. *should* never get NOKp (without NOK) from sv_2nv
         * without also getting a cached IV/UV from it at the same time
         * (ie PV->NV conversion should detect loss of accuracy and cache
     if (SvNOKp(sv)) {
        /* erm. not sure. *should* never get NOKp (without NOK) from sv_2nv
         * without also getting a cached IV/UV from it at the same time
         * (ie PV->NV conversion should detect loss of accuracy and cache
-        * IV or UV at same time to avoid this.  NWC */
+        * IV or UV at same time to avoid this. */
+       /* IV-over-UV optimisation - choose to cache IV if possible */
 
        if (SvTYPE(sv) == SVt_NV)
            sv_upgrade(sv, SVt_PVNV);
 
        if (SvTYPE(sv) == SVt_NV)
            sv_upgrade(sv, SVt_PVNV);
@@ -1762,14 +1705,14 @@ Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
     else if (SvPOKp(sv) && SvLEN(sv)) {
        UV value;
        const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
     else if (SvPOKp(sv) && SvLEN(sv)) {
        UV value;
        const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
-       /* We want to avoid a possible problem when we cache an IV which
+       /* We want to avoid a possible problem when we cache an IV/ a UV which
           may be later translated to an NV, and the resulting NV is not
           the same as the direct translation of the initial string
           (eg 123.456 can shortcut to the IV 123 with atol(), but we must
           be careful to ensure that the value with the .456 is around if the
           NV value is requested in the future).
        
           may be later translated to an NV, and the resulting NV is not
           the same as the direct translation of the initial string
           (eg 123.456 can shortcut to the IV 123 with atol(), but we must
           be careful to ensure that the value with the .456 is around if the
           NV value is requested in the future).
        
-          This means that if we cache such an IV, we need to cache the
+          This means that if we cache such an IV/a UV, we need to cache the
           NV as well.  Moreover, we trade speed for space, and do not
           cache the NV if we are sure it's not needed.
         */
           NV as well.  Moreover, we trade speed for space, and do not
           cache the NV if we are sure it's not needed.
         */
@@ -1801,6 +1744,7 @@ Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
                if (value <= (UV)IV_MAX) {
                    SvIV_set(sv, (IV)value);
                } else {
                if (value <= (UV)IV_MAX) {
                    SvIV_set(sv, (IV)value);
                } else {
+                   /* it didn't overflow, and it was positive. */
                    SvUV_set(sv, value);
                    SvIsUV_on(sv);
                }
                    SvUV_set(sv, value);
                    SvIsUV_on(sv);
                }
@@ -1841,40 +1785,38 @@ Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
                                  PTR2UV(sv), SvNVX(sv)));
 #endif
 
                                  PTR2UV(sv), SvNVX(sv)));
 #endif
 
-
 #ifdef NV_PRESERVES_UV
 #ifdef NV_PRESERVES_UV
-           (void)SvIOKp_on(sv);
-           (void)SvNOK_on(sv);
-           if (SvNVX(sv) < (NV)IV_MAX + 0.5) {
-               SvIV_set(sv, I_V(SvNVX(sv)));
-               if ((NV)(SvIVX(sv)) == SvNVX(sv)) {
-                   SvIOK_on(sv);
-               } else {
-                   /* Integer is imprecise. NOK, IOKp */
-               }
-               /* UV will not work better than IV */
-           } else {
-               if (SvNVX(sv) > (NV)UV_MAX) {
-                   SvIsUV_on(sv);
-                   /* Integer is inaccurate. NOK, IOKp, is UV */
-                   SvUV_set(sv, UV_MAX);
-                   SvIsUV_on(sv);
-               } else {
-                   SvUV_set(sv, U_V(SvNVX(sv)));
-                   /* 0xFFFFFFFFFFFFFFFF not an issue in here */
-                   if ((NV)(SvUVX(sv)) == SvNVX(sv)) {
-                       SvIOK_on(sv);
-                       SvIsUV_on(sv);
-                   } else {
-                       /* Integer is imprecise. NOK, IOKp, is UV */
-                       SvIsUV_on(sv);
-                   }
-               }
-           }
+            (void)SvIOKp_on(sv);
+            (void)SvNOK_on(sv);
+            if (SvNVX(sv) < (NV)IV_MAX + 0.5) {
+                SvIV_set(sv, I_V(SvNVX(sv)));
+                if ((NV)(SvIVX(sv)) == SvNVX(sv)) {
+                    SvIOK_on(sv);
+                } else {
+                    /* Integer is imprecise. NOK, IOKp */
+                }
+                /* UV will not work better than IV */
+            } else {
+                if (SvNVX(sv) > (NV)UV_MAX) {
+                    SvIsUV_on(sv);
+                    /* Integer is inaccurate. NOK, IOKp, is UV */
+                    SvUV_set(sv, UV_MAX);
+                } else {
+                    SvUV_set(sv, U_V(SvNVX(sv)));
+                    /* 0xFFFFFFFFFFFFFFFF not an issue in here, NVs
+                       NV preservse UV so can do correct comparison.  */
+                    if ((NV)(SvUVX(sv)) == SvNVX(sv)) {
+                        SvIOK_on(sv);
+                    } else {
+                        /* Integer is imprecise. NOK, IOKp, is UV */
+                    }
+                }
+               SvIsUV_on(sv);
+            }
 #else /* NV_PRESERVES_UV */
             if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
                 == (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT)) {
 #else /* NV_PRESERVES_UV */
             if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
                 == (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT)) {
-                /* The IV slot will have been set from value returned by
+                /* The IV/UV slot will have been set from value returned by
                    grok_number above.  The NV slot has just been set using
                    Atof.  */
                SvNOK_on(sv);
                    grok_number above.  The NV slot has just been set using
                    Atof.  */
                SvNOK_on(sv);
@@ -1908,13 +1850,76 @@ Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
             }
 #endif /* NV_PRESERVES_UV */
        }
             }
 #endif /* NV_PRESERVES_UV */
        }
-    } else  {
-       if (!PL_localizing && !(SvFLAGS(sv) & SVs_PADTMP) && ckWARN(WARN_UNINITIALIZED))
-           report_uninit(sv);
+    }
+    else  {
+       if (!(SvFLAGS(sv) & SVs_PADTMP)) {
+           if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
+               report_uninit(sv);
+       }
        if (SvTYPE(sv) < SVt_IV)
            /* Typically the caller expects that sv_any is not NULL now.  */
            sv_upgrade(sv, SVt_IV);
        if (SvTYPE(sv) < SVt_IV)
            /* Typically the caller expects that sv_any is not NULL now.  */
            sv_upgrade(sv, SVt_IV);
+       /* Return 0 from the caller.  */
+       return TRUE;
+    }
+    return FALSE;
+}
+
+/*
+=for apidoc sv_2iv_flags
+
+Return the integer value of an SV, doing any necessary string
+conversion.  If flags includes SV_GMAGIC, does an mg_get() first.
+Normally used via the C<SvIV(sv)> and C<SvIVx(sv)> macros.
+
+=cut
+*/
+
+IV
+Perl_sv_2iv_flags(pTHX_ register SV *sv, I32 flags)
+{
+    if (!sv)
        return 0;
        return 0;
+    if (SvGMAGICAL(sv)) {
+       if (flags & SV_GMAGIC)
+           mg_get(sv);
+       if (SvIOKp(sv))
+           return SvIVX(sv);
+       if (SvNOKp(sv)) {
+           return I_V(SvNVX(sv));
+       }
+       if (SvPOKp(sv) && SvLEN(sv))
+           return asIV(sv);
+       if (!SvROK(sv)) {
+           if (!(SvFLAGS(sv) & SVs_PADTMP)) {
+               if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
+                   report_uninit(sv);
+           }
+           return 0;
+       }
+    }
+    if (SvTHINKFIRST(sv)) {
+       if (SvROK(sv)) {
+           if (SvAMAGIC(sv)) {
+               SV * const tmpstr=AMG_CALLun(sv,numer);
+               if (tmpstr && (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
+                   return SvIV(tmpstr);
+               }
+           }
+           return PTR2IV(SvRV(sv));
+       }
+       if (SvIsCOW(sv)) {
+           sv_force_normal_flags(sv, 0);
+       }
+       if (SvREADONLY(sv) && !SvOK(sv)) {
+           if (ckWARN(WARN_UNINITIALIZED))
+               report_uninit(sv);
+           return 0;
+       }
+    }
+    if (!SvIOKp(sv)) {
+       if (S_sv_2iuv_common(aTHX_ sv))
+           return 0;
     }
     DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%"IVdf")\n",
        PTR2UV(sv),SvIVX(sv)));
     }
     DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2iv(%"IVdf")\n",
        PTR2UV(sv),SvIVX(sv)));
@@ -1970,231 +1975,9 @@ Perl_sv_2uv_flags(pTHX_ register SV *sv, I32 flags)
            return 0;
        }
     }
            return 0;
        }
     }
-    if (SvIOKp(sv)) {
-       if (SvIsUV(sv)) {
-           return SvUVX(sv);
-       }
-       else {
-           return (UV)SvIVX(sv);
-       }
-    }
-    if (SvNOKp(sv)) {
-       /* erm. not sure. *should* never get NOKp (without NOK) from sv_2nv
-        * without also getting a cached IV/UV from it at the same time
-        * (ie PV->NV conversion should detect loss of accuracy and cache
-        * IV or UV at same time to avoid this. */
-       /* IV-over-UV optimisation - choose to cache IV if possible */
-
-       if (SvTYPE(sv) == SVt_NV)
-           sv_upgrade(sv, SVt_PVNV);
-
-       (void)SvIOKp_on(sv);    /* Must do this first, to clear any SvOOK */
-       if (SvNVX(sv) < (NV)IV_MAX + 0.5) {
-           SvIV_set(sv, I_V(SvNVX(sv)));
-           if (SvNVX(sv) == (NV) SvIVX(sv)
-#ifndef NV_PRESERVES_UV
-               && (((UV)1 << NV_PRESERVES_UV_BITS) >
-                   (UV)(SvIVX(sv) > 0 ? SvIVX(sv) : -SvIVX(sv)))
-               /* Don't flag it as "accurately an integer" if the number
-                  came from a (by definition imprecise) NV operation, and
-                  we're outside the range of NV integer precision */
-#endif
-               ) {
-               SvIOK_on(sv);  /* Can this go wrong with rounding? NWC */
-               DEBUG_c(PerlIO_printf(Perl_debug_log,
-                                     "0x%"UVxf" uv(%"NVgf" => %"IVdf") (precise)\n",
-                                     PTR2UV(sv),
-                                     SvNVX(sv),
-                                     SvIVX(sv)));
-
-           } else {
-               /* IV not precise.  No need to convert from PV, as NV
-                  conversion would already have cached IV if it detected
-                  that PV->IV would be better than PV->NV->IV
-                  flags already correct - don't set public IOK.  */
-               DEBUG_c(PerlIO_printf(Perl_debug_log,
-                                     "0x%"UVxf" uv(%"NVgf" => %"IVdf") (imprecise)\n",
-                                     PTR2UV(sv),
-                                     SvNVX(sv),
-                                     SvIVX(sv)));
-           }
-           /* Can the above go wrong if SvIVX == IV_MIN and SvNVX < IV_MIN,
-              but the cast (NV)IV_MIN rounds to a the value less (more
-              negative) than IV_MIN which happens to be equal to SvNVX ??
-              Analogous to 0xFFFFFFFFFFFFFFFF rounding up to NV (2**64) and
-              NV rounding back to 0xFFFFFFFFFFFFFFFF, so UVX == UV(NVX) and
-              (NV)UVX == NVX are both true, but the values differ. :-(
-              Hopefully for 2s complement IV_MIN is something like
-              0x8000000000000000 which will be exact. NWC */
-       }
-       else {
-           SvUV_set(sv, U_V(SvNVX(sv)));
-           if (
-               (SvNVX(sv) == (NV) SvUVX(sv))
-#ifndef  NV_PRESERVES_UV
-               /* Make sure it's not 0xFFFFFFFFFFFFFFFF */
-               /*&& (SvUVX(sv) != UV_MAX) irrelevant with code below */
-               && (((UV)1 << NV_PRESERVES_UV_BITS) > SvUVX(sv))
-               /* Don't flag it as "accurately an integer" if the number
-                  came from a (by definition imprecise) NV operation, and
-                  we're outside the range of NV integer precision */
-#endif
-               )
-               SvIOK_on(sv);
-           SvIsUV_on(sv);
-           DEBUG_c(PerlIO_printf(Perl_debug_log,
-                                 "0x%"UVxf" 2uv(%"UVuf" => %"IVdf") (as unsigned)\n",
-                                 PTR2UV(sv),
-                                 SvUVX(sv),
-                                 SvUVX(sv)));
-       }
-    }
-    else if (SvPOKp(sv) && SvLEN(sv)) {
-       UV value;
-       const int numtype = grok_number(SvPVX_const(sv), SvCUR(sv), &value);
-
-       /* We want to avoid a possible problem when we cache a UV which
-          may be later translated to an NV, and the resulting NV is not
-          the translation of the initial data.
-       
-          This means that if we cache such a UV, we need to cache the
-          NV as well.  Moreover, we trade speed for space, and do not
-          cache the NV if not needed.
-        */
-
-       /* SVt_PVNV is one higher than SVt_PVIV, hence this order  */
-       if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
-            == IS_NUMBER_IN_UV) {
-           /* It's definitely an integer, only upgrade to PVIV */
-           if (SvTYPE(sv) < SVt_PVIV)
-               sv_upgrade(sv, SVt_PVIV);
-           (void)SvIOK_on(sv);
-       } else if (SvTYPE(sv) < SVt_PVNV)
-           sv_upgrade(sv, SVt_PVNV);
-
-       /* If NV preserves UV then we only use the UV value if we know that
-          we aren't going to call atof() below. If NVs don't preserve UVs
-          then the value returned may have more precision than atof() will
-          return, even though it isn't accurate.  */
-       if ((numtype & (IS_NUMBER_IN_UV
-#ifdef NV_PRESERVES_UV
-                       | IS_NUMBER_NOT_INT
-#endif
-           )) == IS_NUMBER_IN_UV) {
-           /* This won't turn off the public IOK flag if it was set above  */
-           (void)SvIOKp_on(sv);
-
-           if (!(numtype & IS_NUMBER_NEG)) {
-               /* positive */;
-               if (value <= (UV)IV_MAX) {
-                   SvIV_set(sv, (IV)value);
-               } else {
-                   /* it didn't overflow, and it was positive. */
-                   SvUV_set(sv, value);
-                   SvIsUV_on(sv);
-               }
-           } else {
-               /* 2s complement assumption  */
-               if (value <= (UV)IV_MIN) {
-                   SvIV_set(sv, -(IV)value);
-               } else {
-                   /* Too negative for an IV.  This is a double upgrade, but
-                      I'm assuming it will be rare.  */
-                   if (SvTYPE(sv) < SVt_PVNV)
-                       sv_upgrade(sv, SVt_PVNV);
-                   SvNOK_on(sv);
-                   SvIOK_off(sv);
-                   SvIOKp_on(sv);
-                   SvNV_set(sv, -(NV)value);
-                   SvIV_set(sv, IV_MIN);
-               }
-           }
-       }
-       
-       if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
-           != IS_NUMBER_IN_UV) {
-           /* It wasn't an integer, or it overflowed the UV. */
-           SvNV_set(sv, Atof(SvPVX_const(sv)));
-
-            if (! numtype && ckWARN(WARN_NUMERIC))
-                   not_a_number(sv);
-
-#if defined(USE_LONG_DOUBLE)
-            DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%" PERL_PRIgldbl ")\n",
-                                  PTR2UV(sv), SvNVX(sv)));
-#else
-            DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%"NVgf")\n",
-                                  PTR2UV(sv), SvNVX(sv)));
-#endif
-
-#ifdef NV_PRESERVES_UV
-            (void)SvIOKp_on(sv);
-            (void)SvNOK_on(sv);
-            if (SvNVX(sv) < (NV)IV_MAX + 0.5) {
-                SvIV_set(sv, I_V(SvNVX(sv)));
-                if ((NV)(SvIVX(sv)) == SvNVX(sv)) {
-                    SvIOK_on(sv);
-                } else {
-                    /* Integer is imprecise. NOK, IOKp */
-                }
-                /* UV will not work better than IV */
-            } else {
-                if (SvNVX(sv) > (NV)UV_MAX) {
-                    SvIsUV_on(sv);
-                    /* Integer is inaccurate. NOK, IOKp, is UV */
-                    SvUV_set(sv, UV_MAX);
-                    SvIsUV_on(sv);
-                } else {
-                    SvUV_set(sv, U_V(SvNVX(sv)));
-                    /* 0xFFFFFFFFFFFFFFFF not an issue in here, NVs
-                       NV preservse UV so can do correct comparison.  */
-                    if ((NV)(SvUVX(sv)) == SvNVX(sv)) {
-                        SvIOK_on(sv);
-                        SvIsUV_on(sv);
-                    } else {
-                        /* Integer is imprecise. NOK, IOKp, is UV */
-                        SvIsUV_on(sv);
-                    }
-                }
-            }
-#else /* NV_PRESERVES_UV */
-            if ((numtype & (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT))
-                == (IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT)) {
-                /* The UV slot will have been set from value returned by
-                   grok_number above.  The NV slot has just been set using
-                   Atof.  */
-               SvNOK_on(sv);
-                assert (SvIOKp(sv));
-            } else {
-                if (((UV)1 << NV_PRESERVES_UV_BITS) >
-                    U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))) {
-                    /* Small enough to preserve all bits. */
-                    (void)SvIOKp_on(sv);
-                    SvNOK_on(sv);
-                    SvIV_set(sv, I_V(SvNVX(sv)));
-                    if ((NV)(SvIVX(sv)) == SvNVX(sv))
-                        SvIOK_on(sv);
-                    /* Assumption: first non-preserved integer is < IV_MAX,
-                       this NV is in the preserved range, therefore: */
-                    if (!(U_V(SvNVX(sv) > 0 ? SvNVX(sv) : -SvNVX(sv))
-                          < (UV)IV_MAX)) {
-                        Perl_croak(aTHX_ "sv_2uv assumed (U_V(fabs((double)SvNVX(sv))) < (UV)IV_MAX) but SvNVX(sv)=%"NVgf" U_V is 0x%"UVxf", IV_MAX is 0x%"UVxf"\n", SvNVX(sv), U_V(SvNVX(sv)), (UV)IV_MAX);
-                    }
-                } else
-                    sv_2iuv_non_preserve (sv, numtype);
-            }
-#endif /* NV_PRESERVES_UV */
-       }
-    }
-    else  {
-       if (!(SvFLAGS(sv) & SVs_PADTMP)) {
-           if (!PL_localizing && ckWARN(WARN_UNINITIALIZED))
-               report_uninit(sv);
-       }
-       if (SvTYPE(sv) < SVt_IV)
-           /* Typically the caller expects that sv_any is not NULL now.  */
-           sv_upgrade(sv, SVt_IV);
-       return 0;
+    if (!SvIOKp(sv)) {
+       if (S_sv_2iuv_common(aTHX_ sv))
+           return 0;
     }
 
     DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%"UVuf")\n",
     }
 
     DEBUG_c(PerlIO_printf(Perl_debug_log, "0x%"UVxf" 2uv(%"UVuf")\n",
@@ -2492,6 +2275,86 @@ S_uiv_2buf(char *buf, IV iv, UV uv, int is_uv, char **peob)
     return ptr;
 }
 
     return ptr;
 }
 
+/* stringify_regexp(): private routine for use by sv_2pv_flags(): converts
+ * a regexp to its stringified form.
+ */
+
+static char *
+S_stringify_regexp(pTHX_ SV *sv, MAGIC *mg, STRLEN *lp) {
+    const regexp *re = (regexp *)mg->mg_obj;
+
+    if (!mg->mg_ptr) {
+       const char *fptr = "msix";
+       char reflags[6];
+       char ch;
+       int left = 0;
+       int right = 4;
+       char need_newline = 0;
+       U16 reganch = (U16)((re->reganch & PMf_COMPILETIME) >> 12);
+
+       while((ch = *fptr++)) {
+           if(reganch & 1) {
+               reflags[left++] = ch;
+           }
+           else {
+               reflags[right--] = ch;
+           }
+           reganch >>= 1;
+       }
+       if(left != 4) {
+           reflags[left] = '-';
+           left = 5;
+       }
+
+       mg->mg_len = re->prelen + 4 + left;
+       /*
+        * If /x was used, we have to worry about a regex ending with a
+        * comment later being embedded within another regex. If so, we don't
+        * want this regex's "commentization" to leak out to the right part of
+        * the enclosing regex, we must cap it with a newline.
+        *
+        * So, if /x was used, we scan backwards from the end of the regex. If
+        * we find a '#' before we find a newline, we need to add a newline
+        * ourself. If we find a '\n' first (or if we don't find '#' or '\n'),
+        * we don't need to add anything.  -jfriedl
+        */
+       if (PMf_EXTENDED & re->reganch) {
+           const char *endptr = re->precomp + re->prelen;
+           while (endptr >= re->precomp) {
+               const char c = *(endptr--);
+               if (c == '\n')
+                   break; /* don't need another */
+               if (c == '#') {
+                   /* we end while in a comment, so we need a newline */
+                   mg->mg_len++; /* save space for it */
+                   need_newline = 1; /* note to add it */
+                   break;
+               }
+           }
+       }
+
+       Newx(mg->mg_ptr, mg->mg_len + 1 + left, char);
+       mg->mg_ptr[0] = '(';
+       mg->mg_ptr[1] = '?';
+       Copy(reflags, mg->mg_ptr+2, left, char);
+       *(mg->mg_ptr+left+2) = ':';
+       Copy(re->precomp, mg->mg_ptr+3+left, re->prelen, char);
+       if (need_newline)
+           mg->mg_ptr[mg->mg_len - 2] = '\n';
+       mg->mg_ptr[mg->mg_len - 1] = ')';
+       mg->mg_ptr[mg->mg_len] = 0;
+    }
+    PL_reginterp_cnt += re->program[0].next_off;
+    
+    if (re->reganch & ROPT_UTF8)
+       SvUTF8_on(sv);
+    else
+       SvUTF8_off(sv);
+    if (lp)
+       *lp = mg->mg_len;
+    return mg->mg_ptr;
+}
+
 /*
 =for apidoc sv_2pv_flags
 
 /*
 =for apidoc sv_2pv_flags
 
@@ -2509,10 +2372,6 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
 {
     register char *s;
     int olderrno;
 {
     register char *s;
     int olderrno;
-    SV *tsv, *origsv;
-    char tbuf[64];     /* Must fit sprintf/Gconvert of longest IV/NV */
-    char *tmpbuf = tbuf;
-    STRLEN len = 0;    /* Hush gcc. len is always initialised before use.  */
 
     if (!sv) {
        if (lp)
 
     if (!sv) {
        if (lp)
@@ -2531,16 +2390,44 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                return (char *)SvPVX_const(sv);
            return SvPVX(sv);
        }
                return (char *)SvPVX_const(sv);
            return SvPVX(sv);
        }
-       if (SvIOKp(sv)) {
-           len = SvIsUV(sv) ? my_sprintf(tmpbuf,"%"UVuf, (UV)SvUVX(sv))
-               : my_sprintf(tmpbuf,"%"IVdf, (IV)SvIVX(sv));
-           tsv = Nullsv;
-           goto tokensave_has_len;
-       }
-       if (SvNOKp(sv)) {
-           Gconvert(SvNVX(sv), NV_DIG, 0, tmpbuf);
-           tsv = Nullsv;
-           goto tokensave;
+       if (SvIOKp(sv) || SvNOKp(sv)) {
+           char tbuf[64];  /* Must fit sprintf/Gconvert of longest IV/NV */
+           STRLEN len;
+
+           if (SvIOKp(sv)) {
+               len = SvIsUV(sv) ? my_sprintf(tbuf,"%"UVuf, (UV)SvUVX(sv))
+                   : my_sprintf(tbuf,"%"IVdf, (IV)SvIVX(sv));
+           } else {
+               Gconvert(SvNVX(sv), NV_DIG, 0, tbuf);
+               len = strlen(tbuf);
+           }
+           if (SvROK(sv)) {    /* XXX Skip this when sv_pvn_force calls */
+               /* Sneaky stuff here */
+               SV *tsv = newSVpvn(tbuf, len);
+
+               sv_2mortal(tsv);
+               if (lp)
+                   *lp = SvCUR(tsv);
+               return SvPVX(tsv);
+           }
+           else {
+               dVAR;
+
+#ifdef FIXNEGATIVEZERO
+               if (len == 2 && tbuf[0] == '-' && tbuf[1] == '0') {
+                   tbuf[0] = '0';
+                   tbuf[1] = 0;
+                   len = 1;
+               }
+#endif
+               SvUPGRADE(sv, SVt_PV);
+               if (lp)
+                   *lp = len;
+               s = SvGROW_mutable(sv, len + 1);
+               SvCUR_set(sv, len);
+               SvPOKp_on(sv);
+               return memcpy(s, tbuf, len + 1);
+           }
        }
         if (!SvROK(sv)) {
            if (!(SvFLAGS(sv) & SVs_PADTMP)) {
        }
         if (!SvROK(sv)) {
            if (!(SvFLAGS(sv) & SVs_PADTMP)) {
@@ -2555,7 +2442,7 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
     if (SvTHINKFIRST(sv)) {
        if (SvROK(sv)) {
            SV* tmpstr;
     if (SvTHINKFIRST(sv)) {
        if (SvROK(sv)) {
            SV* tmpstr;
-            register const char *typestr;
+
             if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)) &&
                 (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
                /* Unwrap this:  */
             if (SvAMAGIC(sv) && (tmpstr=AMG_CALLun(sv,string)) &&
                 (!SvROK(tmpstr) || (SvRV(tmpstr) != SvRV(sv)))) {
                /* Unwrap this:  */
@@ -2579,135 +2466,37 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                 else
                     SvUTF8_off(sv);
                 return pv;
                 else
                     SvUTF8_off(sv);
                 return pv;
-            }
-           origsv = sv;
-           sv = (SV*)SvRV(sv);
-           if (!sv)
-               typestr = "NULLREF";
-           else {
+            } else {
+               SV *tsv;
                MAGIC *mg;
                MAGIC *mg;
-               
-               if (SvTYPE(sv) == SVt_PVMG && ((SvFLAGS(sv) &
-                          (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
-                         == (SVs_OBJECT|SVs_SMG))
-                   && (mg = mg_find(sv, PERL_MAGIC_qr))) {
-                   const regexp *re = (regexp *)mg->mg_obj;
-
-                   if (!mg->mg_ptr) {
-                       const char *fptr = "msix";
-                       char reflags[6];
-                       char ch;
-                       int left = 0;
-                       int right = 4;
-                       char need_newline = 0;
-                       U16 reganch =
-                           (U16)((re->reganch & PMf_COMPILETIME) >> 12);
-
-                       while((ch = *fptr++)) {
-                           if(reganch & 1) {
-                               reflags[left++] = ch;
-                           }
-                           else {
-                               reflags[right--] = ch;
-                           }
-                           reganch >>= 1;
-                       }
-                       if(left != 4) {
-                           reflags[left] = '-';
-                           left = 5;
-                       }
-
-                       mg->mg_len = re->prelen + 4 + left;
-                       /*
-                        * If /x was used, we have to worry about a regex
-                        * ending with a comment later being embedded
-                        * within another regex. If so, we don't want this
-                        * regex's "commentization" to leak out to the
-                        * right part of the enclosing regex, we must cap
-                        * it with a newline.
-                        *
-                        * So, if /x was used, we scan backwards from the
-                        * end of the regex. If we find a '#' before we
-                        * find a newline, we need to add a newline
-                        * ourself. If we find a '\n' first (or if we
-                        * don't find '#' or '\n'), we don't need to add
-                        * anything.  -jfriedl
-                        */
-                       if (PMf_EXTENDED & re->reganch) {
-                           const char *endptr = re->precomp + re->prelen;
-                           while (endptr >= re->precomp) {
-                               const char c = *(endptr--);
-                               if (c == '\n')
-                                   break; /* don't need another */
-                               if (c == '#') {
-                                   /* we end while in a comment, so we
-                                      need a newline */
-                                   mg->mg_len++; /* save space for it */
-                                   need_newline = 1; /* note to add it */
-                                   break;
-                               }
-                           }
-                       }
-
-                       Newx(mg->mg_ptr, mg->mg_len + 1 + left, char);
-                       Copy("(?", mg->mg_ptr, 2, char);
-                       Copy(reflags, mg->mg_ptr+2, left, char);
-                       Copy(":", mg->mg_ptr+left+2, 1, char);
-                       Copy(re->precomp, mg->mg_ptr+3+left, re->prelen, char);
-                       if (need_newline)
-                           mg->mg_ptr[mg->mg_len - 2] = '\n';
-                       mg->mg_ptr[mg->mg_len - 1] = ')';
-                       mg->mg_ptr[mg->mg_len] = 0;
+               const SV *const referent = (SV*)SvRV(sv);
+
+               if (!referent) {
+                   tsv = sv_2mortal(newSVpvn("NULLREF", 7));
+               } else if (SvTYPE(referent) == SVt_PVMG
+                          && ((SvFLAGS(referent) &
+                               (SVs_OBJECT|SVf_OK|SVs_GMG|SVs_SMG|SVs_RMG))
+                              == (SVs_OBJECT|SVs_SMG))
+                          && (mg = mg_find(referent, PERL_MAGIC_qr))) {
+                   return S_stringify_regexp(aTHX_ sv, mg, lp);
+               } else {
+                   const char *const typestr = sv_reftype(referent, 0);
+
+                   tsv = sv_newmortal();
+                   if (SvOBJECT(referent)) {
+                       const char *const name = HvNAME_get(SvSTASH(referent));
+                       Perl_sv_setpvf(aTHX_ tsv, "%s=%s(0x%"UVxf")",
+                                      name ? name : "__ANON__" , typestr,
+                                      PTR2UV(referent));
                    }
                    }
-                   PL_reginterp_cnt += re->program[0].next_off;
-
-                   if (re->reganch & ROPT_UTF8)
-                       SvUTF8_on(origsv);
                    else
                    else
-                       SvUTF8_off(origsv);
-                   if (lp)
-                       *lp = mg->mg_len;
-                   return mg->mg_ptr;
+                       Perl_sv_setpvf(aTHX_ tsv, "%s(0x%"UVxf")", typestr,
+                                      PTR2UV(referent));
                }
                }
-
-
-               switch (SvTYPE(sv)) {
-               case SVt_NULL:
-               case SVt_IV:
-               case SVt_NV:
-               case SVt_RV:
-               case SVt_PV:
-               case SVt_PVIV:
-               case SVt_PVNV:
-               case SVt_PVMG:
-               case SVt_PVBM:  typestr = SvVOK(sv) ? "VSTRING"
-                                   : SvROK(sv) ? "REF" : "SCALAR"; break;
-               case SVt_PVLV:  typestr = SvROK(sv) ? "REF"
-                               /* tied lvalues should appear to be
-                                * scalars for backwards compatitbility */
-                               : (LvTYPE(sv) == 't' || LvTYPE(sv) == 'T')
-                                   ? "SCALAR" : "LVALUE";      break;
-               case SVt_PVAV:  typestr = "ARRAY";      break;
-               case SVt_PVHV:  typestr = "HASH";       break;
-               case SVt_PVCV:  typestr = "CODE";       break;
-               case SVt_PVGV:  typestr = "GLOB";       break;
-               case SVt_PVFM:  typestr = "FORMAT";     break;
-               case SVt_PVIO:  typestr = "IO";         break;
-               default:        typestr = "UNKNOWN";    break;
-               }
-               tsv = NEWSV(0,0);
-               if (SvOBJECT(sv)) {
-                   const char * const name = HvNAME_get(SvSTASH(sv));
-                   Perl_sv_setpvf(aTHX_ tsv, "%s=%s(0x%"UVxf")",
-                                  name ? name : "__ANON__" , typestr, PTR2UV(sv));
-               }
-               else
-                   Perl_sv_setpvf(aTHX_ tsv, "%s(0x%"UVxf")", typestr, PTR2UV(sv));
-               goto tokensaveref;
+               if (lp)
+                   *lp = SvCUR(tsv);
+               return SvPVX(tsv);
            }
            }
-           if (lp)
-               *lp = strlen(typestr);
-           return (char *)typestr;
        }
        if (SvREADONLY(sv) && !SvOK(sv)) {
            if (ckWARN(WARN_UNINITIALIZED))
        }
        if (SvREADONLY(sv) && !SvOK(sv)) {
            if (ckWARN(WARN_UNINITIALIZED))
@@ -2793,40 +2582,6 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
     if (flags & SV_MUTABLE_RETURN)
        return SvPVX_mutable(sv);
     return SvPVX(sv);
     if (flags & SV_MUTABLE_RETURN)
        return SvPVX_mutable(sv);
     return SvPVX(sv);
-
-  tokensave:
-    len = strlen(tmpbuf);
- tokensave_has_len:
-    assert (!tsv);
-    if (SvROK(sv)) {   /* XXX Skip this when sv_pvn_force calls */
-       /* Sneaky stuff here */
-
-      tokensaveref:
-       if (!tsv)
-           tsv = newSVpvn(tmpbuf, len);
-       sv_2mortal(tsv);
-       if (lp)
-           *lp = SvCUR(tsv);
-       return SvPVX(tsv);
-    }
-    else {
-        dVAR;
-
-#ifdef FIXNEGATIVEZERO
-       if (len == 2 && tmpbuf[0] == '-' && tmpbuf[1] == '0') {
-           tmpbuf[0] = '0';
-           tmpbuf[1] = 0;
-           len = 1;
-       }
-#endif
-       SvUPGRADE(sv, SVt_PV);
-       if (lp)
-           *lp = len;
-       s = SvGROW_mutable(sv, len + 1);
-       SvCUR_set(sv, len);
-       SvPOKp_on(sv);
-       return memcpy(s, tmpbuf, len + 1);
-    }
 }
 
 /*
 }
 
 /*
@@ -9292,18 +9047,24 @@ Perl_ptr_table_new(pTHX)
 
 /* map an existing pointer using a table */
 
 
 /* map an existing pointer using a table */
 
-void *
-Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, const void *sv)
-{
+STATIC PTR_TBL_ENT_t *
+S_ptr_table_find(pTHX_ PTR_TBL_t *tbl, const void *sv) {
     PTR_TBL_ENT_t *tblent;
     const UV hash = PTR_TABLE_HASH(sv);
     assert(tbl);
     tblent = tbl->tbl_ary[hash & tbl->tbl_max];
     for (; tblent; tblent = tblent->next) {
        if (tblent->oldval == sv)
     PTR_TBL_ENT_t *tblent;
     const UV hash = PTR_TABLE_HASH(sv);
     assert(tbl);
     tblent = tbl->tbl_ary[hash & tbl->tbl_max];
     for (; tblent; tblent = tblent->next) {
        if (tblent->oldval == sv)
-           return tblent->newval;
+           return tblent;
     }
     }
-    return (void*)NULL;
+    return 0;
+}
+
+void *
+Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, const void *sv)
+{
+    PTR_TBL_ENT_t const *const tblent = S_ptr_table_find(aTHX_ tbl, sv);
+    return tblent ? tblent->newval : (void *) 0;
 }
 
 /* add a new entry to a pointer-mapping table */
 }
 
 /* add a new entry to a pointer-mapping table */
@@ -9311,29 +9072,22 @@ Perl_ptr_table_fetch(pTHX_ PTR_TBL_t *tbl, const void *sv)
 void
 Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, const void *oldsv, void *newsv)
 {
 void
 Perl_ptr_table_store(pTHX_ PTR_TBL_t *tbl, const void *oldsv, void *newsv)
 {
-    PTR_TBL_ENT_t *tblent, **otblent;
-    /* XXX this may be pessimal on platforms where pointers aren't good
-     * hash values e.g. if they grow faster in the most significant
-     * bits */
-    const UV hash = PTR_TABLE_HASH(oldsv);
-    bool empty = 1;
+    PTR_TBL_ENT_t *tblent = S_ptr_table_find(aTHX_ tbl, oldsv);
 
 
-    assert(tbl);
-    otblent = &tbl->tbl_ary[hash & tbl->tbl_max];
-    for (tblent = *otblent; tblent; empty=0, tblent = tblent->next) {
-       if (tblent->oldval == oldsv) {
-           tblent->newval = newsv;
-           return;
-       }
+    if (tblent) {
+       tblent->newval = newsv;
+    } else {
+       const UV entry = PTR_TABLE_HASH(oldsv) & tbl->tbl_max;
+
+       new_body_inline(tblent, sizeof(struct ptr_tbl_ent), PTE_SVSLOT);
+       tblent->oldval = oldsv;
+       tblent->newval = newsv;
+       tblent->next = tbl->tbl_ary[entry];
+       tbl->tbl_ary[entry] = tblent;
+       tbl->tbl_items++;
+       if (tblent->next && tbl->tbl_items > tbl->tbl_max)
+           ptr_table_split(tbl);
     }
     }
-    new_body_inline(tblent, sizeof(struct ptr_tbl_ent), PTE_SVSLOT);
-    tblent->oldval = oldsv;
-    tblent->newval = newsv;
-    tblent->next = *otblent;
-    *otblent = tblent;
-    tbl->tbl_items++;
-    if (!empty && tbl->tbl_items > tbl->tbl_max)
-       ptr_table_split(tbl);
 }
 
 /* double the hash bucket size of an existing ptr table */
 }
 
 /* double the hash bucket size of an existing ptr table */
@@ -9373,34 +9127,22 @@ Perl_ptr_table_split(pTHX_ PTR_TBL_t *tbl)
 void
 Perl_ptr_table_clear(pTHX_ PTR_TBL_t *tbl)
 {
 void
 Perl_ptr_table_clear(pTHX_ PTR_TBL_t *tbl)
 {
-    register PTR_TBL_ENT_t **array;
-    register PTR_TBL_ENT_t *entry;
-    UV riter = 0;
-    UV max;
+    if (tbl && tbl->tbl_items) {
+       register PTR_TBL_ENT_t **array = tbl->tbl_ary;
+       UV riter = tbl->tbl_max;
 
 
-    if (!tbl || !tbl->tbl_items) {
-        return;
-    }
+       do {
+           PTR_TBL_ENT_t *entry = array[riter];
 
 
-    array = tbl->tbl_ary;
-    entry = array[0];
-    max = tbl->tbl_max;
+           while (entry) {
+               PTR_TBL_ENT_t *oentry = entry;
+               entry = entry->next;
+               del_pte(oentry);
+           }
+       } while (riter--);
 
 
-    for (;;) {
-        if (entry) {
-            PTR_TBL_ENT_t *oentry = entry;
-            entry = entry->next;
-            del_pte(oentry);
-        }
-        if (!entry) {
-            if (++riter > max) {
-                break;
-            }
-            entry = array[riter];
-        }
+       tbl->tbl_items = 0;
     }
     }
-
-    tbl->tbl_items = 0;
 }
 
 /* clear and free a ptr table */
 }
 
 /* clear and free a ptr table */
Unnamed repository; edit this file 'description' to name the repository.