DJGPP feedback for #2028.

[p5sagit/p5-mst-13.2.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 7fcdf3d..04efce6 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -977,7 +977,7 @@ dopoptolabel(char *label)
 
     for (i = cxstack_ix; i >= 0; i--) {
        cx = &cxstack[i];
-       switch (cx->cx_type) {
+       switch (CxTYPE(cx)) {
        case CXt_SUBST:
            if (ckWARN(WARN_UNSAFE))
                warner(WARN_UNSAFE, "Exiting substitution via %s", 
@@ -1058,7 +1058,7 @@ dopoptosub_at(PERL_CONTEXT *cxstk, I32 startingblock)
     register PERL_CONTEXT *cx;
     for (i = startingblock; i >= 0; i--) {
        cx = &cxstk[i];
-       switch (cx->cx_type) {
+       switch (CxTYPE(cx)) {
        default:
            continue;
        case CXt_EVAL:
@@ -1078,7 +1078,7 @@ dopoptoeval(I32 startingblock)
     register PERL_CONTEXT *cx;
     for (i = startingblock; i >= 0; i--) {
        cx = &cxstack[i];
-       switch (cx->cx_type) {
+       switch (CxTYPE(cx)) {
        default:
            continue;
        case CXt_EVAL:
@@ -1097,7 +1097,7 @@ dopoptoloop(I32 startingblock)
     register PERL_CONTEXT *cx;
     for (i = startingblock; i >= 0; i--) {
        cx = &cxstack[i];
-       switch (cx->cx_type) {
+       switch (CxTYPE(cx)) {
        case CXt_SUBST:
            if (ckWARN(WARN_UNSAFE))
                warner(WARN_UNSAFE, "Exiting substitution via %s", 
@@ -1137,9 +1137,9 @@ dounwind(I32 cxix)
     while (cxstack_ix > cxix) {
        cx = &cxstack[cxstack_ix];
        DEBUG_l(PerlIO_printf(Perl_debug_log, "Unwinding block %ld, type %s\n",
-                             (long) cxstack_ix, block_type[cx->cx_type]));
+                             (long) cxstack_ix, block_type[CxTYPE(cx)]));
        /* Note: we don't need to restore the base context info till the end. */
-       switch (cx->cx_type) {
+       switch (CxTYPE(cx)) {
        case CXt_SUBST:
            POPSUBST(cx);
            continue;  /* not break */
@@ -1208,7 +1208,7 @@ die_where(char *message)
                dounwind(cxix);
 
            POPBLOCK(cx,PL_curpm);
-           if (cx->cx_type != CXt_EVAL) {
+           if (CxTYPE(cx) != CXt_EVAL) {
                PerlIO_printf(PerlIO_stderr(), "panic: die %s", message);
                my_exit(1);
            }
@@ -1298,7 +1298,7 @@ PP(pp_caller)
     }
 
     cx = &ccstack[cxix];
-    if (ccstack[cxix].cx_type == CXt_SUB) {
+    if (CxTYPE(cx) == CXt_SUB) {
         dbcxix = dopoptosub_at(ccstack, cxix - 1);
        /* We expect that ccstack[dbcxix] is CXt_SUB, anyway, the
           field below is defined for any cx. */
@@ -1327,7 +1327,7 @@ PP(pp_caller)
     PUSHs(sv_2mortal(newSViv((I32)cx->blk_oldcop->cop_line)));
     if (!MAXARG)
        RETURN;
-    if (cx->cx_type == CXt_SUB) { /* So is ccstack[dbcxix]. */
+    if (CxTYPE(cx) == CXt_SUB) { /* So is ccstack[dbcxix]. */
        sv = NEWSV(49, 0);
        gv_efullname3(sv, CvGV(ccstack[cxix].blk_sub.cv), Nullch);
        PUSHs(sv_2mortal(sv));
@@ -1342,7 +1342,7 @@ PP(pp_caller)
        PUSHs(&PL_sv_undef);
     else
        PUSHs(sv_2mortal(newSViv(gimme & G_ARRAY)));
-    if (cx->cx_type == CXt_EVAL) {
+    if (CxTYPE(cx) == CXt_EVAL) {
        if (cx->blk_eval.old_op_type == OP_ENTEREVAL) {
            PUSHs(cx->blk_eval.cur_text);
            PUSHs(&PL_sv_no);
@@ -1353,7 +1353,7 @@ PP(pp_caller)
            PUSHs(&PL_sv_yes);
        }
     }
-    else if (cx->cx_type == CXt_SUB &&
+    else if (CxTYPE(cx) == CXt_SUB &&
            cx->blk_sub.hasargs &&
            PL_curcop->cop_stash == PL_debstash)
     {
@@ -1610,7 +1610,7 @@ PP(pp_return)
        dounwind(cxix);
 
     POPBLOCK(cx,newpm);
-    switch (cx->cx_type) {
+    switch (CxTYPE(cx)) {
     case CXt_SUB:
        POPSUB1(cx);    /* Delay POPSUB2 until stack values are safe */
        popsub2 = TRUE;
@@ -1698,7 +1698,7 @@ PP(pp_last)
        dounwind(cxix);
 
     POPBLOCK(cx,newpm);
-    switch (cx->cx_type) {
+    switch (CxTYPE(cx)) {
     case CXt_LOOP:
        POPLOOP1(cx);   /* Delay POPLOOP2 until stack values are safe */
        pop2 = CXt_LOOP;
@@ -1873,6 +1873,7 @@ PP(pp_goto)
            SV** mark;
            I32 items = 0;
            I32 oldsave;
+           int arg_was_real = 0;
 
        retry:
            if (!CvROOT(cv) && !CvXSUB(cv)) {
@@ -1901,10 +1902,10 @@ PP(pp_goto)
            if (cxix < cxstack_ix)
                dounwind(cxix);
            TOPBLOCK(cx);
-           if (cx->cx_type == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL) 
+           if (CxTYPE(cx) == CXt_EVAL && cx->blk_eval.old_op_type == OP_ENTEREVAL) 
                DIE("Can't goto subroutine from an eval-string");
            mark = PL_stack_sp;
-           if (cx->cx_type == CXt_SUB &&
+           if (CxTYPE(cx) == CXt_SUB &&
                cx->blk_sub.hasargs) {   /* put @_ back onto stack */
                AV* av = cx->blk_sub.argarray;
                
@@ -1917,7 +1918,10 @@ PP(pp_goto)
                SvREFCNT_dec(GvAV(PL_defgv));
                GvAV(PL_defgv) = cx->blk_sub.savearray;
 #endif /* USE_THREADS */
-               AvREAL_off(av);
+               if (AvREAL(av)) {
+                   arg_was_real = 1;
+                   AvREAL_off(av);     /* so av_clear() won't clobber elts */
+               }
                av_clear(av);
            }
            else if (CvXSUB(cv)) {      /* put GvAV(defgv) back onto stack */
@@ -1934,7 +1938,7 @@ PP(pp_goto)
                Copy(AvARRAY(av), PL_stack_sp, items, SV*);
                PL_stack_sp += items;
            }
-           if (cx->cx_type == CXt_SUB &&
+           if (CxTYPE(cx) == CXt_SUB &&
                !(CvDEPTH(cx->blk_sub.cv) = cx->blk_sub.olddepth))
                SvREFCNT_dec(cx->blk_sub.cv);
            oldsave = PL_scopestack[PL_scopestack_ix - 1];
@@ -1973,7 +1977,7 @@ PP(pp_goto)
            else {
                AV* padlist = CvPADLIST(cv);
                SV** svp = AvARRAY(padlist);
-               if (cx->cx_type == CXt_EVAL) {
+               if (CxTYPE(cx) == CXt_EVAL) {
                    PL_in_eval = cx->blk_eval.old_in_eval;
                    PL_eval_root = cx->blk_eval.old_eval_root;
                    cx->cx_type = CXt_SUB;
@@ -2073,7 +2077,11 @@ PP(pp_goto)
                    }
                    Copy(mark,AvARRAY(av),items,SV*);
                    AvFILLp(av) = items - 1;
-                   
+                   /* preserve @_ nature */
+                   if (arg_was_real) {
+                       AvREIFY_off(av);
+                       AvREAL_on(av);
+                   }
                    while (items--) {
                        if (*mark)
                            SvTEMP_off(*mark);
@@ -2123,7 +2131,7 @@ PP(pp_goto)
        *enterops = 0;
        for (ix = cxstack_ix; ix >= 0; ix--) {
            cx = &cxstack[ix];
-           switch (cx->cx_type) {
+           switch (CxTYPE(cx)) {
            case CXt_EVAL:
                gotoprobe = PL_eval_root; /* XXX not good for nested eval */
                break;
@@ -2204,11 +2212,6 @@ PP(pp_goto)
        PL_do_undump = FALSE;
     }
 
-    if (PL_top_env->je_prev) {
-        PL_restartop = retop;
-        JMPENV_JUMP(3);
-    }
-
     RETURNOP(retop);
 }
 
@@ -2313,15 +2316,14 @@ docatch(OP *o)
     JMPENV_PUSH(ret);
     switch (ret) {
     default:                           /* topmost level handles it */
+pass_the_buck:
        JMPENV_POP;
        PL_op = oldop;
        JMPENV_JUMP(ret);
        /* NOTREACHED */
     case 3:
-       if (!PL_restartop) {
-           PerlIO_printf(PerlIO_stderr(), "panic: restartop\n");
-           break;
-       }
+       if (!PL_restartop)
+           goto pass_the_buck;
        PL_op = PL_restartop;
        PL_restartop = 0;
        /* FALL THROUGH */
@@ -2380,7 +2382,7 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp)
     PL_hints = 0;
 
     PL_op = &dummy;
-    PL_op->op_type = 0;                        /* Avoid uninit warning. */
+    PL_op->op_type = OP_ENTEREVAL;
     PL_op->op_flags = 0;                       /* Avoid uninit warning. */
     PUSHBLOCK(cx, CXt_EVAL, SP);
     PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
@@ -2393,7 +2395,7 @@ sv_compile_2op(SV *sv, OP** startop, char *code, AV** avp)
     lex_end();
     *avp = (AV*)SvREFCNT_inc(PL_comppad);
     LEAVE;
-    if (curcop = &PL_compiling)
+    if (PL_curcop == &PL_compiling)
        PL_compiling.op_private = PL_hints;
 #ifdef OP_IN_REGISTER
     op = PL_opsave;
@@ -2427,11 +2429,11 @@ doeval(int gimme, OP** startop)
     SAVEI32(PL_max_intro_pending);
 
     caller = PL_compcv;
-    for (i = cxstack_ix; i >= 0; i--) {
+    for (i = cxstack_ix - 1; i >= 0; i--) {
        PERL_CONTEXT *cx = &cxstack[i];
-       if (cx->cx_type == CXt_EVAL)
+       if (CxTYPE(cx) == CXt_EVAL)
            break;
-       else if (cx->cx_type == CXt_SUB) {
+       else if (CxTYPE(cx) == CXt_SUB) {
            caller = cx->blk_sub.cv;
            break;
        }
@@ -2686,7 +2688,7 @@ PP(pp_require)
        RETPUSHUNDEF;
     }
     else
-       errno = 0;
+       SETERRNO(0, SS$_NORMAL);
 
     /* Assume success here to prevent recursive requirement. */
     (void)hv_store(GvHVn(PL_incgv), name, strlen(name),
@@ -2769,7 +2771,7 @@ PP(pp_entereval)
     SAVEDELETE(PL_defstash, safestr, strlen(safestr));
     SAVEHINTS();
     PL_hints = PL_op->op_targ;
-    SAVEPPTR(compiling.cop_warnings);
+    SAVEPPTR(PL_compiling.cop_warnings);
     if (PL_compiling.cop_warnings != WARN_ALL 
        && PL_compiling.cop_warnings != WARN_NONE){
         PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
@@ -2777,7 +2779,7 @@ PP(pp_entereval)
     }
 
     push_return(PL_op->op_next);
-    PUSHBLOCK(cx, CXt_EVAL, SP);
+    PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
     PUSHEVAL(cx, 0, PL_compiling.cop_filegv);
 
     /* prepare to compile string */