Missed FREAD in bytecode.h

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

diff --git a/op.c b/op.c
index 073569c..39d2a14 100644 (file)
--- a/op.c
+++ b/op.c
@@ -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;
@@ -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++;
@@ -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 {
@@ -4597,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 '\\':
@@ -4629,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;
@@ -4799,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;