First class regexps.

[perl5.git] / sv.c

diff --git a/sv.c b/sv.c
index d5655b3..3e7c3ff 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -246,8 +246,13 @@ S_new_SV(pTHX)
     SvREFCNT(sv) = 1;
     SvFLAGS(sv) = 0;
     sv->sv_debug_optype = PL_op ? PL_op->op_type : 0;
     SvREFCNT(sv) = 1;
     SvFLAGS(sv) = 0;
     sv->sv_debug_optype = PL_op ? PL_op->op_type : 0;

-    sv->sv_debug_line = (U16) ((PL_parser && PL_parser->copline == NOLINE) ?
-        (PL_curcop ? CopLINE(PL_curcop) : 0) : PL_parser->copline);
+    sv->sv_debug_line = (U16) (PL_parser
+           ?  PL_parser->copline == NOLINE
+               ?  PL_curcop
+                   ? CopLINE(PL_curcop)
+                   : 0
+               : PL_parser->copline
+           : 0);

     sv->sv_debug_inpad = 0;
     sv->sv_debug_cloned = 0;
     sv->sv_debug_file = PL_curcop ? savepv(CopFILE(PL_curcop)): NULL;
     sv->sv_debug_inpad = 0;
     sv->sv_debug_cloned = 0;
     sv->sv_debug_file = PL_curcop ? savepv(CopFILE(PL_curcop)): NULL;


@@ -349,7 +354,7 @@ Perl_sv_add_arena(pTHX_ char *ptr, U32 size, U32 flags)
 #ifdef DEBUGGING
        SvREFCNT(sv) = 0;
 #endif
 #ifdef DEBUGGING
        SvREFCNT(sv) = 0;
 #endif

-       /* Must always set typemask because it's awlays checked in on cleanup
+       /* Must always set typemask because it's always checked in on cleanup

           when the arenas are walked looking for objects.  */
        SvFLAGS(sv) = SVTYPEMASK;
        sv++;
           when the arenas are walked looking for objects.  */
        SvFLAGS(sv) = SVTYPEMASK;
        sv++;


@@ -462,7 +467,8 @@ do_clean_named_objs(pTHX_ SV *sv)
             SvOBJECT(GvSV(sv))) ||
             (GvAV(sv) && SvOBJECT(GvAV(sv))) ||
             (GvHV(sv) && SvOBJECT(GvHV(sv))) ||
             SvOBJECT(GvSV(sv))) ||
             (GvAV(sv) && SvOBJECT(GvAV(sv))) ||
             (GvHV(sv) && SvOBJECT(GvHV(sv))) ||

-            (GvIO(sv) && SvOBJECT(GvIO(sv))) ||
+            /* In certain rare cases GvIOp(sv) can be NULL, which would make SvOBJECT(GvIO(sv)) dereference NULL. */
+            (GvIO(sv) ? (SvFLAGS(GvIOp(sv)) & SVs_OBJECT) : 0) ||

             (GvCV(sv) && SvOBJECT(GvCV(sv))) )
        {
            DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv)));
             (GvCV(sv) && SvOBJECT(GvCV(sv))) )
        {
            DEBUG_D((PerlIO_printf(Perl_debug_log, "Cleaning named glob object:\n "), sv_dump(sv)));


@@ -538,7 +544,8 @@ Perl_sv_clean_all(pTHX)
   memory in the last arena-set (1/2 on average).  In trade, we get
   back the 1st slot in each arena (ie 1.7% of a CV-arena, less for
   smaller types).  The recovery of the wasted space allows use of
   memory in the last arena-set (1/2 on average).  In trade, we get
   back the 1st slot in each arena (ie 1.7% of a CV-arena, less for
   smaller types).  The recovery of the wasted space allows use of

-  small arenas for large, rare body types,
+  small arenas for large, rare body types, by changing array* fields
+  in body_details_by_type[] below.

 */
 struct arena_desc {
     char       *arena;         /* the raw storage, allocated aligned */
 */
 struct arena_desc {
     char       *arena;         /* the raw storage, allocated aligned */


@@ -549,7 +556,7 @@ struct arena_desc {
 struct arena_set;
 
 /* Get the maximum number of elements in set[] such that struct arena_set
 struct arena_set;
 
 /* Get the maximum number of elements in set[] such that struct arena_set

-   will fit within PERL_ARENA_SIZE, which is probabably just under 4K, and
+   will fit within PERL_ARENA_SIZE, which is probably just under 4K, and

    therefore likely to be 1 aligned memory page.  */
 
 #define ARENAS_PER_SET  ((PERL_ARENA_SIZE - sizeof(struct arena_set*) \
    therefore likely to be 1 aligned memory page.  */
 
 #define ARENAS_PER_SET  ((PERL_ARENA_SIZE - sizeof(struct arena_set*) \


@@ -780,16 +787,16 @@ are used for this, except for arena_size.
 For the sv-types that have no bodies, arenas are not used, so those
 PL_body_roots[sv_type] are unused, and can be overloaded.  In
 something of a special case, SVt_NULL is borrowed for HE arenas;
 For the sv-types that have no bodies, arenas are not used, so those
 PL_body_roots[sv_type] are unused, and can be overloaded.  In
 something of a special case, SVt_NULL is borrowed for HE arenas;

-PL_body_roots[SVt_NULL] is filled by S_more_he, but the
+PL_body_roots[HE_SVSLOT=SVt_NULL] is filled by S_more_he, but the

 bodies_by_type[SVt_NULL] slot is not used, as the table is not
 bodies_by_type[SVt_NULL] slot is not used, as the table is not

-available in hv.c,
+available in hv.c.

 
 

-PTEs also use arenas, but are never seen in Perl_sv_upgrade.
-Nonetheless, they get their own slot in bodies_by_type[SVt_NULL], so
-they can just use the same allocation semantics.  At first, PTEs were
-also overloaded to a non-body sv-type, but this yielded hard-to-find
-malloc bugs, so was simplified by claiming a new slot.  This choice
-has no consequence at this time.
+PTEs also use arenas, but are never seen in Perl_sv_upgrade. Nonetheless,
+they get their own slot in bodies_by_type[PTE_SVSLOT =SVt_IV], so they can
+just use the same allocation semantics.  At first, PTEs were also
+overloaded to a non-body sv-type, but this yielded hard-to-find malloc
+bugs, so was simplified by claiming a new slot.  This choice has no
+consequence at this time.

 
 */
 
 
 */
 


@@ -869,7 +876,7 @@ static const struct body_details bodies_by_type[] = {
       FALSE, NONV, NOARENA, FIT_ARENA(0, sizeof(HE)) },
 
     /* The bind placeholder pretends to be an RV for now.
       FALSE, NONV, NOARENA, FIT_ARENA(0, sizeof(HE)) },
 
     /* The bind placeholder pretends to be an RV for now.

-       Also it's marked as "can't upgrade" top stop anyone using it before it's
+       Also it's marked as "can't upgrade" to stop anyone using it before it's

        implemented.  */
     { 0, 0, 0, SVt_BIND, TRUE, NONV, NOARENA, 0 },
 
        implemented.  */
     { 0, 0, 0, SVt_BIND, TRUE, NONV, NOARENA, 0 },
 


@@ -887,9 +894,6 @@ static const struct body_details bodies_by_type[] = {
     { sizeof(NV), sizeof(NV), 0, SVt_NV, FALSE, HADNV, HASARENA,
       FIT_ARENA(0, sizeof(NV)) },
 
     { sizeof(NV), sizeof(NV), 0, SVt_NV, FALSE, HADNV, HASARENA,
       FIT_ARENA(0, sizeof(NV)) },
 

-    /* RVs are in the head now.  */
-    { 0, 0, 0, SVt_RV, FALSE, NONV, NOARENA, 0 },
-

     /* 8 bytes on most ILP32 with IEEE doubles */
     { sizeof(xpv_allocated),
       copy_length(XPV, xpv_len)
     /* 8 bytes on most ILP32 with IEEE doubles */
     { sizeof(xpv_allocated),
       copy_length(XPV, xpv_len)


@@ -911,7 +915,12 @@ static const struct body_details bodies_by_type[] = {
     /* 28 */
     { sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, SVt_PVMG, FALSE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
     /* 28 */
     { sizeof(XPVMG), copy_length(XPVMG, xmg_stash), 0, SVt_PVMG, FALSE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },

-    
+
+    /* 32 */
+    { sizeof(struct xregexp), copy_length(struct xregexp, xrx_regexp), 0,
+      SVt_REGEXP, FALSE, HADNV, HASARENA, FIT_ARENA(0, sizeof(struct xregexp))
+    },
+

     /* 48 */
     { sizeof(XPVGV), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVGV)) },
     /* 48 */
     { sizeof(XPVGV), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV,
       HASARENA, FIT_ARENA(0, sizeof(XPVGV)) },


@@ -1088,6 +1097,9 @@ S_new_body(pTHX_ svtype sv_type)
 
 #endif
 
 
 #endif
 

+static const struct body_details fake_rv =
+    { 0, 0, 0, SVt_IV, FALSE, NONV, NOARENA, 0 };
+

 /*
 =for apidoc sv_upgrade
 
 /*
 =for apidoc sv_upgrade
 


@@ -1106,8 +1118,9 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
     void*      new_body;
     const svtype old_type = SvTYPE(sv);
     const struct body_details *new_type_details;
     void*      new_body;
     const svtype old_type = SvTYPE(sv);
     const struct body_details *new_type_details;

-    const struct body_details *const old_type_details
+    const struct body_details *old_type_details

        = bodies_by_type + old_type;
        = bodies_by_type + old_type;

+    SV *referant = NULL;

 
     if (new_type != SVt_PV && SvIsCOW(sv)) {
        sv_force_normal_flags(sv, 0);
 
     if (new_type != SVt_PV && SvIsCOW(sv)) {
        sv_force_normal_flags(sv, 0);


@@ -1116,11 +1129,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
     if (old_type == new_type)
        return;
 
     if (old_type == new_type)
        return;
 

-    if (old_type > new_type)
-       Perl_croak(aTHX_ "sv_upgrade from type %d down to type %d",
-               (int)old_type, (int)new_type);
-
-

     old_body = SvANY(sv);
 
     /* Copying structures onto other structures that have been neatly zeroed
     old_body = SvANY(sv);
 
     /* Copying structures onto other structures that have been neatly zeroed


@@ -1165,9 +1173,16 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
     case SVt_NULL:
        break;
     case SVt_IV:
     case SVt_NULL:
        break;
     case SVt_IV:

-       if (new_type < SVt_PVIV) {
-           new_type = (new_type == SVt_NV)
-               ? SVt_PVNV : SVt_PVIV;
+       if (SvROK(sv)) {
+           referant = SvRV(sv);
+           old_type_details = &fake_rv;
+           if (new_type == SVt_NV)
+               new_type = SVt_PVNV;
+       } else {
+           if (new_type < SVt_PVIV) {
+               new_type = (new_type == SVt_NV)
+                   ? SVt_PVNV : SVt_PVIV;
+           }

        }
        break;
     case SVt_NV:
        }
        break;
     case SVt_NV:


@@ -1175,8 +1190,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
            new_type = SVt_PVNV;
        }
        break;
            new_type = SVt_PVNV;
        }
        break;

-    case SVt_RV:
-       break;

     case SVt_PV:
        assert(new_type > SVt_PV);
        assert(SVt_IV < SVt_PV);
     case SVt_PV:
        assert(new_type > SVt_PV);
        assert(SVt_IV < SVt_PV);


@@ -1201,6 +1214,11 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
            Perl_croak(aTHX_ "Can't upgrade %s (%" UVuf ") to %" UVuf,
                       sv_reftype(sv, 0), (UV) old_type, (UV) new_type);
     }
            Perl_croak(aTHX_ "Can't upgrade %s (%" UVuf ") to %" UVuf,
                       sv_reftype(sv, 0), (UV) old_type, (UV) new_type);
     }

+
+    if (old_type > new_type)
+       Perl_croak(aTHX_ "sv_upgrade from type %d down to type %d",
+               (int)old_type, (int)new_type);
+

     new_type_details = bodies_by_type + new_type;
 
     SvFLAGS(sv) &= ~SVTYPEMASK;
     new_type_details = bodies_by_type + new_type;
 
     SvFLAGS(sv) &= ~SVTYPEMASK;


@@ -1220,11 +1238,6 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
        SvANY(sv) = new_XNV();
        SvNV_set(sv, 0);
        return;
        SvANY(sv) = new_XNV();
        SvNV_set(sv, 0);
        return;

-    case SVt_RV:
-       assert(old_type == SVt_NULL);
-       SvANY(sv) = &sv->sv_u.svu_rv;
-       SvRV_set(sv, 0);
-       return;

     case SVt_PVHV:
     case SVt_PVAV:
        assert(new_type_details->body_size);
     case SVt_PVHV:
     case SVt_PVAV:
        assert(new_type_details->body_size);


@@ -1246,13 +1259,36 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
            AvMAX(sv)   = -1;
            AvFILLp(sv) = -1;
            AvREAL_only(sv);
            AvMAX(sv)   = -1;
            AvFILLp(sv) = -1;
            AvREAL_only(sv);

+           if (old_type_details->body_size) {
+               AvALLOC(sv) = 0;
+           } else {
+               /* It will have been zeroed when the new body was allocated.
+                  Lets not write to it, in case it confuses a write-back
+                  cache.  */
+           }
+       } else {
+           assert(!SvOK(sv));
+           SvOK_off(sv);
+#ifndef NODEFAULT_SHAREKEYS
+           HvSHAREKEYS_on(sv);         /* key-sharing on by default */
+#endif
+           HvMAX(sv) = 7; /* (start with 8 buckets) */
+           if (old_type_details->body_size) {
+               HvFILL(sv) = 0;
+           } else {
+               /* It will have been zeroed when the new body was allocated.
+                  Lets not write to it, in case it confuses a write-back
+                  cache.  */
+           }

        }
 
        /* SVt_NULL isn't the only thing upgraded to AV or HV.
           The target created by newSVrv also is, and it can have magic.
           However, it never has SvPVX set.
        */
        }
 
        /* SVt_NULL isn't the only thing upgraded to AV or HV.
           The target created by newSVrv also is, and it can have magic.
           However, it never has SvPVX set.
        */

-       if (old_type >= SVt_RV) {
+       if (old_type == SVt_IV) {
+           assert(!SvROK(sv));
+       } else if (old_type >= SVt_PV) {

            assert(SvPVX_const(sv) == 0);
        }
 
            assert(SvPVX_const(sv) == 0);
        }
 


@@ -1275,6 +1311,7 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
     case SVt_PVGV:
     case SVt_PVCV:
     case SVt_PVLV:
     case SVt_PVGV:
     case SVt_PVCV:
     case SVt_PVLV:

+    case SVt_REGEXP:

     case SVt_PVMG:
     case SVt_PVNV:
     case SVt_PV:
     case SVt_PVMG:
     case SVt_PVNV:
     case SVt_PV:


@@ -1323,8 +1360,11 @@ Perl_sv_upgrade(pTHX_ register SV *sv, svtype new_type)
 
        if (new_type == SVt_PVIO)
            IoPAGE_LEN(sv) = 60;
 
        if (new_type == SVt_PVIO)
            IoPAGE_LEN(sv) = 60;

-       if (old_type < SVt_RV)
-           SvPV_set(sv, NULL);
+       if (old_type < SVt_PV) {
+           /* referant will be NULL unless the old type was SVt_IV emulating
+              SVt_RV */
+           sv->sv_u.svu_rv = referant;
+       }

        break;
     default:
        Perl_croak(aTHX_ "panic: sv_upgrade to unknown type %lu",
        break;
     default:
        Perl_croak(aTHX_ "panic: sv_upgrade to unknown type %lu",


@@ -1457,12 +1497,9 @@ Perl_sv_setiv(pTHX_ register SV *sv, IV i)
     SV_CHECK_THINKFIRST_COW_DROP(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:
     SV_CHECK_THINKFIRST_COW_DROP(sv);
     switch (SvTYPE(sv)) {
     case SVt_NULL:

-       sv_upgrade(sv, SVt_IV);
-       break;

     case SVt_NV:
     case SVt_NV:

-       sv_upgrade(sv, SVt_PVNV);
+       sv_upgrade(sv, SVt_IV);

        break;
        break;

-    case SVt_RV:

     case SVt_PV:
        sv_upgrade(sv, SVt_PVIV);
        break;
     case SVt_PV:
        sv_upgrade(sv, SVt_PVIV);
        break;


@@ -1560,7 +1597,6 @@ Perl_sv_setnv(pTHX_ register SV *sv, NV num)
     case SVt_IV:
        sv_upgrade(sv, SVt_NV);
        break;
     case SVt_IV:
        sv_upgrade(sv, SVt_NV);
        break;

-    case SVt_RV:

     case SVt_PV:
     case SVt_PVIV:
        sv_upgrade(sv, SVt_PVNV);
     case SVt_PV:
     case SVt_PVIV:
        sv_upgrade(sv, SVt_PVNV);


@@ -2495,6 +2531,29 @@ Perl_sv_2nv(pTHX_ register SV *sv)
     return SvNVX(sv);
 }
 
     return SvNVX(sv);
 }
 

+/*
+=for apidoc sv_2num
+
+Return an SV with the numeric value of the source SV, doing any necessary
+reference or overload conversion.  You must use the C<SvNUM(sv)> macro to
+access this function.
+
+=cut
+*/
+
+SV *
+Perl_sv_2num(pTHX_ register SV *sv)
+{
+    if (!SvROK(sv))
+       return sv;
+    if (SvAMAGIC(sv)) {
+       SV * const tmpsv = AMG_CALLun(sv,numer);
+       if (tmpsv && (!SvROK(tmpsv) || (SvRV(tmpsv) != SvRV(sv))))
+           return sv_2num(tmpsv);
+    }
+    return sv_2mortal(newSVuv(PTR2UV(SvRV(sv))));
+}
+

 /* uiv_2buf(): private routine for use by sv_2pv_flags(): print an IV or
  * UV as a string towards the end of buf, and return pointers to start and
  * end of it.
 /* uiv_2buf(): private routine for use by sv_2pv_flags(): print an IV or
  * UV as a string towards the end of buf, and return pointers to start and
  * end of it.


@@ -2634,22 +2693,20 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
                STRLEN len;
                char *retval;
                char *buffer;
                STRLEN len;
                char *retval;
                char *buffer;

-               MAGIC *mg;

                const SV *const referent = (SV*)SvRV(sv);
 
                if (!referent) {
                    len = 7;
                    retval = buffer = savepvn("NULLREF", len);
                const SV *const referent = (SV*)SvRV(sv);
 
                if (!referent) {
                    len = 7;
                    retval = buffer = savepvn("NULLREF", len);

-               } 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)))
-                {
+               } else if (SvTYPE(referent) == SVt_REGEXP) {

                     char *str = NULL;
                     I32 haseval = 0;
                     U32 flags = 0;
                     char *str = NULL;
                     I32 haseval = 0;
                     U32 flags = 0;

-                    (str) = CALLREG_AS_STR(mg,lp,&flags,&haseval);
+                   struct magic temp;
+                   temp.mg_obj
+                       = (SV*)((struct xregexp *)SvANY(referent))->xrx_regexp;
+                   assert(temp.mg_obj);
+                    (str) = CALLREG_AS_STR(&temp,lp,&flags,&haseval);

                     if (flags & 1)
                        SvUTF8_on(sv);
                     else
                     if (flags & 1)
                        SvUTF8_on(sv);
                     else


@@ -2734,15 +2791,16 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
        const U32 isUIOK = SvIsUV(sv);
        char buf[TYPE_CHARS(UV)];
        char *ebuf, *ptr;
        const U32 isUIOK = SvIsUV(sv);
        char buf[TYPE_CHARS(UV)];
        char *ebuf, *ptr;

+       STRLEN len;

 
        if (SvTYPE(sv) < SVt_PVIV)
            sv_upgrade(sv, SVt_PVIV);
        ptr = uiv_2buf(buf, SvIVX(sv), SvUVX(sv), isUIOK, &ebuf);
 
        if (SvTYPE(sv) < SVt_PVIV)
            sv_upgrade(sv, SVt_PVIV);
        ptr = uiv_2buf(buf, SvIVX(sv), SvUVX(sv), isUIOK, &ebuf);

+       len = ebuf - ptr;

        /* inlined from sv_setpvn */
        /* inlined from sv_setpvn */

-       SvGROW_mutable(sv, (STRLEN)(ebuf - ptr + 1));
-       Move(ptr,SvPVX_mutable(sv),ebuf - ptr,char);
-       SvCUR_set(sv, ebuf - ptr);
-       s = SvEND(sv);
+       s = SvGROW_mutable(sv, len + 1);
+       Move(ptr, s, len, char);
+       s += len;

        *s = '\0';
     }
     else if (SvNOKp(sv)) {
        *s = '\0';
     }
     else if (SvNOKp(sv)) {


@@ -2762,8 +2820,10 @@ Perl_sv_2pv_flags(pTHX_ register SV *sv, STRLEN *lp, I32 flags)
        }
        errno = olderrno;
 #ifdef FIXNEGATIVEZERO
        }
        errno = olderrno;
 #ifdef FIXNEGATIVEZERO

-        if (*s == '-' && s[1] == '0' && !s[2])
-           my_strlcpy(s, "0", SvLEN(s));
+        if (*s == '-' && s[1] == '0' && !s[2]) {
+           s[0] = '0';
+           s[1] = 0;
+       }

 #endif
        while (*s) s++;
 #ifdef hcx
 #endif
        while (*s) s++;
 #ifdef hcx


@@ -3378,7 +3438,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                sv_upgrade(dstr, SVt_IV);
                break;
            case SVt_NV:
                sv_upgrade(dstr, SVt_IV);
                break;
            case SVt_NV:

-           case SVt_RV:

            case SVt_PV:
                sv_upgrade(dstr, SVt_PVIV);
                break;
            case SVt_PV:
                sv_upgrade(dstr, SVt_PVIV);
                break;


@@ -3396,7 +3455,11 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            assert(!SvTAINTED(sstr));
            return;
        }
            assert(!SvTAINTED(sstr));
            return;
        }

-       goto undef_sstr;
+       if (!SvROK(sstr))
+           goto undef_sstr;
+       if (dtype < SVt_PV && dtype != SVt_IV)
+           sv_upgrade(dstr, SVt_IV);
+       break;

 
     case SVt_NV:
        if (SvNOK(sstr)) {
 
     case SVt_NV:
        if (SvNOK(sstr)) {


@@ -3405,7 +3468,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
            case SVt_IV:
                sv_upgrade(dstr, SVt_NV);
                break;
            case SVt_IV:
                sv_upgrade(dstr, SVt_NV);
                break;

-           case SVt_RV:

            case SVt_PV:
            case SVt_PVIV:
                sv_upgrade(dstr, SVt_PVNV);
            case SVt_PV:
            case SVt_PVIV:
                sv_upgrade(dstr, SVt_PVNV);


@@ -3424,10 +3486,6 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
        }
        goto undef_sstr;
 
        }
        goto undef_sstr;
 

-    case SVt_RV:
-       if (dtype < SVt_RV)
-           sv_upgrade(dstr, SVt_RV);
-       break;

     case SVt_PVFM:
 #ifdef PERL_OLD_COPY_ON_WRITE
        if ((SvFLAGS(sstr) & CAN_COW_MASK) == CAN_COW_FLAGS) {
     case SVt_PVFM:
 #ifdef PERL_OLD_COPY_ON_WRITE
        if ((SvFLAGS(sstr) & CAN_COW_MASK) == CAN_COW_FLAGS) {


@@ -3529,7 +3587,7 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
        }
 
        if (dtype >= SVt_PV) {
        }
 
        if (dtype >= SVt_PV) {

-           if (dtype == SVt_PVGV) {
+           if (dtype == SVt_PVGV && isGV_with_GP(dstr)) {

                glob_assign_ref(dstr, sstr);
                return;
            }
                glob_assign_ref(dstr, sstr);
                return;
            }


@@ -3616,9 +3674,11 @@ Perl_sv_setsv_flags(pTHX_ SV *dstr, register SV *sstr, I32 flags)
                                /* and won't be needed again, potentially */
              !(PL_op && PL_op->op_type == OP_AASSIGN))
 #ifdef PERL_OLD_COPY_ON_WRITE
                                /* and won't be needed again, potentially */
              !(PL_op && PL_op->op_type == OP_AASSIGN))
 #ifdef PERL_OLD_COPY_ON_WRITE

-            && !((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
-                && (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
-                 && SvTYPE(sstr) >= SVt_PVIV)
+            && ((flags & SV_COW_SHARED_HASH_KEYS)
+               ? (!((sflags & CAN_COW_MASK) == CAN_COW_FLAGS
+                    && (SvFLAGS(dstr) & CAN_COW_MASK) == CAN_COW_FLAGS
+                    && SvTYPE(sstr) >= SVt_PVIV))
+               : 1)

 #endif
             ) {
             /* Failed the swipe test, and it's not a shared hash key either.
 #endif
             ) {
             /* Failed the swipe test, and it's not a shared hash key either.


@@ -3998,7 +4058,7 @@ Perl_sv_usepvn_flags(pTHX_ SV *sv, char *ptr, STRLEN len, U32 flags)
     SvCUR_set(sv, len);
     SvLEN_set(sv, allocate);
     if (!(flags & SV_HAS_TRAILING_NUL)) {
     SvCUR_set(sv, len);
     SvLEN_set(sv, allocate);
     if (!(flags & SV_HAS_TRAILING_NUL)) {

-       *SvEND(sv) = '\0';
+       ptr[len] = '\0';

     }
     (void)SvPOK_only_UTF8(sv);         /* validate pointer */
     SvTAINT(sv);
     }
     (void)SvPOK_only_UTF8(sv);         /* validate pointer */
     SvTAINT(sv);


@@ -4992,13 +5052,9 @@ Perl_sv_replace(pTHX_ register SV *sv, register SV *nsv)
 #else
     StructCopy(nsv,sv,SV);
 #endif
 #else
     StructCopy(nsv,sv,SV);
 #endif

-    /* Currently could join these into one piece of pointer arithmetic, but
-       it would be unclear.  */
-    if(SvTYPE(sv) == SVt_IV)
+    if(SvTYPE(sv) == SVt_IV) {

        SvANY(sv)
            = (XPVIV*)((char*)&(sv->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
        SvANY(sv)
            = (XPVIV*)((char*)&(sv->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));

-    else if (SvTYPE(sv) == SVt_RV) {
-       SvANY(sv) = &sv->sv_u.svu_rv;

     }
        
 
     }
        
 


@@ -5060,11 +5116,22 @@ Perl_sv_clear(pTHX_ register SV *sv)
        /* See the comment in sv.h about the collusion between this early
           return and the overloading of the NULL and IV slots in the size
           table.  */
        /* See the comment in sv.h about the collusion between this early
           return and the overloading of the NULL and IV slots in the size
           table.  */

+       if (SvROK(sv)) {
+           SV * const target = SvRV(sv);
+           if (SvWEAKREF(sv))
+               sv_del_backref(target, sv);
+           else
+               SvREFCNT_dec(target);
+       }
+       SvFLAGS(sv) &= SVf_BREAK;
+       SvFLAGS(sv) |= SVTYPEMASK;

        return;
     }
 
     if (SvOBJECT(sv)) {
        return;
     }
 
     if (SvOBJECT(sv)) {

-       if (PL_defstash) {              /* Still have a symbol table? */
+       if (PL_defstash &&      /* Still have a symbol table? */
+           SvDESTROYABLE(sv))
+       {

            dSP;
            HV* stash;
            do {        
            dSP;
            HV* stash;
            do {        


@@ -5138,6 +5205,9 @@ Perl_sv_clear(pTHX_ register SV *sv)
        Safefree(IoFMT_NAME(sv));
        Safefree(IoBOTTOM_NAME(sv));
        goto freescalar;
        Safefree(IoFMT_NAME(sv));
        Safefree(IoBOTTOM_NAME(sv));
        goto freescalar;

+    case SVt_REGEXP:
+       ReREFCNT_dec(((struct xregexp *)SvANY(sv))->xrx_regexp);
+       goto freescalar;

     case SVt_PVCV:
     case SVt_PVFM:
        cv_undef((CV*)sv);
     case SVt_PVCV:
     case SVt_PVFM:
        cv_undef((CV*)sv);


@@ -5188,7 +5258,6 @@ Perl_sv_clear(pTHX_ register SV *sv)
            /* Don't even bother with turning off the OOK flag.  */
        }
     case SVt_PV:
            /* Don't even bother with turning off the OOK flag.  */
        }
     case SVt_PV:

-    case SVt_RV:

        if (SvROK(sv)) {
            SV * const target = SvRV(sv);
            if (SvWEAKREF(sv))
        if (SvROK(sv)) {
            SV * const target = SvRV(sv);
            if (SvWEAKREF(sv))


@@ -5388,7 +5457,7 @@ Perl_sv_len_utf8(pTHX_ register SV *sv)
 
        if (PL_utf8cache) {
            STRLEN ulen;
 
        if (PL_utf8cache) {
            STRLEN ulen;

-           MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : 0;
+           MAGIC *mg = SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL;

 
            if (mg && mg->mg_len != -1) {
                ulen = mg->mg_len;
 
            if (mg && mg->mg_len != -1) {
                ulen = mg->mg_len;


@@ -7050,11 +7119,11 @@ Perl_newSVhek(pTHX_ const HEK *hek)
 
 Creates a new SV with its SvPVX_const pointing to a shared string in the string
 table. If the string does not already exist in the table, it is created
 
 Creates a new SV with its SvPVX_const pointing to a shared string in the string
 table. If the string does not already exist in the table, it is created

-first.  Turns on READONLY and FAKE.  The string's hash is stored in the UV
-slot of the SV; if the C<hash> parameter is non-zero, that value is used;
-otherwise the hash is computed.  The idea here is that as the string table
-is used for shared hash keys these strings will have SvPVX_const == HeKEY and
-hash lookup will avoid string compare.
+first.  Turns on READONLY and FAKE. If the C<hash> parameter is non-zero, that
+value is used; otherwise the hash is computed. The string's hash can be later
+be retrieved from the SV with the C<SvSHARED_HASH()> macro. The idea here is
+that as the string table is used for shared hash keys these strings will have
+SvPVX_const == HeKEY and hash lookup will avoid string compare.

 
 =cut
 */
 
 =cut
 */


@@ -7207,7 +7276,7 @@ Perl_newSVuv(pTHX_ UV u)
 /*
 =for apidoc newSV_type
 
 /*
 =for apidoc newSV_type
 

-Creates a new SV, of the type specificied.  The reference count for the new SV
+Creates a new SV, of the type specified.  The reference count for the new SV

 is set to 1.
 
 =cut
 is set to 1.
 
 =cut


@@ -7236,7 +7305,7 @@ SV *
 Perl_newRV_noinc(pTHX_ SV *tmpRef)
 {
     dVAR;
 Perl_newRV_noinc(pTHX_ SV *tmpRef)
 {
     dVAR;

-    register SV *sv = newSV_type(SVt_RV);
+    register SV *sv = newSV_type(SVt_IV);

     SvTEMP_off(tmpRef);
     SvRV_set(sv, tmpRef);
     SvROK_on(sv);
     SvTEMP_off(tmpRef);
     SvRV_set(sv, tmpRef);
     SvROK_on(sv);


@@ -7598,7 +7667,8 @@ Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags)
            else
                Perl_croak(aTHX_ "Can't coerce readonly %s to string", ref);
        }
            else
                Perl_croak(aTHX_ "Can't coerce readonly %s to string", ref);
        }

-       if (SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM)
+       if ((SvTYPE(sv) > SVt_PVLV && SvTYPE(sv) != SVt_PVFM)
+           || isGV_with_GP(sv))

            Perl_croak(aTHX_ "Can't coerce %s to string in %s", sv_reftype(sv,0),
                OP_NAME(PL_op));
        s = sv_2pv_flags(sv, &len, flags);
            Perl_croak(aTHX_ "Can't coerce %s to string in %s", sv_reftype(sv,0),
                OP_NAME(PL_op));
        s = sv_2pv_flags(sv, &len, flags);


@@ -7612,7 +7682,7 @@ Perl_sv_pvn_force_flags(pTHX_ SV *sv, STRLEN *lp, I32 flags)
            SvGROW(sv, len + 1);
            Move(s,SvPVX(sv),len,char);
            SvCUR_set(sv, len);
            SvGROW(sv, len + 1);
            Move(s,SvPVX(sv),len,char);
            SvCUR_set(sv, len);

-           *SvEND(sv) = '\0';
+           SvPVX(sv)[len] = '\0';

        }
        if (!SvPOK(sv)) {
            SvPOK_on(sv);               /* validate pointer */
        }
        if (!SvPOK(sv)) {
            SvPOK_on(sv);               /* validate pointer */


@@ -7680,7 +7750,6 @@ Perl_sv_reftype(pTHX_ const SV *sv, int ob)
        case SVt_NULL:
        case SVt_IV:
        case SVt_NV:
        case SVt_NULL:
        case SVt_IV:
        case SVt_NV:

-       case SVt_RV:

        case SVt_PV:
        case SVt_PVIV:
        case SVt_PVNV:
        case SVt_PV:
        case SVt_PVIV:
        case SVt_PVNV:


@@ -7704,6 +7773,7 @@ Perl_sv_reftype(pTHX_ const SV *sv, int ob)
        case SVt_PVFM:          return "FORMAT";
        case SVt_PVIO:          return "IO";
        case SVt_BIND:          return "BIND";
        case SVt_PVFM:          return "FORMAT";
        case SVt_PVIO:          return "IO";
        case SVt_BIND:          return "BIND";

+       case SVt_REGEXP:        return "Regexp"; /* FIXME? to "REGEXP"  */

        default:                return "UNKNOWN";
        }
     }
        default:                return "UNKNOWN";
        }
     }


@@ -7791,15 +7861,11 @@ Perl_newSVrv(pTHX_ SV *rv, const char *classname)
        SvFLAGS(rv) = 0;
        SvREFCNT(rv) = refcnt;
 
        SvFLAGS(rv) = 0;
        SvREFCNT(rv) = refcnt;
 

-       sv_upgrade(rv, SVt_RV);
+       sv_upgrade(rv, SVt_IV);

     } else if (SvROK(rv)) {
        SvREFCNT_dec(SvRV(rv));
     } else if (SvROK(rv)) {
        SvREFCNT_dec(SvRV(rv));

-    } else if (SvTYPE(rv) < SVt_RV)
-       sv_upgrade(rv, SVt_RV);
-    else if (SvTYPE(rv) > SVt_RV) {
-       SvPV_free(rv);
-       SvCUR_set(rv, 0);
-       SvLEN_set(rv, 0);
+    } else {
+       prepare_SV_for_RV(rv);

     }
 
     SvOK_off(rv);
     }
 
     SvOK_off(rv);


@@ -7942,6 +8008,8 @@ Perl_sv_bless(pTHX_ SV *sv, HV *stash)
         Perl_croak(aTHX_ "Can't bless non-reference value");
     tmpRef = SvRV(sv);
     if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) {
         Perl_croak(aTHX_ "Can't bless non-reference value");
     tmpRef = SvRV(sv);
     if (SvFLAGS(tmpRef) & (SVs_OBJECT|SVf_READONLY)) {

+       if (SvIsCOW(tmpRef))
+           sv_force_normal_flags(tmpRef, 0);

        if (SvREADONLY(tmpRef))
            Perl_croak(aTHX_ PL_no_modify);
        if (SvOBJECT(tmpRef)) {
        if (SvREADONLY(tmpRef))
            Perl_croak(aTHX_ PL_no_modify);
        if (SvOBJECT(tmpRef)) {


@@ -8592,10 +8660,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                %p              include pointer address (standard)      
                %-p     (SVf)   include an SV (previously %_)
                %-<num>p        include an SV with precision <num>      
                %p              include pointer address (standard)      
                %-p     (SVf)   include an SV (previously %_)
                %-<num>p        include an SV with precision <num>      

-               %1p     (VDf)   include a v-string (as %vd)

                %<num>p         reserved for future extensions
 
        Robin Barker 2005-07-14
                %<num>p         reserved for future extensions
 
        Robin Barker 2005-07-14

+
+               %1p     (VDf)   removed.  RMB 2007-10-19

 */
            char* r = q; 
            bool sv = FALSE;    
 */
            char* r = q; 
            bool sv = FALSE;    


@@ -8615,13 +8684,6 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                        is_utf8 = TRUE;
                    goto string;
                }
                        is_utf8 = TRUE;
                    goto string;
                }

-#if vdNUMBER
-               else if (n == vdNUMBER) {       /* VDf */
-                   vectorize = TRUE;
-                   VECTORIZE_ARGS
-                   goto format_vd;
-               }
-#endif

                else if (n) {
                    if (ckWARN_d(WARN_INTERNAL))
                        Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
                else if (n) {
                    if (ckWARN_d(WARN_INTERNAL))
                        Perl_warner(aTHX_ packWARN(WARN_INTERNAL),


@@ -9185,7 +9247,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
                : SvNV(argsv);
 
            need = 0;
                : SvNV(argsv);
 
            need = 0;

-           if (c != 'e' && c != 'E') {
+           /* nv * 0 will be NaN for NaN, +Inf and -Inf, and 0 for anything
+              else. frexp() has some unspecified behaviour for those three */
+           if (c != 'e' && c != 'E' && (nv * 0) == 0) {

                i = PERL_INT_MIN;
                /* FIXME: if HAS_LONG_DOUBLE but not USE_LONG_DOUBLE this
                   will cast our (long double) to (double) */
                i = PERL_INT_MIN;
                /* FIXME: if HAS_LONG_DOUBLE but not USE_LONG_DOUBLE this
                   will cast our (long double) to (double) */


@@ -9486,7 +9550,7 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 All the macros and functions in this section are for the private use of
 the main function, perl_clone().
 
 All the macros and functions in this section are for the private use of
 the main function, perl_clone().
 

-The foo_dup() functions make an exact copy of an existing foo thinngy.
+The foo_dup() functions make an exact copy of an existing foo thingy.

 During the course of a cloning, a hash table is used to map old addresses
 to new addresses. The table is created and manipulated with the
 ptr_table_* functions.
 During the course of a cloning, a hash table is used to map old addresses
 to new addresses. The table is created and manipulated with the
 ptr_table_* functions.


@@ -9959,10 +10023,7 @@ Perl_rvpv_dup(pTHX_ SV *dstr, const SV *sstr, CLONE_PARAMS* param)
     }
     else {
        /* Copy the NULL */
     }
     else {
        /* Copy the NULL */

-       if (SvTYPE(dstr) == SVt_RV)
-           SvRV_set(dstr, NULL);
-       else
-           SvPV_set(dstr, NULL);
+       SvPV_set(dstr, NULL);

     }
 }
 
     }
 }
 


@@ -9985,10 +10046,10 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
         /** We are joining here so we don't want do clone
            something that is bad **/
        if (SvTYPE(sstr) == SVt_PVHV) {
         /** We are joining here so we don't want do clone
            something that is bad **/
        if (SvTYPE(sstr) == SVt_PVHV) {

-           const char * const hvname = HvNAME_get(sstr);
+           const HEK * const hvname = HvNAME_HEK(sstr);

            if (hvname)
                /** don't clone stashes if they already exist **/
            if (hvname)
                /** don't clone stashes if they already exist **/

-               return (SV*)gv_stashpv(hvname,0);
+               return (SV*)gv_stashpvn(HEK_KEY(hvname), HEK_LEN(hvname), 0);

         }
     }
 
         }
     }
 


@@ -10018,8 +10079,7 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
 
     /* don't clone objects whose class has asked us not to */
     if (SvOBJECT(sstr) && ! (SvFLAGS(SvSTASH(sstr)) & SVphv_CLONEABLE)) {
 
     /* don't clone objects whose class has asked us not to */
     if (SvOBJECT(sstr) && ! (SvFLAGS(SvSTASH(sstr)) & SVphv_CLONEABLE)) {

-       SvFLAGS(dstr) &= ~SVTYPEMASK;
-       SvOBJECT_off(dstr);
+       SvFLAGS(dstr) = 0;

        return dstr;
     }
 
        return dstr;
     }
 


@@ -10029,16 +10089,16 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
        break;
     case SVt_IV:
        SvANY(dstr)     = (XPVIV*)((char*)&(dstr->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));
        break;
     case SVt_IV:
        SvANY(dstr)     = (XPVIV*)((char*)&(dstr->sv_u.svu_iv) - STRUCT_OFFSET(XPVIV, xiv_iv));

-       SvIV_set(dstr, SvIVX(sstr));
+       if(SvROK(sstr)) {
+           Perl_rvpv_dup(aTHX_ dstr, sstr, param);
+       } else {
+           SvIV_set(dstr, SvIVX(sstr));
+       }

        break;
     case SVt_NV:
        SvANY(dstr)     = new_XNV();
        SvNV_set(dstr, SvNVX(sstr));
        break;
        break;
     case SVt_NV:
        SvANY(dstr)     = new_XNV();
        SvNV_set(dstr, SvNVX(sstr));
        break;

-    case SVt_RV:
-       SvANY(dstr)     = &(dstr->sv_u.svu_rv);
-       Perl_rvpv_dup(aTHX_ dstr, sstr, param);
-       break;

        /* case SVt_BIND: */
     default:
        {
        /* case SVt_BIND: */
     default:
        {


@@ -10063,6 +10123,7 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
            case SVt_PVAV:
            case SVt_PVCV:
            case SVt_PVLV:
            case SVt_PVAV:
            case SVt_PVCV:
            case SVt_PVLV:

+           case SVt_REGEXP:

            case SVt_PVMG:
            case SVt_PVNV:
            case SVt_PVIV:
            case SVt_PVMG:
            case SVt_PVNV:
            case SVt_PVIV:


@@ -10117,6 +10178,11 @@ Perl_sv_dup(pTHX_ const SV *sstr, CLONE_PARAMS* param)
                break;
            case SVt_PVMG:
                break;
                break;
            case SVt_PVMG:
                break;

+           case SVt_REGEXP:
+               ((struct xregexp *)SvANY(dstr))->xrx_regexp
+                   = CALLREGDUPE(((struct xregexp *)SvANY(dstr))->xrx_regexp,
+                                 param);
+               break;

            case SVt_PVLV:
                /* XXX LvTARGOFF sometimes holds PMOP* when DEBUGGING */
                if (LvTYPE(dstr) == 't') /* for tie: unrefcnted fake (SV**) */
            case SVt_PVLV:
                /* XXX LvTARGOFF sometimes holds PMOP* when DEBUGGING */
                if (LvTYPE(dstr) == 't') /* for tie: unrefcnted fake (SV**) */


@@ -10897,6 +10963,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_savestack_ix = 0;
     PL_savestack_max = -1;
     PL_sig_pending = 0;
     PL_savestack_ix = 0;
     PL_savestack_max = -1;
     PL_sig_pending = 0;

+    PL_parser = NULL;

     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
 #  else        /* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);
     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
 #  else        /* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);


@@ -10931,6 +10998,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_savestack_ix = 0;
     PL_savestack_max = -1;
     PL_sig_pending = 0;
     PL_savestack_ix = 0;
     PL_savestack_max = -1;
     PL_sig_pending = 0;

+    PL_parser = NULL;

     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
 #    else      /* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);
     Zero(&PL_debug_pad, 1, struct perl_debug_pad);
 #    else      /* !DEBUGGING */
     Zero(my_perl, 1, PerlInterpreter);


@@ -11136,7 +11204,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_DBsingle                = sv_dup(proto_perl->IDBsingle, param);
     PL_DBtrace         = sv_dup(proto_perl->IDBtrace, param);
     PL_DBsignal                = sv_dup(proto_perl->IDBsignal, param);
     PL_DBsingle                = sv_dup(proto_perl->IDBsingle, param);
     PL_DBtrace         = sv_dup(proto_perl->IDBtrace, param);
     PL_DBsignal                = sv_dup(proto_perl->IDBsignal, param);

-    PL_DBassertion      = sv_dup(proto_perl->IDBassertion, param);

     PL_dbargs          = av_dup(proto_perl->Idbargs, param);
 
     /* symbol tables */
     PL_dbargs          = av_dup(proto_perl->Idbargs, param);
 
     /* symbol tables */


@@ -11157,7 +11224,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_sub_generation  = proto_perl->Isub_generation;
     PL_isarev          = hv_dup_inc(proto_perl->Iisarev, param);
 
     PL_sub_generation  = proto_perl->Isub_generation;
     PL_isarev          = hv_dup_inc(proto_perl->Iisarev, param);

-    PL_delayedisa      = hv_dup_inc(proto_perl->Idelayedisa, param);

 
     /* funky return mechanisms */
     PL_forkprocess     = proto_perl->Iforkprocess;
 
     /* funky return mechanisms */
     PL_forkprocess     = proto_perl->Iforkprocess;


@@ -11260,11 +11326,6 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_runops          = proto_perl->Irunops;
 
 
     PL_runops          = proto_perl->Irunops;
 

-#ifdef CSH
-    PL_cshlen          = proto_perl->Icshlen;
-    PL_cshname         = proto_perl->Icshname; /* XXX never deallocated */
-#endif
-

     PL_parser          = parser_dup(proto_perl->Iparser, param);
 
     PL_subline         = proto_perl->Isubline;
     PL_parser          = parser_dup(proto_perl->Iparser, param);
 
     PL_subline         = proto_perl->Isubline;


@@ -11341,6 +11402,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
     PL_lockhook                = proto_perl->Ilockhook;
     PL_unlockhook      = proto_perl->Iunlockhook;
     PL_threadhook      = proto_perl->Ithreadhook;
     PL_lockhook                = proto_perl->Ilockhook;
     PL_unlockhook      = proto_perl->Iunlockhook;
     PL_threadhook      = proto_perl->Ithreadhook;

+    PL_destroyhook     = proto_perl->Idestroyhook;

 
 #ifdef THREADS_HAVE_PIDS
     PL_ppid            = proto_perl->Ippid;
 
 #ifdef THREADS_HAVE_PIDS
     PL_ppid            = proto_perl->Ippid;


@@ -11454,7 +11516,7 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
 
     PL_Sv              = NULL;
     PL_Xpv             = (XPV*)NULL;
 
     PL_Sv              = NULL;
     PL_Xpv             = (XPV*)NULL;

-    PL_na              = proto_perl->Ina;
+    my_perl->Ina       = proto_perl->Ina;

 
     PL_statbuf         = proto_perl->Istatbuf;
     PL_statcache       = proto_perl->Istatcache;
 
     PL_statbuf         = proto_perl->Istatbuf;
     PL_statcache       = proto_perl->Istatcache;


@@ -12064,10 +12126,23 @@ S_find_uninit_var(pTHX_ OP* obase, SV* uninit_sv, bool match)
 
     case OP_RV2SV:
     case OP_CUSTOM:
 
     case OP_RV2SV:
     case OP_CUSTOM:

-    case OP_ENTERSUB:

        match = 1; /* XS or custom code could trigger random warnings */
        goto do_op;
 
        match = 1; /* XS or custom code could trigger random warnings */
        goto do_op;
 

+    case OP_ENTERSUB:
+    case OP_GOTO:
+       /* XXX tmp hack: these two may call an XS sub, and currently
+         XS subs don't have a SUB entry on the context stack, so CV and
+         pad determination goes wrong, and BAD things happen. So, just
+         don't try to determine the value under those circumstances.
+         Need a better fix at dome point. DAPM 11/2007 */
+       break;
+
+    case OP_POS:
+       /* def-ness of rval pos() is independent of the def-ness of its arg */
+       if ( !(obase->op_flags & OPf_MOD))
+           break;
+

     case OP_SCHOMP:
     case OP_CHOMP:
        if (SvROK(PL_rs) && uninit_sv == SvRV(PL_rs))
     case OP_SCHOMP:
     case OP_CHOMP:
        if (SvROK(PL_rs) && uninit_sv == SvRV(PL_rs))