Missed FREAD in bytecode.h
[p5sagit/p5-mst-13.2.git] / op.c
diff --git a/op.c b/op.c
index d508bfb..39d2a14 100644 (file)
--- a/op.c
+++ b/op.c
@@ -108,9 +108,9 @@ pad_allocmy(char *name)
        }
        croak("Can't use global %s in \"my\"",name);
     }
-    if (dowarn && AvFILL(comppad_name) >= 0) {
+    if (dowarn && AvFILLp(comppad_name) >= 0) {
        SV **svp = AvARRAY(comppad_name);
-       for (off = AvFILL(comppad_name); off > comppad_name_floor; off--) {
+       for (off = AvFILLp(comppad_name); off > comppad_name_floor; off--) {
            if ((sv = svp[off])
                && sv != &sv_undef
                && SvIVX(sv) == 999999999       /* var is in open scope */
@@ -148,16 +148,7 @@ pad_allocmy(char *name)
 }
 
 static PADOFFSET
-#ifndef CAN_PROTOTYPE
-pad_findlex(name, newoff, seq, startcv, cx_ix)
-char *name;
-PADOFFSET newoff;
-U32 seq;
-CV* startcv;
-I32 cx_ix;
-#else
 pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
-#endif
 {
     dTHR;
     CV *cv;
@@ -176,7 +167,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
            continue;
        curname = (AV*)*svp;
        svp = AvARRAY(curname);
-       for (off = AvFILL(curname); off > 0; off--) {
+       for (off = AvFILLp(curname); off > 0; off--) {
            if ((sv = svp[off]) &&
                sv != &sv_undef &&
                seq <= SvIVX(sv) &&
@@ -307,7 +298,7 @@ pad_findmy(char *name)
 #endif /* USE_THREADS */
 
     /* The one we're looking for is probably just before comppad_name_fill. */
-    for (off = AvFILL(comppad_name); off > 0; off--) {
+    for (off = AvFILLp(comppad_name); off > 0; off--) {
        if ((sv = svp[off]) &&
            sv != &sv_undef &&
            (!SvIVX(sv) ||
@@ -345,7 +336,7 @@ pad_leavemy(I32 fill)
        }
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
-    for (off = AvFILL(comppad_name); off > fill; off--) {
+    for (off = AvFILLp(comppad_name); off > fill; off--) {
        if ((sv = svp[off]) && sv != &sv_undef && SvIVX(sv) == 999999999)
            SvIVX(sv) = cop_seqmax;
     }
@@ -364,13 +355,13 @@ pad_alloc(I32 optype, U32 tmptype)
        pad_reset();
     if (tmptype & SVs_PADMY) {
        do {
-           sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE);
+           sv = *av_fetch(comppad, AvFILLp(comppad) + 1, TRUE);
        } while (SvPADBUSY(sv));                /* need a fresh one */
-       retval = AvFILL(comppad);
+       retval = AvFILLp(comppad);
     }
     else {
        SV **names = AvARRAY(comppad_name);
-       SSize_t names_fill = AvFILL(comppad_name);
+       SSize_t names_fill = AvFILLp(comppad_name);
        for (;;) {
            /*
             * "foreach" index vars temporarily become aliases to non-"my"
@@ -393,19 +384,15 @@ pad_alloc(I32 optype, U32 tmptype)
                          (unsigned long) thr, (unsigned long) curpad,
                          (long) retval, op_name[optype]));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad alloc %ld for %s\n",
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx alloc %ld for %s\n",
+                         (unsigned long) curpad,
                          (long) retval, op_name[optype]));
 #endif /* USE_THREADS */
     return (PADOFFSET)retval;
 }
 
 SV *
-#ifndef CAN_PROTOTYPE
-pad_sv(po)
-PADOFFSET po;
-#else
 pad_sv(PADOFFSET po)
-#endif /* CAN_PROTOTYPE */
 {
     dTHR;
 #ifdef USE_THREADS
@@ -414,18 +401,14 @@ pad_sv(PADOFFSET po)
 #else
     if (!po)
        croak("panic: pad_sv po");
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad sv %d\n", po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx sv %d\n",
+                         (unsigned long) curpad, po));
 #endif /* USE_THREADS */
     return curpad[po];         /* eventually we'll turn this into a macro */
 }
 
 void
-#ifndef CAN_PROTOTYPE
-pad_free(po)
-PADOFFSET po;
-#else
 pad_free(PADOFFSET po)
-#endif /* CAN_PROTOTYPE */
 {
     dTHR;
     if (!curpad)
@@ -438,7 +421,8 @@ pad_free(PADOFFSET po)
     DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx free %d\n",
                          (unsigned long) thr, (unsigned long) curpad, po));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad free %d\n", po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx free %d\n",
+                         (unsigned long) curpad, po));
 #endif /* USE_THREADS */
     if (curpad[po] && curpad[po] != &sv_undef)
        SvPADTMP_off(curpad[po]);
@@ -447,12 +431,7 @@ pad_free(PADOFFSET po)
 }
 
 void
-#ifndef CAN_PROTOTYPE
-pad_swipe(po)
-PADOFFSET po;
-#else
 pad_swipe(PADOFFSET po)
-#endif /* CAN_PROTOTYPE */
 {
     dTHR;
     if (AvARRAY(comppad) != curpad)
@@ -463,7 +442,8 @@ pad_swipe(PADOFFSET po)
     DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx swipe %d\n",
                          (unsigned long) thr, (unsigned long) curpad, po));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad swipe %d\n", po));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx swipe %d\n",
+                         (unsigned long) curpad, po));
 #endif /* USE_THREADS */
     SvPADTMP_off(curpad[po]);
     curpad[po] = NEWSV(1107,0);
@@ -472,9 +452,16 @@ pad_swipe(PADOFFSET po)
        padix = po - 1;
 }
 
+/* XXX pad_reset() is currently disabled because it results in serious bugs.
+ * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
+ * on the stack by OPs that use them, there are several ways to get an alias
+ * to  a shared TARG.  Such an alias will change randomly and unpredictably.
+ * We avoid doing this until we can think of a Better Way.
+ * GSAR 97-10-29 */
 void
 pad_reset(void)
 {
+#ifdef USE_BROKEN_PAD_RESET
     dTHR;
     register I32 po;
 
@@ -484,7 +471,8 @@ pad_reset(void)
     DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx reset\n",
                          (unsigned long) thr, (unsigned long) curpad));
 #else
-    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad reset\n"));
+    DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx reset\n",
+                         (unsigned long) curpad));
 #endif /* USE_THREADS */
     if (!tainting) {   /* Can't mix tainted and non-tainted temporaries. */
        for (po = AvMAX(comppad); po > padix_floor; po--) {
@@ -493,6 +481,7 @@ pad_reset(void)
        }
        padix = padix_floor;
     }
+#endif
     pad_reset_pending = FALSE;
 }
 
@@ -514,6 +503,7 @@ find_threadsv(char *name)
     if (!svp) {
        SV *sv = NEWSV(0, 0);
        av_store(thr->threadsv, key, sv);
+       thr->threadsvp = AvARRAY(thr->threadsv);
        /*
         * Some magic variables used to be automagically initialised
         * in gv_fetchpv. Those which are now per-thread magicals get
@@ -1161,6 +1151,7 @@ mod(OP *o, I32 type)
        /* FALL THROUGH */
     case OP_GV:
     case OP_AV2ARYLEN:
+       hints |= HINT_BLOCK_SCOPE;
     case OP_SASSIGN:
     case OP_AELEMFAST:
        modcount++;
@@ -1502,7 +1493,7 @@ block_start(int full)
     int retval = savestack_ix;
     SAVEI32(comppad_name_floor);
     if (full) {
-       if ((comppad_name_fill = AvFILL(comppad_name)) > 0)
+       if ((comppad_name_fill = AvFILLp(comppad_name)) > 0)
            comppad_name_floor = comppad_name_fill;
        else
            comppad_name_floor = 0;
@@ -1586,7 +1577,6 @@ localize(OP *o, I32 lex)
     if (o->op_flags & OPf_PARENS)
        list(o);
     else {
-       scalar(o);
        if (dowarn && bufptr > oldbufptr && bufptr[-1] == ',') {
            char *s;
            for (s = bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
@@ -1643,6 +1633,12 @@ fold_constants(register OP *o)
     case OP_LCFIRST:
     case OP_UC:
     case OP_LC:
+    case OP_SLT:
+    case OP_SGT:
+    case OP_SLE:
+    case OP_SGE:
+    case OP_SCMP:
+
        if (o->op_private & OPpLOCALE)
            goto nope;
     }
@@ -2906,18 +2902,7 @@ newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *b
 }
 
 OP *
-#ifndef CAN_PROTOTYPE
-newFOROP(flags,label,forline,sv,expr,block,cont)
-I32 flags;
-char *label;
-line_t forline;
-OP* sv;
-OP* expr;
-OP*block;
-OP*cont;
-#else
 newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
-#endif /* CAN_PROTOTYPE */
 {
     LOOP *loop;
     OP *wop;
@@ -2972,10 +2957,14 @@ newLOOPEX(I32 type, OP *label)
     dTHR;
     OP *o;
     if (type != OP_GOTO || label->op_type == OP_CONST) {
-       o = newPVOP(type, 0, savepv(
-               label->op_type == OP_CONST
-                   ? SvPVx(((SVOP*)label)->op_sv, na)
-                   : "" ));
+       /* "last()" means "last" */
+       if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
+           o = newOP(type, OPf_SPECIAL);
+       else {
+           o = newPVOP(type, 0, savepv(label->op_type == OP_CONST
+                                       ? SvPVx(((SVOP*)label)->op_sv, na)
+                                       : ""));
+       }
        op_free(label);
     }
     else {
@@ -3026,7 +3015,7 @@ cv_undef(CV *cv)
     if (CvPADLIST(cv)) {
        /* may be during global destruction */
        if (SvREFCNT(CvPADLIST(cv))) {
-           I32 i = AvFILL(CvPADLIST(cv));
+           I32 i = AvFILLp(CvPADLIST(cv));
            while (i >= 0) {
                SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
                SV* sv = svp ? *svp : Nullsv;
@@ -3080,7 +3069,7 @@ CV* cv;
     pname = AvARRAY(pad_name);
     ppad = AvARRAY(pad);
 
-    for (ix = 1; ix <= AvFILL(pad_name); ix++) {
+    for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
        if (SvPOK(pname[ix]))
            PerlIO_printf(Perl_debug_log, "\t%4d. 0x%lx (%s\"%s\" %ld-%ld)\n",
                          ix, ppad[ix],
@@ -3103,8 +3092,8 @@ cv_clone2(CV *proto, CV *outside)
     AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
     SV** pname = AvARRAY(protopad_name);
     SV** ppad = AvARRAY(protopad);
-    I32 fname = AvFILL(protopad_name);
-    I32 fpad = AvFILL(protopad);
+    I32 fname = AvFILLp(protopad_name);
+    I32 fpad = AvFILLp(protopad);
     AV* comppadlist;
     CV* cv;
 
@@ -3149,7 +3138,7 @@ cv_clone2(CV *proto, CV *outside)
     av_store(comppadlist, 0, (SV*)comppad_name);
     av_store(comppadlist, 1, (SV*)comppad);
     CvPADLIST(cv) = comppadlist;
-    av_fill(comppad, AvFILL(protopad));
+    av_fill(comppad, AvFILLp(protopad));
     curpad = AvARRAY(comppad);
 
     av = newAV();           /* will be @_ */
@@ -3386,12 +3375,12 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
        return cv;
     }
 
-    if (AvFILL(comppad_name) < AvFILL(comppad))
-       av_store(comppad_name, AvFILL(comppad), Nullsv);
+    if (AvFILLp(comppad_name) < AvFILLp(comppad))
+       av_store(comppad_name, AvFILLp(comppad), Nullsv);
 
     if (CvCLONE(cv)) {
        SV **namep = AvARRAY(comppad_name);
-       for (ix = AvFILL(comppad); ix > 0; ix--) {
+       for (ix = AvFILLp(comppad); ix > 0; ix--) {
            SV *namesv;
 
            if (SvIMMORTAL(curpad[ix]))
@@ -3417,7 +3406,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block)
        av_store(comppad, 0, (SV*)av);
        AvFLAGS(av) = AVf_REIFY;
 
-       for (ix = AvFILL(comppad); ix > 0; ix--) {
+       for (ix = AvFILLp(comppad); ix > 0; ix--) {
            if (SvIMMORTAL(curpad[ix]))
                continue;
            if (!SvPADMY(curpad[ix]))
@@ -3606,7 +3595,7 @@ newFORM(I32 floor, OP *o, OP *block)
     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
     CvFILEGV(cv) = curcop->cop_filegv;
 
-    for (ix = AvFILL(comppad); ix > 0; ix--) {
+    for (ix = AvFILLp(comppad); ix > 0; ix--) {
        if (!SvPADMY(curpad[ix]) && !SvIMMORTAL(curpad[ix]))
            SvPADTMP_on(curpad[ix]);
     }
@@ -3873,6 +3862,8 @@ ck_eval(OP *o)
            enter->op_other = o;
            return o;
        }
+       else
+           scalar((OP*)kid);
     }
     else {
        op_free(o);
@@ -4595,10 +4586,11 @@ ck_subr(OP *o)
                    goto wrapref;
                {
                    OP* kid = o2;
-                   o2 = newUNOP(OP_RV2GV, 0, kid);
-                   o2->op_sibling = kid->op_sibling;
+                   OP* sib = kid->op_sibling;
                    kid->op_sibling = 0;
-                   prev->op_sibling = o;
+                   o2 = newUNOP(OP_RV2GV, 0, kid);
+                   o2->op_sibling = sib;
+                   prev->op_sibling = o2;
                }
                goto wrapref;
            case '\\':
@@ -4627,9 +4619,10 @@ ck_subr(OP *o)
                  wrapref:
                    {
                        OP* kid = o2;
-                       o2 = newUNOP(OP_REFGEN, 0, kid);
-                       o2->op_sibling = kid->op_sibling;
+                       OP* sib = kid->op_sibling;
                        kid->op_sibling = 0;
+                       o2 = newUNOP(OP_REFGEN, 0, kid);
+                       o2->op_sibling = sib;
                        prev->op_sibling = o2;
                    }
                    break;
@@ -4797,6 +4790,8 @@ peep(register OP *o)
        case OP_AND:
        case OP_OR:
            o->op_seq = op_seqmax++;
+           while (cLOGOP->op_other->op_type == OP_NULL)
+               cLOGOP->op_other = cLOGOP->op_other->op_next;
            peep(cLOGOP->op_other);
            break;