perl5.004 on AIX: Patches

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 009d636..bc3ebb1 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -94,7 +94,7 @@ PP(pp_regcomp) {
        pm->op_pmflags |= PMf_WHITE;
 
     if (pm->op_pmflags & PMf_KEEP) {
-       pm->op_pmflags &= ~PMf_RUNTIME; /* no point compiling again */
+       pm->op_private &= ~OPpRUNTIME;  /* no point compiling again */
        hoistmust(pm);
        cLOGOP->op_first->op_next = op->op_next;
     }
@@ -112,6 +112,8 @@ PP(pp_substcont)
     char *orig = cx->sb_orig;
     register REGEXP *rx = cx->sb_rx;
 
+    rxres_restore(&cx->sb_rxres, rx);
+
     if (cx->sb_iters++) {
        if (cx->sb_iters > cx->sb_maxiters)
            DIE("Substitution loop");
@@ -157,9 +159,75 @@ PP(pp_substcont)
     sv_catpvn(dstr, s, m-s);
     cx->sb_s = rx->endp[0];
     cx->sb_rxtainted |= rx->exec_tainted;
+    rxres_save(&cx->sb_rxres, rx);
     RETURNOP(pm->op_pmreplstart);
 }
 
+void
+rxres_save(rsp, rx)
+void **rsp;
+REGEXP *rx;
+{
+    UV *p = (UV*)*rsp;
+    U32 i;
+
+    if (!p || p[1] < rx->nparens) {
+       i = 6 + rx->nparens * 2;
+       if (!p)
+           New(501, p, i, UV);
+       else
+           Renew(p, i, UV);
+       *rsp = (void*)p;
+    }
+
+    *p++ = (UV)rx->subbase;
+    rx->subbase = Nullch;
+
+    *p++ = rx->nparens;
+
+    *p++ = (UV)rx->subbeg;
+    *p++ = (UV)rx->subend;
+    for (i = 0; i <= rx->nparens; ++i) {
+       *p++ = (UV)rx->startp[i];
+       *p++ = (UV)rx->endp[i];
+    }
+}
+
+void
+rxres_restore(rsp, rx)
+void **rsp;
+REGEXP *rx;
+{
+    UV *p = (UV*)*rsp;
+    U32 i;
+
+    Safefree(rx->subbase);
+    rx->subbase = (char*)(*p);
+    *p++ = 0;
+
+    rx->nparens = *p++;
+
+    rx->subbeg = (char*)(*p++);
+    rx->subend = (char*)(*p++);
+    for (i = 0; i <= rx->nparens; ++i) {
+       rx->startp[i] = (char*)(*p++);
+       rx->endp[i] = (char*)(*p++);
+    }
+}
+
+void
+rxres_free(rsp)
+void **rsp;
+{
+    UV *p = (UV*)*rsp;
+
+    if (p) {
+       Safefree((char*)(*p));
+       Safefree(p);
+       *rsp = Null(void*);
+    }
+}
+
 PP(pp_formline)
 {
     dSP; dMARK; dORIGMARK;
@@ -601,7 +669,7 @@ PP(pp_sort)
            sortcop = CvSTART(cv);
            SAVESPTR(CvROOT(cv)->op_ppaddr);
            CvROOT(cv)->op_ppaddr = ppaddr[OP_NULL];
-           
+
            SAVESPTR(curpad);
            curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
        }
@@ -648,7 +716,16 @@ PP(pp_sort)
 
            SAVESPTR(GvSV(firstgv));
            SAVESPTR(GvSV(secondgv));
+
            PUSHBLOCK(cx, CXt_NULL, stack_base);
+           if (!(op->op_flags & OPf_SPECIAL)) {
+               bool hasargs = FALSE;
+               cx->cx_type = CXt_SUB;
+               cx->blk_gimme = G_SCALAR;
+               PUSHSUB(cx);
+               if (!CvDEPTH(cv))
+                   SvREFCNT_inc(cv);   /* in preparation for POPSUB */
+           }
            sortcxix = cxstack_ix;
 
            qsort((char*)(myorigmark+1), max, sizeof(SV*), sortcv);
@@ -917,11 +994,14 @@ I32 cxix;
     I32 optype;
 
     while (cxstack_ix > cxix) {
-       cx = &cxstack[cxstack_ix--];
-       DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n", (long) cxstack_ix+1,
-                   block_type[cx->cx_type]));
+       cx = &cxstack[cxstack_ix];
+       DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
+                             (long) cxstack_ix+1, block_type[cx->cx_type]));
        /* Note: we don't need to restore the base context info till the end. */
        switch (cx->cx_type) {
+       case CXt_SUBST:
+           POPSUBST(cx);
+           continue;  /* not break */
        case CXt_SUB:
            POPSUB(cx);
            break;
@@ -932,9 +1012,9 @@ I32 cxix;
            POPLOOP(cx);
            break;
        case CXt_NULL:
-       case CXt_SUBST:
            break;
        }
+       cxstack_ix--;
     }
 }
 
@@ -1356,7 +1436,7 @@ PP(pp_return)
     I32 optype = 0;
 
     if (curstack == sortstack) {
-       if (cxstack_ix == sortcxix || dopoptosub(cxstack_ix) < sortcxix) {
+       if (cxstack_ix == sortcxix || dopoptosub(cxstack_ix) <= sortcxix) {
            if (cxstack_ix > sortcxix)
                dounwind(sortcxix);
            AvARRAY(curstack)[1] = *SP;
@@ -1803,9 +1883,6 @@ PP(pp_goto)
        for (ix = cxstack_ix; ix >= 0; ix--) {
            cx = &cxstack[ix];
            switch (cx->cx_type) {
-           case CXt_SUB:
-               gotoprobe = CvROOT(cx->blk_sub.cv);
-               break;
            case CXt_EVAL:
                gotoprobe = eval_root; /* XXX not good for nested eval */
                break;
@@ -1820,6 +1897,12 @@ PP(pp_goto)
                else
                    gotoprobe = main_root;
                break;
+           case CXt_SUB:
+               if (CvDEPTH(cx->blk_sub.cv)) {
+                   gotoprobe = CvROOT(cx->blk_sub.cv);
+                   break;
+               }
+               /* FALL THROUGH */
            case CXt_NULL:
                DIE("Can't \"goto\" outside a block");
            default: