This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
support for C<exists &func> (from Spider Boardman)
[perl5.git] / pp.c
diff --git a/pp.c b/pp.c
index 6b71e8c..267da99 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -241,25 +241,30 @@ PP(pp_rv2gv)
                 * NI-S 1999/05/07
                 */ 
                if (PL_op->op_private & OPpDEREF) {
-                   GV *gv = (GV *) newSV(0);
-                   STRLEN len = 0;
-                   char *name = "";
-                   if (cUNOP->op_first->op_type == OP_PADSV) {
-                       SV *padname = *av_fetch(PL_comppad_name, cUNOP->op_first->op_targ, 4);
-                       name = SvPV(padname,len);                                                    
+                   char *name;
+                   GV *gv;
+                   if (cUNOP->op_targ) {
+                       STRLEN len;
+                       SV *namesv = PL_curpad[cUNOP->op_targ];
+                       name = SvPV(namesv, len);
+                       gv = (GV*)NEWSV(0,0);
+                       gv_init(gv, CopSTASH(PL_curcop), name, len, 0);
+                   }
+                   else {
+                       name = CopSTASHPV(PL_curcop);
+                       gv = newGVgen(name);
                    }
-                   gv_init(gv, PL_curcop->cop_stash, name, len, 0);
                    sv_upgrade(sv, SVt_RV);
-                   SvRV(sv) = (SV *) gv;
+                   SvRV(sv) = (SV*)gv;
                    SvROK_on(sv);
                    SvSETMAGIC(sv);
                    goto wasref;
-               }  
+               }
                if (PL_op->op_flags & OPf_REF ||
                    PL_op->op_private & HINT_STRICT_REFS)
                    DIE(aTHX_ PL_no_usym, "a symbol");
                if (ckWARN(WARN_UNINITIALIZED))
-                   Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+                   report_uninit();
                RETSETUNDEF;
            }
            sym = SvPV(sv, n_a);
@@ -315,7 +320,7 @@ PP(pp_rv2sv)
                    PL_op->op_private & HINT_STRICT_REFS)
                    DIE(aTHX_ PL_no_usym, "a SCALAR");
                if (ckWARN(WARN_UNINITIALIZED))
-                   Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
+                   report_uninit();
                RETSETUNDEF;
            }
            sym = SvPV(sv, n_a);
@@ -407,7 +412,7 @@ PP(pp_rv2cv)
        if (CvCLONE(cv))
            cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
        if ((PL_op->op_private & OPpLVAL_INTRO) && !CvLVALUE(cv))
-           Perl_croak(aTHX_ "Can't modify non-lvalue subroutine call");
+           DIE(aTHX_ "Can't modify non-lvalue subroutine call");
     }
     else
        cv = (CV*)&PL_sv_undef;
@@ -469,7 +474,7 @@ PP(pp_prototype)
                goto set;
            else {                      /* None such */
              nonesuch:
-               Perl_croak(aTHX_ "Can't find an opnumber for \"%s\"", s+6);
+               DIE(aTHX_ "Can't find an opnumber for \"%s\"", s+6);
            }
        }
     }
@@ -530,6 +535,12 @@ S_refto(pTHX_ SV *sv)
        else
            (void)SvREFCNT_inc(sv);
     }
+    else if (SvTYPE(sv) == SVt_PVAV) {
+       if (!AvREAL((AV*)sv) && AvREIFY((AV*)sv))
+           av_reify((AV*)sv);
+       SvTEMP_off(sv);
+       (void)SvREFCNT_inc(sv);
+    }
     else if (SvPADTMP(sv))
        sv = newSVsv(sv);
     else {
@@ -569,7 +580,7 @@ PP(pp_bless)
     HV *stash;
 
     if (MAXARG == 1)
-       stash = PL_curcop->cop_stash;
+       stash = CopSTASH(PL_curcop);
     else {
        SV *ssv = POPs;
        STRLEN len;
@@ -842,7 +853,7 @@ PP(pp_undef)
            Newz(602, gp, 1, GP);
            GvGP(sv) = gp_ref(gp);
            GvSV(sv) = NEWSV(72,0);
-           GvLINE(sv) = PL_curcop->cop_line;
+           GvLINE(sv) = CopLINE(PL_curcop);
            GvEGV(sv) = (GV*)sv;
            GvMULTI_on(sv);
        }
@@ -865,7 +876,7 @@ PP(pp_predec)
 {
     djSP;
     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
-       Perl_croak(aTHX_ PL_no_modify);
+       DIE(aTHX_ PL_no_modify);
     if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
        SvIVX(TOPs) != IV_MIN)
     {
@@ -882,7 +893,7 @@ PP(pp_postinc)
 {
     djSP; dTARGET;
     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
-       Perl_croak(aTHX_ PL_no_modify);
+       DIE(aTHX_ PL_no_modify);
     sv_setsv(TARG, TOPs);
     if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
        SvIVX(TOPs) != IV_MAX)
@@ -903,7 +914,7 @@ PP(pp_postdec)
 {
     djSP; dTARGET;
     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
-       Perl_croak(aTHX_ PL_no_modify);
+       DIE(aTHX_ PL_no_modify);
     sv_setsv(TARG, TOPs);
     if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
        SvIVX(TOPs) != IV_MIN)
@@ -1777,10 +1788,10 @@ S_seed(pTHX)
     u = (U32)SEED_C1 * when;
 #  endif
 #endif
-    u += SEED_C3 * (U32)getpid();
-    u += SEED_C4 * (U32)(UV)PTR_CAST PL_stack_sp;
+    u += SEED_C3 * (U32)PerlProc_getpid();
+    u += SEED_C4 * (U32)PTR2UV(PL_stack_sp);
 #ifndef PLAN9           /* XXX Plan9 assembler chokes on this; fix needed  */
-    u += SEED_C5 * (U32)(UV)PTR_CAST &when;
+    u += SEED_C5 * (U32)PTR2UV(&when);
 #endif
     return u;
 }
@@ -2010,7 +2021,9 @@ PP(pp_substr)
            sv_pos_u2b(sv, &pos, &rem);
        tmps += pos;
        sv_setpvn(TARG, tmps, rem);
-       if (lvalue) {                   /* it's an lvalue! */
+       if (repl)
+           sv_insert(sv, pos, rem, repl, repl_len);
+       else if (lvalue) {              /* it's an lvalue! */
            if (!SvGMAGICAL(sv)) {
                if (SvROK(sv)) {
                    STRLEN n_a;
@@ -2039,8 +2052,6 @@ PP(pp_substr)
            LvTARGOFF(TARG) = pos;
            LvTARGLEN(TARG) = rem;
        }
-       else if (repl)
-           sv_insert(sv, pos, rem, repl, repl_len);
     }
     SPAGAIN;
     PUSHs(TARG);               /* avoid SvSETMAGIC here */
@@ -2250,7 +2261,7 @@ PP(pp_ucfirst)
        
        tend = uv_to_utf8(tmpbuf, uv);
 
-       if (!SvPADTMP(sv) || tend - tmpbuf != ulen) {
+       if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
            dTARGET;
            sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
            sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
@@ -2262,7 +2273,7 @@ PP(pp_ucfirst)
        }
     }
     else {
-       if (!SvPADTMP(sv)) {
+       if (!SvPADTMP(sv) || SvREADONLY(sv)) {
            dTARGET;
            sv_setsv(TARG, sv);
            sv = TARG;
@@ -2307,7 +2318,7 @@ PP(pp_lcfirst)
        
        tend = uv_to_utf8(tmpbuf, uv);
 
-       if (!SvPADTMP(sv) || tend - tmpbuf != ulen) {
+       if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
            dTARGET;
            sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
            sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
@@ -2319,7 +2330,7 @@ PP(pp_lcfirst)
        }
     }
     else {
-       if (!SvPADTMP(sv)) {
+       if (!SvPADTMP(sv) || SvREADONLY(sv)) {
            dTARGET;
            sv_setsv(TARG, sv);
            sv = TARG;
@@ -2386,7 +2397,7 @@ PP(pp_uc)
        }
     }
     else {
-       if (!SvPADTMP(sv)) {
+       if (!SvPADTMP(sv) || SvREADONLY(sv)) {
            dTARGET;
            sv_setsv(TARG, sv);
            sv = TARG;
@@ -2457,7 +2468,7 @@ PP(pp_lc)
        }
     }
     else {
-       if (!SvPADTMP(sv)) {
+       if (!SvPADTMP(sv) || SvREADONLY(sv)) {
            dTARGET;
            sv_setsv(TARG, sv);
            sv = TARG;
@@ -2636,13 +2647,28 @@ PP(pp_delete)
        U32 hvtype;
        hv = (HV*)POPs;
        hvtype = SvTYPE(hv);
-       while (++MARK <= SP) {
-           if (hvtype == SVt_PVHV)
+       if (hvtype == SVt_PVHV) {                       /* hash element */
+           while (++MARK <= SP) {
                sv = hv_delete_ent(hv, *MARK, discard, 0);
-           else
-               DIE(aTHX_ "Not a HASH reference");
-           *MARK = sv ? sv : &PL_sv_undef;
+               *MARK = sv ? sv : &PL_sv_undef;
+           }
        }
+       else if (hvtype == SVt_PVAV) {
+           if (PL_op->op_flags & OPf_SPECIAL) {        /* array element */
+               while (++MARK <= SP) {
+                   sv = av_delete((AV*)hv, SvIV(*MARK), discard);
+                   *MARK = sv ? sv : &PL_sv_undef;
+               }
+           }
+           else {                                      /* pseudo-hash element */
+               while (++MARK <= SP) {
+                   sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0);
+                   *MARK = sv ? sv : &PL_sv_undef;
+               }
+           }
+       }
+       else
+           DIE(aTHX_ "Not a HASH reference");
        if (discard)
            SP = ORIGMARK;
        else if (gimme == G_SCALAR) {
@@ -2656,6 +2682,12 @@ PP(pp_delete)
        hv = (HV*)POPs;
        if (SvTYPE(hv) == SVt_PVHV)
            sv = hv_delete_ent(hv, keysv, discard, 0);
+       else if (SvTYPE(hv) == SVt_PVAV) {
+           if (PL_op->op_flags & OPf_SPECIAL)
+               sv = av_delete((AV*)hv, SvIV(keysv), discard);
+           else
+               sv = avhv_delete_ent((AV*)hv, keysv, discard, 0);
+       }
        else
            DIE(aTHX_ "Not a HASH reference");
        if (!sv)
@@ -2669,14 +2701,32 @@ PP(pp_delete)
 PP(pp_exists)
 {
     djSP;
-    SV *tmpsv = POPs;
-    HV *hv = (HV*)POPs;
+    SV *tmpsv;
+    HV *hv;
+
+    if (PL_op->op_private & OPpEXISTS_SUB) {
+       GV *gv;
+       CV *cv;
+       SV *sv = POPs;
+       cv = sv_2cv(sv, &hv, &gv, FALSE);
+       if (cv)
+           RETPUSHYES;
+       if (gv && isGV(gv) && GvCV(gv) && !GvCVGEN(gv))
+           RETPUSHYES;
+       RETPUSHNO;
+    }
+    tmpsv = POPs;
+    hv = (HV*)POPs;
     if (SvTYPE(hv) == SVt_PVHV) {
        if (hv_exists_ent(hv, tmpsv, 0))
            RETPUSHYES;
     }
     else if (SvTYPE(hv) == SVt_PVAV) {
-       if (avhv_exists_ent((AV*)hv, tmpsv, 0))
+       if (PL_op->op_flags & OPf_SPECIAL) {            /* array element */
+           if (av_exists((AV*)hv, SvIV(tmpsv)))
+               RETPUSHYES;
+       }
+       else if (avhv_exists_ent((AV*)hv, tmpsv, 0))    /* pseudo-hash element */
            RETPUSHYES;
     }
     else {
@@ -3124,6 +3174,7 @@ PP(pp_reverse)
            *MARK++ = *SP;
            *SP-- = tmp;
        }
+       /* safe as long as stack cannot get extended in the above */
        SP = oldsp;
     }
     else {
@@ -3224,7 +3275,7 @@ PP(pp_unpack)
 {
     djSP;
     dPOPPOPssrl;
-    SV **oldsp = SP;
+    I32 start_sp_offset = SP - PL_stack_base;
     I32 gimme = GIMME_V;
     SV *sv;
     STRLEN llen;
@@ -3237,6 +3288,7 @@ PP(pp_unpack)
     I32 datumtype;
     register I32 len;
     register I32 bits;
+    register char *str;
 
     /* These must not be in registers: */
     I16 ashort;
@@ -3258,6 +3310,7 @@ PP(pp_unpack)
     register U32 culong;
     NV cdouble;
     int commas = 0;
+    int star;
 #ifdef PERL_NATINT_PACK
     int natint;                /* native integer */
     int unatint;       /* unsigned native integer */
@@ -3282,6 +3335,11 @@ PP(pp_unpack)
 #endif
        if (isSPACE(datumtype))
            continue;
+       if (datumtype == '#') {
+           while (pat < patend && *pat != '\n')
+               pat++;
+           continue;
+       }
        if (*pat == '!') {
            char *natstr = "sSiIlL";
 
@@ -3292,30 +3350,34 @@ PP(pp_unpack)
                pat++;
            }
            else
-               Perl_croak(aTHX_ "'!' allowed only after types %s", natstr);
+               DIE(aTHX_ "'!' allowed only after types %s", natstr);
        }
+       star = 0;
        if (pat >= patend)
            len = 1;
        else if (*pat == '*') {
            len = strend - strbeg;      /* long enough */
            pat++;
+           star = 1;
        }
        else if (isDIGIT(*pat)) {
            len = *pat++ - '0';
            while (isDIGIT(*pat)) {
                len = (len * 10) + (*pat++ - '0');
                if (len < 0)
-                   Perl_croak(aTHX_ "Repeat count in unpack overflows");
+                   DIE(aTHX_ "Repeat count in unpack overflows");
            }
        }
        else
            len = (datumtype != '@');
+      redo_switch:
        switch(datumtype) {
        default:
-           Perl_croak(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
+           DIE(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
        case ',': /* grandfather in commas but with a warning */
            if (commas++ == 0 && ckWARN(WARN_UNSAFE))
-               Perl_warner(aTHX_ WARN_UNSAFE, "Invalid type in unpack: '%c'", (int)datumtype);
+               Perl_warner(aTHX_ WARN_UNSAFE,
+                           "Invalid type in unpack: '%c'", (int)datumtype);
            break;
        case '%':
            if (len == 1 && pat[-1] != '1')
@@ -3341,18 +3403,17 @@ PP(pp_unpack)
                DIE(aTHX_ "x outside of string");
            s += len;
            break;
-       case '#':
-           if (oldsp >= SP)
-               DIE(aTHX_ "# must follow a numeric type");
-           if (*pat != 'a' && *pat != 'A' && *pat != 'Z')
-               DIE(aTHX_ "# must be followed by a, A or Z");
+       case '/':
+           if (start_sp_offset >= SP - PL_stack_base)
+               DIE(aTHX_ "/ must follow a numeric type");
            datumtype = *pat++;
            if (*pat == '*')
                pat++;          /* ignore '*' for compatibility with pack */
            if (isDIGIT(*pat))
-               DIE(aTHX_ "# cannot take a count" );
+               DIE(aTHX_ "/ cannot take a count" );
            len = POPi;
-           /* drop through */
+           star = 0;
+           goto redo_switch;
        case 'A':
        case 'Z':
        case 'a':
@@ -3383,7 +3444,7 @@ PP(pp_unpack)
            break;
        case 'B':
        case 'b':
-           if (pat[-1] == '*' || len > (strend - s) * 8)
+           if (star || len > (strend - s) * 8)
                len = (strend - s) * 8;
            if (checksum) {
                if (!PL_bitcount) {
@@ -3423,8 +3484,7 @@ PP(pp_unpack)
            sv = NEWSV(35, len + 1);
            SvCUR_set(sv, len);
            SvPOK_on(sv);
-           aptr = pat;                 /* borrow register */
-           pat = SvPVX(sv);
+           str = SvPVX(sv);
            if (datumtype == 'b') {
                aint = len;
                for (len = 0; len < aint; len++) {
@@ -3432,7 +3492,7 @@ PP(pp_unpack)
                        bits >>= 1;
                    else
                        bits = *s++;
-                   *pat++ = '0' + (bits & 1);
+                   *str++ = '0' + (bits & 1);
                }
            }
            else {
@@ -3442,22 +3502,20 @@ PP(pp_unpack)
                        bits <<= 1;
                    else
                        bits = *s++;
-                   *pat++ = '0' + ((bits & 128) != 0);
+                   *str++ = '0' + ((bits & 128) != 0);
                }
            }
-           *pat = '\0';
-           pat = aptr;                 /* unborrow register */
+           *str = '\0';
            XPUSHs(sv_2mortal(sv));
            break;
        case 'H':
        case 'h':
-           if (pat[-1] == '*' || len > (strend - s) * 2)
+           if (star || len > (strend - s) * 2)
                len = (strend - s) * 2;
            sv = NEWSV(35, len + 1);
            SvCUR_set(sv, len);
            SvPOK_on(sv);
-           aptr = pat;                 /* borrow register */
-           pat = SvPVX(sv);
+           str = SvPVX(sv);
            if (datumtype == 'h') {
                aint = len;
                for (len = 0; len < aint; len++) {
@@ -3465,7 +3523,7 @@ PP(pp_unpack)
                        bits >>= 4;
                    else
                        bits = *s++;
-                   *pat++ = PL_hexdigit[bits & 15];
+                   *str++ = PL_hexdigit[bits & 15];
                }
            }
            else {
@@ -3475,11 +3533,10 @@ PP(pp_unpack)
                        bits <<= 4;
                    else
                        bits = *s++;
-                   *pat++ = PL_hexdigit[(bits >> 4) & 15];
+                   *str++ = PL_hexdigit[(bits >> 4) & 15];
                }
            }
-           *pat = '\0';
-           pat = aptr;                 /* unborrow register */
+           *str = '\0';
            XPUSHs(sv_2mortal(sv));
            break;
        case 'c':
@@ -3981,7 +4038,7 @@ PP(pp_unpack)
                    }
                }
                if ((s >= strend) && bytes)
-                   Perl_croak(aTHX_ "Unterminated compressed integer");
+                   DIE(aTHX_ "Unterminated compressed integer");
            }
            break;
        case 'P':
@@ -4183,7 +4240,7 @@ PP(pp_unpack)
            checksum = 0;
        }
     }
-    if (SP == oldsp && gimme == G_SCALAR)
+    if (SP - PL_stack_base == start_sp_offset && gimme == G_SCALAR)
        PUSHs(&PL_sv_undef);
     RETURN;
 }
@@ -4339,6 +4396,11 @@ PP(pp_pack)
 #endif
        if (isSPACE(datumtype))
            continue;
+       if (datumtype == '#') {
+           while (pat < patend && *pat != '\n')
+               pat++;
+           continue;
+       }
         if (*pat == '!') {
            char *natstr = "sSiIlL";
 
@@ -4349,7 +4411,7 @@ PP(pp_pack)
                pat++;
            }
            else
-               Perl_croak(aTHX_ "'!' allowed only after types %s", natstr);
+               DIE(aTHX_ "'!' allowed only after types %s", natstr);
        }
        if (*pat == '*') {
            len = strchr("@Xxu", datumtype) ? 0 : items;
@@ -4360,21 +4422,21 @@ PP(pp_pack)
            while (isDIGIT(*pat)) {
                len = (len * 10) + (*pat++ - '0');
                if (len < 0)
-                   Perl_croak(aTHX_ "Repeat count in pack overflows");
+                   DIE(aTHX_ "Repeat count in pack overflows");
            }
        }
        else
            len = 1;
-       if (*pat == '#') {
+       if (*pat == '/') {
            ++pat;
            if (*pat != 'a' && *pat != 'A' && *pat != 'Z' || pat[1] != '*')
-               DIE(aTHX_ "# must be followed by a*, A* or Z*");
+               DIE(aTHX_ "/ must be followed by a*, A* or Z*");
            lengthcode = sv_2mortal(newSViv(sv_len(items > 0
                                                   ? *MARK : &PL_sv_no)));
        }
        switch(datumtype) {
        default:
-           Perl_croak(aTHX_ "Invalid type in pack: '%c'", (int)datumtype);
+           DIE(aTHX_ "Invalid type in pack: '%c'", (int)datumtype);
        case ',': /* grandfather in commas but with a warning */
            if (commas++ == 0 && ckWARN(WARN_UNSAFE))
                Perl_warner(aTHX_ WARN_UNSAFE,
@@ -4410,10 +4472,16 @@ PP(pp_pack)
        case 'a':
            fromstr = NEXTFROM;
            aptr = SvPV(fromstr, fromlen);
-           if (pat[-1] == '*')
+           if (pat[-1] == '*') {
                len = fromlen;
-           if (fromlen > len)
+               if (datumtype == 'Z')
+                   ++len;
+           }
+           if (fromlen >= len) {
                sv_catpvn(cat, aptr, len);
+               if (datumtype == 'Z')
+                   *(SvEND(cat)-1) = '\0';
+           }
            else {
                sv_catpvn(cat, aptr, fromlen);
                len -= fromlen;
@@ -4436,15 +4504,14 @@ PP(pp_pack)
        case 'B':
        case 'b':
            {
-               char *savepat = pat;
+               register char *str;
                I32 saveitems;
 
                fromstr = NEXTFROM;
                saveitems = items;
-               aptr = SvPV(fromstr, fromlen);
+               str = SvPV(fromstr, fromlen);
                if (pat[-1] == '*')
                    len = fromlen;
-               pat = aptr;
                aint = SvCUR(cat);
                SvCUR(cat) += (len+7)/8;
                SvGROW(cat, SvCUR(cat) + 1);
@@ -4455,7 +4522,7 @@ PP(pp_pack)
                items = 0;
                if (datumtype == 'B') {
                    for (len = 0; len++ < aint;) {
-                       items |= *pat++ & 1;
+                       items |= *str++ & 1;
                        if (len & 7)
                            items <<= 1;
                        else {
@@ -4466,7 +4533,7 @@ PP(pp_pack)
                }
                else {
                    for (len = 0; len++ < aint;) {
-                       if (*pat++ & 1)
+                       if (*str++ & 1)
                            items |= 128;
                        if (len & 7)
                            items >>= 1;
@@ -4483,26 +4550,24 @@ PP(pp_pack)
                        items >>= 7 - (aint & 7);
                    *aptr++ = items & 0xff;
                }
-               pat = SvPVX(cat) + SvCUR(cat);
-               while (aptr <= pat)
+               str = SvPVX(cat) + SvCUR(cat);
+               while (aptr <= str)
                    *aptr++ = '\0';
 
-               pat = savepat;
                items = saveitems;
            }
            break;
        case 'H':
        case 'h':
            {
-               char *savepat = pat;
+               register char *str;
                I32 saveitems;
 
                fromstr = NEXTFROM;
                saveitems = items;
-               aptr = SvPV(fromstr, fromlen);
+               str = SvPV(fromstr, fromlen);
                if (pat[-1] == '*')
                    len = fromlen;
-               pat = aptr;
                aint = SvCUR(cat);
                SvCUR(cat) += (len+1)/2;
                SvGROW(cat, SvCUR(cat) + 1);
@@ -4513,10 +4578,10 @@ PP(pp_pack)
                items = 0;
                if (datumtype == 'H') {
                    for (len = 0; len++ < aint;) {
-                       if (isALPHA(*pat))
-                           items |= ((*pat++ & 15) + 9) & 15;
+                       if (isALPHA(*str))
+                           items |= ((*str++ & 15) + 9) & 15;
                        else
-                           items |= *pat++ & 15;
+                           items |= *str++ & 15;
                        if (len & 1)
                            items <<= 4;
                        else {
@@ -4527,10 +4592,10 @@ PP(pp_pack)
                }
                else {
                    for (len = 0; len++ < aint;) {
-                       if (isALPHA(*pat))
-                           items |= (((*pat++ & 15) + 9) & 15) << 4;
+                       if (isALPHA(*str))
+                           items |= (((*str++ & 15) + 9) & 15) << 4;
                        else
-                           items |= (*pat++ & 15) << 4;
+                           items |= (*str++ & 15) << 4;
                        if (len & 1)
                            items >>= 4;
                        else {
@@ -4541,11 +4606,10 @@ PP(pp_pack)
                }
                if (aint & 1)
                    *aptr++ = items & 0xff;
-               pat = SvPVX(cat) + SvCUR(cat);
-               while (aptr <= pat)
+               str = SvPVX(cat) + SvCUR(cat);
+               while (aptr <= str)
                    *aptr++ = '\0';
 
-               pat = savepat;
                items = saveitems;
            }
            break;
@@ -4663,7 +4727,7 @@ PP(pp_pack)
                adouble = Perl_floor(SvNV(fromstr));
 
                if (adouble < 0)
-                   Perl_croak(aTHX_ "Cannot compress negative numbers");
+                   DIE(aTHX_ "Cannot compress negative numbers");
 
                if (
 #ifdef BW_BITS
@@ -4697,7 +4761,7 @@ PP(pp_pack)
                    /* Copy string and check for compliance */
                    from = SvPV(fromstr, len);
                    if ((norm = is_an_int(from, len)) == NULL)
-                       Perl_croak(aTHX_ "can compress only unsigned integer");
+                       DIE(aTHX_ "can compress only unsigned integer");
 
                    New('w', result, len, char);
                    in = result + len;
@@ -4717,14 +4781,14 @@ PP(pp_pack)
                        double next = floor(adouble / 128);
                        *--in = (unsigned char)(adouble - (next * 128)) | 0x80;
                        if (--in < buf)  /* this cannot happen ;-) */
-                           Perl_croak(aTHX_ "Cannot compress integer");
+                           DIE(aTHX_ "Cannot compress integer");
                        adouble = next;
                    } while (adouble > 0);
                    buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
                    sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
                }
                else
-                   Perl_croak(aTHX_ "Cannot compress non integer");
+                   DIE(aTHX_ "Cannot compress non integer");
            }
             break;
        case 'i':
@@ -4811,7 +4875,7 @@ PP(pp_pack)
                sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
            }
            break;
-#endif /* HAS_QUAD */
+#endif
        case 'P':
            len = 1;            /* assume SV is correct length */
            /* FALL THROUGH */
@@ -4827,9 +4891,13 @@ PP(pp_pack)
                     * of pack() (and all copies of the result) are
                     * gone.
                     */
-                   if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
+                   if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr)
+                                               || (SvPADTMP(fromstr)
+                                                   && !SvREADONLY(fromstr))))
+                   {
                        Perl_warner(aTHX_ WARN_UNSAFE,
                                "Attempt to pack pointer to temporary value");
+                   }
                    if (SvPOK(fromstr) || SvNIOK(fromstr))
                        aptr = SvPV(fromstr,n_a);
                    else
@@ -4906,8 +4974,13 @@ PP(pp_split)
     TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
             (pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
 
-    if (pm->op_pmreplroot)
+    if (pm->op_pmreplroot) {
+#ifdef USE_ITHREADS
+       ary = GvAVn((GV*)PL_curpad[(PADOFFSET)pm->op_pmreplroot]);
+#else
        ary = GvAVn((GV*)pm->op_pmreplroot);
+#endif
+    }
     else if (gimme != G_ARRAY)
 #ifdef USE_THREADS
        ary = (AV*)PL_curpad[0];
@@ -5153,8 +5226,8 @@ Perl_unlock_condpair(pTHX_ void *svv)
        Perl_croak(aTHX_ "panic: unlock_condpair unlocking mutex that we don't own");
     MgOWNER(mg) = 0;
     COND_SIGNAL(MgOWNERCONDP(mg));
-    DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n",
-                         (unsigned long)thr, (unsigned long)svv);)
+    DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": unlock 0x%"UVxf"\n",
+                         PTR2UV(thr), PTR2UV(svv));)
     MUTEX_UNLOCK(MgMUTEXP(mg));
 }
 #endif /* USE_THREADS */
@@ -5178,10 +5251,10 @@ PP(pp_lock)
        while (MgOWNER(mg))
            COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
        MgOWNER(mg) = thr;
-       DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
-                             (unsigned long)thr, (unsigned long)sv);)
+       DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": pp_lock lock 0x%"UVxf"\n",
+                             PTR2UV(thr), PTR2UV(sv));)
        MUTEX_UNLOCK(MgMUTEXP(mg));
-       SAVEDESTRUCTOR(Perl_unlock_condpair, sv);
+       SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv);
     }
 #endif /* USE_THREADS */
     if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV