Add a new file, mathoms.c, to hold old code kept around for binary

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

diff --git a/op.c b/op.c
index 6b29e3c..4ec189e 100644 (file)
--- a/op.c
+++ b/op.c
@@ -804,6 +804,16 @@ Perl_scalarvoid(pTHX_ OP *o)
        o->op_ppaddr = PL_ppaddr[OP_PREDEC];
        break;
 
+    case OP_I_POSTINC:
+       o->op_type = OP_I_PREINC;       /* pre-increment is faster */
+       o->op_ppaddr = PL_ppaddr[OP_I_PREINC];
+       break;
+
+    case OP_I_POSTDEC:
+       o->op_type = OP_I_PREDEC;       /* pre-decrement is faster */
+       o->op_ppaddr = PL_ppaddr[OP_I_PREDEC];
+       break;
+
     case OP_OR:
     case OP_AND:
     case OP_DOR:
@@ -1412,7 +1422,7 @@ Perl_refkids(pTHX_ OP *o, I32 type)
 }
 
 OP *
-Perl_ref(pTHX_ OP *o, I32 type)
+Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
 {
     dVAR;
     OP *kid;
@@ -1434,12 +1444,12 @@ Perl_ref(pTHX_ OP *o, I32 type)
 
     case OP_COND_EXPR:
        for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
-           ref(kid, type);
+           doref(kid, type, set_op_ref);
        break;
     case OP_RV2SV:
        if (type == OP_DEFINED)
            o->op_flags |= OPf_SPECIAL;         /* don't create GV */
-       ref(cUNOPo->op_first, o->op_type);
+       doref(cUNOPo->op_first, o->op_type, set_op_ref);
        /* FALL THROUGH */
     case OP_PADSV:
        if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
@@ -1456,28 +1466,30 @@ Perl_ref(pTHX_ OP *o, I32 type)
 
     case OP_RV2AV:
     case OP_RV2HV:
-       o->op_flags |= OPf_REF;
+       if (set_op_ref)
+           o->op_flags |= OPf_REF;
        /* FALL THROUGH */
     case OP_RV2GV:
        if (type == OP_DEFINED)
            o->op_flags |= OPf_SPECIAL;         /* don't create GV */
-       ref(cUNOPo->op_first, o->op_type);
+       doref(cUNOPo->op_first, o->op_type, set_op_ref);
        break;
 
     case OP_PADAV:
     case OP_PADHV:
-       o->op_flags |= OPf_REF;
+       if (set_op_ref)
+           o->op_flags |= OPf_REF;
        break;
 
     case OP_SCALAR:
     case OP_NULL:
        if (!(o->op_flags & OPf_KIDS))
            break;
-       ref(cBINOPo->op_first, type);
+       doref(cBINOPo->op_first, type, set_op_ref);
        break;
     case OP_AELEM:
     case OP_HELEM:
-       ref(cBINOPo->op_first, o->op_type);
+       doref(cBINOPo->op_first, o->op_type, set_op_ref);
        if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
            o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
                              : type == OP_RV2HV ? OPpDEREF_HV
@@ -1488,11 +1500,13 @@ Perl_ref(pTHX_ OP *o, I32 type)
 
     case OP_SCOPE:
     case OP_LEAVE:
+       set_op_ref = FALSE;
+       /* FALL THROUGH */
     case OP_ENTER:
     case OP_LIST:
        if (!(o->op_flags & OPf_KIDS))
            break;
-       ref(cLISTOPo->op_last, type);
+       doref(cLISTOPo->op_last, type, set_op_ref);
        break;
     default:
        break;
@@ -1841,8 +1855,15 @@ Perl_scope(pTHX_ OP *o)
            o->op_type = OP_SCOPE;
            o->op_ppaddr = PL_ppaddr[OP_SCOPE];
            kid = ((LISTOP*)o)->op_first;
-           if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
+           if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
                op_null(kid);
+
+               /* The following deals with things like 'do {1 for 1}' */
+               kid = kid->op_sibling;
+               if (kid &&
+                   (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE))
+                   op_null(kid);
+           }
        }
        else
            o = newLISTOP(OP_SCOPE, 0, o, Nullop);
@@ -2314,7 +2335,7 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
     unop->op_type = (OPCODE)type;
     unop->op_ppaddr = PL_ppaddr[type];
     unop->op_first = first;
-    unop->op_flags = flags | OPf_KIDS;
+    unop->op_flags = (U8)(flags | OPf_KIDS);
     unop->op_private = (U8)(1 | (flags >> 8));
     unop = (UNOP*) CHECKOP(type, unop);
     if (unop->op_next)
@@ -2336,7 +2357,7 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
     binop->op_type = (OPCODE)type;
     binop->op_ppaddr = PL_ppaddr[type];
     binop->op_first = first;
-    binop->op_flags = flags | OPf_KIDS;
+    binop->op_flags = (U8)(flags | OPf_KIDS);
     if (!last) {
        last = first;
        binop->op_private = (U8)(1 | (flags >> 8));
@@ -2633,7 +2654,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
                j = rlen - 1;
            else
                cPVOPo->op_pv = (char*)Renew(tbl, 0x101+rlen-j, short);
-           tbl[0x100] = rlen - j;
+           tbl[0x100] = (short)(rlen - j);
            for (i=0; i < (I32)rlen - j; i++)
                tbl[0x101+i] = r[j+i];
        }
@@ -3615,7 +3636,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
     logop->op_type = (OPCODE)type;
     logop->op_ppaddr = PL_ppaddr[type];
     logop->op_first = first;
-    logop->op_flags = flags | OPf_KIDS;
+    logop->op_flags = (U8)(flags | OPf_KIDS);
     logop->op_other = LINKLIST(other);
     logop->op_private = (U8)(1 | (flags >> 8));
 
@@ -3666,7 +3687,7 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
     logop->op_type = OP_COND_EXPR;
     logop->op_ppaddr = PL_ppaddr[OP_COND_EXPR];
     logop->op_first = first;
-    logop->op_flags = flags | OPf_KIDS;
+    logop->op_flags = (U8)(flags | OPf_KIDS);
     logop->op_private = (U8)(1 | (flags >> 8));
     logop->op_other = LINKLIST(trueop);
     logop->op_next = LINKLIST(falseop);