op.c

   1 /*    op.c
   2  *
   3  *    Copyright (c) 1991-1997, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  */
   9
  10 /*
  11  * "You see: Mr. Drogo, he married poor Miss Primula Brandybuck.  She was
  12  * our Mr. Bilbo's first cousin on the mother's side (her mother being the
  13  * youngest of the Old Took's daughters); and Mr. Drogo was his second
  14  * cousin.  So Mr. Frodo is his first *and* second cousin, once removed
  15  * either way, as the saying is, if you follow me."  --the Gaffer
  16  */
  17
  18 #include "EXTERN.h"
  19 #include "perl.h"
  20
  21 #ifdef PERL_OBJECT
  22 #define CHECKCALL this->*check
  23 #else
  24 #define CHECKCALL *check
  25 #endif
  26
  27 /*
  28  * In the following definition, the ", Nullop" is just to make the compiler
  29  * think the expression is of the right type: croak actually does a Siglongjmp.
  30  */
  31 #define CHECKOP(type,o) \
  32     ((PL_op_mask && PL_op_mask[type])                                   \
  33      ? ( op_free((OP*)o),                                       \
  34          croak("%s trapped by operation mask", op_desc[type]),  \
  35          Nullop )                                               \
  36      : (CHECKCALL[type])((OP*)o))
  37
  38 static bool scalar_mod_type _((OP *o, I32 type));
  39 #ifndef PERL_OBJECT
  40 static I32 list_assignment _((OP *o));
  41 static void bad_type _((I32 n, char *t, char *name, OP *kid));
  42 static OP *modkids _((OP *o, I32 type));
  43 static OP *no_fh_allowed _((OP *o));
  44 static OP *scalarboolean _((OP *o));
  45 static OP *too_few_arguments _((OP *o, char* name));
  46 static OP *too_many_arguments _((OP *o, char* name));
  47 static void null _((OP* o));
  48 static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
  49         CV* startcv, I32 cx_ix));
  50 static OP *newDEFSVOP _((void));
  51 static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp));
  52 #endif
  53
  54 STATIC char*
  55 gv_ename(GV *gv)
  56 {
  57     SV* tmpsv = sv_newmortal();
  58     gv_efullname3(tmpsv, gv, Nullch);
  59     return SvPV(tmpsv,PL_na);
  60 }
  61
  62 STATIC OP *
  63 no_fh_allowed(OP *o)
  64 {
  65     yyerror(form("Missing comma after first argument to %s function",
  66                  op_desc[o->op_type]));
  67     return o;
  68 }
  69
  70 STATIC OP *
  71 too_few_arguments(OP *o, char *name)
  72 {
  73     yyerror(form("Not enough arguments for %s", name));
  74     return o;
  75 }
  76
  77 STATIC OP *
  78 too_many_arguments(OP *o, char *name)
  79 {
  80     yyerror(form("Too many arguments for %s", name));
  81     return o;
  82 }
  83
  84 STATIC void
  85 bad_type(I32 n, char *t, char *name, OP *kid)
  86 {
  87     yyerror(form("Type of arg %d to %s must be %s (not %s)",
  88                  (int)n, name, t, op_desc[kid->op_type]));
  89 }
  90
  91 void
  92 assertref(OP *o)
  93 {
  94     int type = o->op_type;
  95     if (type != OP_AELEM && type != OP_HELEM) {
  96         yyerror(form("Can't use subscript on %s", op_desc[type]));
  97         if (type == OP_ENTERSUB || type == OP_RV2HV || type == OP_PADHV) {
  98             dTHR;
  99             SV *msg = sv_2mortal(
 100                         newSVpvf("(Did you mean $ or @ instead of %c?)\n",
 101                                  type == OP_ENTERSUB ? '&' : '%'));
 102             if (PL_in_eval & 2)
 103                 warn("%_", msg);
 104             else if (PL_in_eval)
 105                 sv_catsv(GvSV(PL_errgv), msg);
 106             else
 107                 PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
 108         }
 109     }
 110 }
 111
 112 /* "register" allocation */
 113
 114 PADOFFSET
 115 pad_allocmy(char *name)
 116 {
 117     dTHR;
 118     PADOFFSET off;
 119     SV *sv;
 120
 121     if (!(isALPHA(name[1]) || name[1] == '_' && (int)strlen(name) > 2)) {
 122         if (!isPRINT(name[1])) {
 123             name[3] = '\0';
 124             name[2] = toCTRL(name[1]);
 125             name[1] = '^';
 126         }
 127         croak("Can't use global %s in \"my\"",name);
 128     }
 129     if (PL_dowarn && AvFILLp(PL_comppad_name) >= 0) {
 130         SV **svp = AvARRAY(PL_comppad_name);
 131         for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_floor; off--) {
 132             if ((sv = svp[off])
 133                 && sv != &PL_sv_undef
 134                 && SvIVX(sv) == 999999999       /* var is in open scope */
 135                 && strEQ(name, SvPVX(sv)))
 136             {
 137                 warn("\"my\" variable %s masks earlier declaration in same scope", name);
 138                 break;
 139             }
 140         }
 141     }
 142     off = pad_alloc(OP_PADSV, SVs_PADMY);
 143     sv = NEWSV(1102,0);
 144     sv_upgrade(sv, SVt_PVNV);
 145     sv_setpv(sv, name);
 146     if (PL_in_my_stash) {
 147         if (*name != '$')
 148             croak("Can't declare class for non-scalar %s in \"my\"",name);
 149         SvOBJECT_on(sv);
 150         (void)SvUPGRADE(sv, SVt_PVMG);
 151         SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash);
 152         PL_sv_objcount++;
 153     }
 154     av_store(PL_comppad_name, off, sv);
 155     SvNVX(sv) = (double)999999999;
 156     SvIVX(sv) = 0;                      /* Not yet introduced--see newSTATEOP */
 157     if (!PL_min_intro_pending)
 158         PL_min_intro_pending = off;
 159     PL_max_intro_pending = off;
 160     if (*name == '@')
 161         av_store(PL_comppad, off, (SV*)newAV());
 162     else if (*name == '%')
 163         av_store(PL_comppad, off, (SV*)newHV());
 164     SvPADMY_on(PL_curpad[off]);
 165     return off;
 166 }
 167
 168 STATIC PADOFFSET
 169 pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
 170 {
 171     dTHR;
 172     CV *cv;
 173     I32 off;
 174     SV *sv;
 175     register I32 i;
 176     register PERL_CONTEXT *cx;
 177     int saweval;
 178
 179     for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
 180         AV *curlist = CvPADLIST(cv);
 181         SV **svp = av_fetch(curlist, 0, FALSE);
 182         AV *curname;
 183
 184         if (!svp || *svp == &PL_sv_undef)
 185             continue;
 186         curname = (AV*)*svp;
 187         svp = AvARRAY(curname);
 188         for (off = AvFILLp(curname); off > 0; off--) {
 189             if ((sv = svp[off]) &&
 190                 sv != &PL_sv_undef &&
 191                 seq <= SvIVX(sv) &&
 192                 seq > I_32(SvNVX(sv)) &&
 193                 strEQ(SvPVX(sv), name))
 194             {
 195                 I32 depth;
 196                 AV *oldpad;
 197                 SV *oldsv;
 198
 199                 depth = CvDEPTH(cv);
 200                 if (!depth) {
 201                     if (newoff) {
 202                         if (SvFAKE(sv))
 203                             continue;
 204                         return 0; /* don't clone from inactive stack frame */
 205                     }
 206                     depth = 1;
 207                 }
 208                 oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
 209                 oldsv = *av_fetch(oldpad, off, TRUE);
 210                 if (!newoff) {          /* Not a mere clone operation. */
 211                     SV *namesv = NEWSV(1103,0);
 212                     newoff = pad_alloc(OP_PADSV, SVs_PADMY);
 213                     sv_upgrade(namesv, SVt_PVNV);
 214                     sv_setpv(namesv, name);
 215                     av_store(PL_comppad_name, newoff, namesv);
 216                     SvNVX(namesv) = (double)PL_curcop->cop_seq;
 217                     SvIVX(namesv) = 999999999;  /* A ref, intro immediately */
 218                     SvFAKE_on(namesv);          /* A ref, not a real var */
 219                     if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
 220                         /* "It's closures all the way down." */
 221                         CvCLONE_on(PL_compcv);
 222                         if (cv == startcv) {
 223                             if (CvANON(PL_compcv))
 224                                 oldsv = Nullsv; /* no need to keep ref */
 225                         }
 226                         else {
 227                             CV *bcv;
 228                             for (bcv = startcv;
 229                                  bcv && bcv != cv && !CvCLONE(bcv);
 230                                  bcv = CvOUTSIDE(bcv)) {
 231                                 if (CvANON(bcv))
 232                                     CvCLONE_on(bcv);
 233                                 else {
 234                                     if (PL_dowarn && !CvUNIQUE(cv))
 235                                         warn(
 236                                           "Variable \"%s\" may be unavailable",
 237                                              name);
 238                                     break;
 239                                 }
 240                             }
 241                         }
 242                     }
 243                     else if (!CvUNIQUE(PL_compcv)) {
 244                         if (PL_dowarn && !SvFAKE(sv) && !CvUNIQUE(cv))
 245                             warn("Variable \"%s\" will not stay shared", name);
 246                     }
 247                 }
 248                 av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
 249                 return newoff;
 250             }
 251         }
 252     }
 253
 254     /* Nothing in current lexical context--try eval's context, if any.
 255      * This is necessary to let the perldb get at lexically scoped variables.
 256      * XXX This will also probably interact badly with eval tree caching.
 257      */
 258
 259     saweval = 0;
 260     for (i = cx_ix; i >= 0; i--) {
 261         cx = &cxstack[i];
 262         switch (cx->cx_type) {
 263         default:
 264             if (i == 0 && saweval) {
 265                 seq = cxstack[saweval].blk_oldcop->cop_seq;
 266                 return pad_findlex(name, newoff, seq, PL_main_cv, 0);
 267             }
 268             break;
 269         case CXt_EVAL:
 270             switch (cx->blk_eval.old_op_type) {
 271             case OP_ENTEREVAL:
 272                 saweval = i;
 273                 break;
 274             case OP_REQUIRE:
 275                 /* require must have its own scope */
 276                 return 0;
 277             }
 278             break;
 279         case CXt_SUB:
 280             if (!saweval)
 281                 return 0;
 282             cv = cx->blk_sub.cv;
 283             if (PL_debstash && CvSTASH(cv) == PL_debstash) {    /* ignore DB'* scope */
 284                 saweval = i;    /* so we know where we were called from */
 285                 continue;
 286             }
 287             seq = cxstack[saweval].blk_oldcop->cop_seq;
 288             return pad_findlex(name, newoff, seq, cv, i-1);
 289         }
 290     }
 291
 292     return 0;
 293 }
 294
 295 PADOFFSET
 296 pad_findmy(char *name)
 297 {
 298     dTHR;
 299     I32 off;
 300     I32 pendoff = 0;
 301     SV *sv;
 302     SV **svp = AvARRAY(PL_comppad_name);
 303     U32 seq = PL_cop_seqmax;
 304
 305 #ifdef USE_THREADS
 306     /*
 307      * Special case to get lexical (and hence per-thread) @_.
 308      * XXX I need to find out how to tell at parse-time whether use
 309      * of @_ should refer to a lexical (from a sub) or defgv (global
 310      * scope and maybe weird sub-ish things like formats). See
 311      * startsub in perly.y.  It's possible that @_ could be lexical
 312      * (at least from subs) even in non-threaded perl.
 313      */
 314     if (strEQ(name, "@_"))
 315         return 0;               /* success. (NOT_IN_PAD indicates failure) */
 316 #endif /* USE_THREADS */
 317
 318     /* The one we're looking for is probably just before comppad_name_fill. */
 319     for (off = AvFILLp(PL_comppad_name); off > 0; off--) {
 320         if ((sv = svp[off]) &&
 321             sv != &PL_sv_undef &&
 322             (!SvIVX(sv) ||
 323              (seq <= SvIVX(sv) &&
 324               seq > I_32(SvNVX(sv)))) &&
 325             strEQ(SvPVX(sv), name))
 326         {
 327             if (SvIVX(sv))
 328                 return (PADOFFSET)off;
 329             pendoff = off;      /* this pending def. will override import */
 330         }
 331     }
 332
 333     /* See if it's in a nested scope */
 334     off = pad_findlex(name, 0, seq, CvOUTSIDE(PL_compcv), cxstack_ix);
 335     if (off) {
 336         /* If there is a pending local definition, this new alias must die */
 337         if (pendoff)
 338             SvIVX(AvARRAY(PL_comppad_name)[off]) = seq;
 339         return off;             /* pad_findlex returns 0 for failure...*/
 340     }
 341     return NOT_IN_PAD;          /* ...but we return NOT_IN_PAD for failure */
 342 }
 343
 344 void
 345 pad_leavemy(I32 fill)
 346 {
 347     I32 off;
 348     SV **svp = AvARRAY(PL_comppad_name);
 349     SV *sv;
 350     if (PL_min_intro_pending && fill < PL_min_intro_pending) {
 351         for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
 352             if ((sv = svp[off]) && sv != &PL_sv_undef)
 353                 warn("%s never introduced", SvPVX(sv));
 354         }
 355     }
 356     /* "Deintroduce" my variables that are leaving with this scope. */
 357     for (off = AvFILLp(PL_comppad_name); off > fill; off--) {
 358         if ((sv = svp[off]) && sv != &PL_sv_undef && SvIVX(sv) == 999999999)
 359             SvIVX(sv) = PL_cop_seqmax;
 360     }
 361 }
 362
 363 PADOFFSET
 364 pad_alloc(I32 optype, U32 tmptype)
 365 {
 366     dTHR;
 367     SV *sv;
 368     I32 retval;
 369
 370     if (AvARRAY(PL_comppad) != PL_curpad)
 371         croak("panic: pad_alloc");
 372     if (PL_pad_reset_pending)
 373         pad_reset();
 374     if (tmptype & SVs_PADMY) {
 375         do {
 376             sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
 377         } while (SvPADBUSY(sv));                /* need a fresh one */
 378         retval = AvFILLp(PL_comppad);
 379     }
 380     else {
 381         SV **names = AvARRAY(PL_comppad_name);
 382         SSize_t names_fill = AvFILLp(PL_comppad_name);
 383         for (;;) {
 384             /*
 385              * "foreach" index vars temporarily become aliases to non-"my"
 386              * values.  Thus we must skip, not just pad values that are
 387              * marked as current pad values, but also those with names.
 388              */
 389             if (++PL_padix <= names_fill &&
 390                    (sv = names[PL_padix]) && sv != &PL_sv_undef)
 391                 continue;
 392             sv = *av_fetch(PL_comppad, PL_padix, TRUE);
 393             if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)))
 394                 break;
 395         }
 396         retval = PL_padix;
 397     }
 398     SvFLAGS(sv) |= tmptype;
 399     PL_curpad = AvARRAY(PL_comppad);
 400 #ifdef USE_THREADS
 401     DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx alloc %ld for %s\n",
 402                           (unsigned long) thr, (unsigned long) PL_curpad,
 403                           (long) retval, op_name[optype]));
 404 #else
 405     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx alloc %ld for %s\n",
 406                           (unsigned long) PL_curpad,
 407                           (long) retval, op_name[optype]));
 408 #endif /* USE_THREADS */
 409     return (PADOFFSET)retval;
 410 }
 411
 412 SV *
 413 pad_sv(PADOFFSET po)
 414 {
 415     dTHR;
 416 #ifdef USE_THREADS
 417     DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx sv %d\n",
 418                           (unsigned long) thr, (unsigned long) PL_curpad, po));
 419 #else
 420     if (!po)
 421         croak("panic: pad_sv po");
 422     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx sv %d\n",
 423                           (unsigned long) PL_curpad, po));
 424 #endif /* USE_THREADS */
 425     return PL_curpad[po];               /* eventually we'll turn this into a macro */
 426 }
 427
 428 void
 429 pad_free(PADOFFSET po)
 430 {
 431     dTHR;
 432     if (!PL_curpad)
 433         return;
 434     if (AvARRAY(PL_comppad) != PL_curpad)
 435         croak("panic: pad_free curpad");
 436     if (!po)
 437         croak("panic: pad_free po");
 438 #ifdef USE_THREADS
 439     DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx free %d\n",
 440                           (unsigned long) thr, (unsigned long) PL_curpad, po));
 441 #else
 442     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx free %d\n",
 443                           (unsigned long) PL_curpad, po));
 444 #endif /* USE_THREADS */
 445     if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef)
 446         SvPADTMP_off(PL_curpad[po]);
 447     if ((I32)po < PL_padix)
 448         PL_padix = po - 1;
 449 }
 450
 451 void
 452 pad_swipe(PADOFFSET po)
 453 {
 454     dTHR;
 455     if (AvARRAY(PL_comppad) != PL_curpad)
 456         croak("panic: pad_swipe curpad");
 457     if (!po)
 458         croak("panic: pad_swipe po");
 459 #ifdef USE_THREADS
 460     DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx swipe %d\n",
 461                           (unsigned long) thr, (unsigned long) PL_curpad, po));
 462 #else
 463     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx swipe %d\n",
 464                           (unsigned long) PL_curpad, po));
 465 #endif /* USE_THREADS */
 466     SvPADTMP_off(PL_curpad[po]);
 467     PL_curpad[po] = NEWSV(1107,0);
 468     SvPADTMP_on(PL_curpad[po]);
 469     if ((I32)po < PL_padix)
 470         PL_padix = po - 1;
 471 }
 472
 473 /* XXX pad_reset() is currently disabled because it results in serious bugs.
 474  * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
 475  * on the stack by OPs that use them, there are several ways to get an alias
 476  * to  a shared TARG.  Such an alias will change randomly and unpredictably.
 477  * We avoid doing this until we can think of a Better Way.
 478  * GSAR 97-10-29 */
 479 void
 480 pad_reset(void)
 481 {
 482 #ifdef USE_BROKEN_PAD_RESET
 483     dTHR;
 484     register I32 po;
 485
 486     if (AvARRAY(PL_comppad) != PL_curpad)
 487         croak("panic: pad_reset curpad");
 488 #ifdef USE_THREADS
 489     DEBUG_X(PerlIO_printf(Perl_debug_log, "0x%lx Pad 0x%lx reset\n",
 490                           (unsigned long) thr, (unsigned long) PL_curpad));
 491 #else
 492     DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%lx reset\n",
 493                           (unsigned long) PL_curpad));
 494 #endif /* USE_THREADS */
 495     if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
 496         for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
 497             if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
 498                 SvPADTMP_off(PL_curpad[po]);
 499         }
 500         PL_padix = PL_padix_floor;
 501     }
 502 #endif
 503     PL_pad_reset_pending = FALSE;
 504 }
 505
 506 #ifdef USE_THREADS
 507 /* find_threadsv is not reentrant */
 508 PADOFFSET
 509 find_threadsv(char *name)
 510 {
 511     dTHR;
 512     char *p;
 513     PADOFFSET key;
 514     SV **svp;
 515     /* We currently only handle names of a single character */
 516     p = strchr(PL_threadsv_names, *name);
 517     if (!p)
 518         return NOT_IN_PAD;
 519     key = p - PL_threadsv_names;
 520     svp = av_fetch(thr->threadsv, key, FALSE);
 521     if (!svp) {
 522         SV *sv = NEWSV(0, 0);
 523         av_store(thr->threadsv, key, sv);
 524         thr->threadsvp = AvARRAY(thr->threadsv);
 525         /*
 526          * Some magic variables used to be automagically initialised
 527          * in gv_fetchpv. Those which are now per-thread magicals get
 528          * initialised here instead.
 529          */
 530         switch (*name) {
 531         case '_':
 532             break;
 533         case ';':
 534             sv_setpv(sv, "\034");
 535             sv_magic(sv, 0, 0, name, 1);
 536             break;
 537         case '&':
 538         case '`':
 539         case '\'':
 540             PL_sawampersand = TRUE;
 541             SvREADONLY_on(sv);
 542             /* FALL THROUGH */
 543
 544         /* XXX %! tied to Errno.pm needs to be added here.
 545          * See gv_fetchpv(). */
 546         /* case '!': */
 547
 548         default:
 549             sv_magic(sv, 0, 0, name, 1);
 550         }
 551         DEBUG_L(PerlIO_printf(PerlIO_stderr(),
 552                               "find_threadsv: new SV %p for $%s%c\n",
 553                               sv, (*name < 32) ? "^" : "",
 554                               (*name < 32) ? toCTRL(*name) : *name));
 555     }
 556     return key;
 557 }
 558 #endif /* USE_THREADS */
 559
 560 /* Destructor */
 561
 562 void
 563 op_free(OP *o)
 564 {
 565     register OP *kid, *nextkid;
 566
 567     if (!o || o->op_seq == (U16)-1)
 568         return;
 569
 570     if (o->op_flags & OPf_KIDS) {
 571         for (kid = cUNOPo->op_first; kid; kid = nextkid) {
 572             nextkid = kid->op_sibling; /* Get before next freeing kid */
 573             op_free(kid);
 574         }
 575     }
 576
 577     switch (o->op_type) {
 578     case OP_NULL:
 579         o->op_targ = 0; /* Was holding old type, if any. */
 580         break;
 581     case OP_ENTEREVAL:
 582         o->op_targ = 0; /* Was holding hints. */
 583         break;
 584 #ifdef USE_THREADS
 585     case OP_THREADSV:
 586         o->op_targ = 0; /* Was holding index into thr->threadsv AV. */
 587         break;
 588 #endif /* USE_THREADS */
 589     default:
 590         if (!(o->op_flags & OPf_REF)
 591             || (check[o->op_type] != FUNC_NAME_TO_PTR(ck_ftst)))
 592             break;
 593         /* FALL THROUGH */
 594     case OP_GVSV:
 595     case OP_GV:
 596     case OP_AELEMFAST:
 597         SvREFCNT_dec(cGVOPo->op_gv);
 598         break;
 599     case OP_NEXTSTATE:
 600     case OP_DBSTATE:
 601         Safefree(cCOPo->cop_label);
 602         SvREFCNT_dec(cCOPo->cop_filegv);
 603         break;
 604     case OP_CONST:
 605         SvREFCNT_dec(cSVOPo->op_sv);
 606         break;
 607     case OP_GOTO:
 608     case OP_NEXT:
 609     case OP_LAST:
 610     case OP_REDO:
 611         if (o->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
 612             break;
 613         /* FALL THROUGH */
 614     case OP_TRANS:
 615         if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF))
 616             SvREFCNT_dec(cSVOPo->op_sv);
 617         else
 618             Safefree(cPVOPo->op_pv);
 619         break;
 620     case OP_SUBST:
 621         op_free(cPMOPo->op_pmreplroot);
 622         /* FALL THROUGH */
 623     case OP_PUSHRE:
 624     case OP_MATCH:
 625     case OP_QR:
 626         ReREFCNT_dec(cPMOPo->op_pmregexp);
 627         break;
 628     }
 629
 630     if (o->op_targ > 0)
 631         pad_free(o->op_targ);
 632
 633     Safefree(o);
 634 }
 635
 636 STATIC void
 637 null(OP *o)
 638 {
 639     if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0)
 640         pad_free(o->op_targ);
 641     o->op_targ = o->op_type;
 642     o->op_type = OP_NULL;
 643     o->op_ppaddr = ppaddr[OP_NULL];
 644 }
 645
 646 /* Contextualizers */
 647
 648 #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
 649
 650 OP *
 651 linklist(OP *o)
 652 {
 653     register OP *kid;
 654
 655     if (o->op_next)
 656         return o->op_next;
 657
 658     /* establish postfix order */
 659     if (cUNOPo->op_first) {
 660         o->op_next = LINKLIST(cUNOPo->op_first);
 661         for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
 662             if (kid->op_sibling)
 663                 kid->op_next = LINKLIST(kid->op_sibling);
 664             else
 665                 kid->op_next = o;
 666         }
 667     }
 668     else
 669         o->op_next = o;
 670
 671     return o->op_next;
 672 }
 673
 674 OP *
 675 scalarkids(OP *o)
 676 {
 677     OP *kid;
 678     if (o && o->op_flags & OPf_KIDS) {
 679         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
 680             scalar(kid);
 681     }
 682     return o;
 683 }
 684
 685 STATIC OP *
 686 scalarboolean(OP *o)
 687 {
 688     if (PL_dowarn &&
 689         o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
 690         dTHR;
 691         line_t oldline = PL_curcop->cop_line;
 692
 693         if (PL_copline != NOLINE)
 694             PL_curcop->cop_line = PL_copline;
 695         warn("Found = in conditional, should be ==");
 696         PL_curcop->cop_line = oldline;
 697     }
 698     return scalar(o);
 699 }
 700
 701 OP *
 702 scalar(OP *o)
 703 {
 704     OP *kid;
 705
 706     /* assumes no premature commitment */
 707     if (!o || (o->op_flags & OPf_WANT) || PL_error_count
 708          || o->op_type == OP_RETURN)
 709         return o;
 710
 711     o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
 712
 713     switch (o->op_type) {
 714     case OP_REPEAT:
 715         if (o->op_private & OPpREPEAT_DOLIST)
 716             null(((LISTOP*)cBINOPo->op_first)->op_first);
 717         scalar(cBINOPo->op_first);
 718         break;
 719     case OP_OR:
 720     case OP_AND:
 721     case OP_COND_EXPR:
 722         for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
 723             scalar(kid);
 724         break;
 725     case OP_SPLIT:
 726         if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
 727             if (!kPMOP->op_pmreplroot)
 728                 deprecate("implicit split to @_");
 729         }
 730         /* FALL THROUGH */
 731     case OP_MATCH:
 732     case OP_QR:
 733     case OP_SUBST:
 734     case OP_NULL:
 735     default:
 736         if (o->op_flags & OPf_KIDS) {
 737             for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
 738                 scalar(kid);
 739         }
 740         break;
 741     case OP_LEAVE:
 742     case OP_LEAVETRY:
 743         kid = cLISTOPo->op_first;
 744         scalar(kid);
 745         while (kid = kid->op_sibling) {
 746             if (kid->op_sibling)
 747                 scalarvoid(kid);
 748             else
 749                 scalar(kid);
 750         }
 751         WITH_THR(PL_curcop = &PL_compiling);
 752         break;
 753     case OP_SCOPE:
 754     case OP_LINESEQ:
 755     case OP_LIST:
 756         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
 757             if (kid->op_sibling)
 758                 scalarvoid(kid);
 759             else
 760                 scalar(kid);
 761         }
 762         WITH_THR(PL_curcop = &PL_compiling);
 763         break;
 764     }
 765     return o;
 766 }
 767
 768 OP *
 769 scalarvoid(OP *o)
 770 {
 771     OP *kid;
 772     char* useless = 0;
 773     SV* sv;
 774
 775     /* assumes no premature commitment */
 776     if (!o || (o->op_flags & OPf_WANT) == OPf_WANT_LIST || PL_error_count
 777          || o->op_type == OP_RETURN)
 778         return o;
 779
 780     o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
 781
 782     switch (o->op_type) {
 783     default:
 784         if (!(opargs[o->op_type] & OA_FOLDCONST))
 785             break;
 786         /* FALL THROUGH */
 787     case OP_REPEAT:
 788         if (o->op_flags & OPf_STACKED)
 789             break;
 790         goto func_ops;
 791     case OP_SUBSTR:
 792         if (o->op_private == 4)
 793             break;
 794         /* FALL THROUGH */
 795     case OP_GVSV:
 796     case OP_WANTARRAY:
 797     case OP_GV:
 798     case OP_PADSV:
 799     case OP_PADAV:
 800     case OP_PADHV:
 801     case OP_PADANY:
 802     case OP_AV2ARYLEN:
 803     case OP_REF:
 804     case OP_REFGEN:
 805     case OP_SREFGEN:
 806     case OP_DEFINED:
 807     case OP_HEX:
 808     case OP_OCT:
 809     case OP_LENGTH:
 810     case OP_VEC:
 811     case OP_INDEX:
 812     case OP_RINDEX:
 813     case OP_SPRINTF:
 814     case OP_AELEM:
 815     case OP_AELEMFAST:
 816     case OP_ASLICE:
 817     case OP_HELEM:
 818     case OP_HSLICE:
 819     case OP_UNPACK:
 820     case OP_PACK:
 821     case OP_JOIN:
 822     case OP_LSLICE:
 823     case OP_ANONLIST:
 824     case OP_ANONHASH:
 825     case OP_SORT:
 826     case OP_REVERSE:
 827     case OP_RANGE:
 828     case OP_FLIP:
 829     case OP_FLOP:
 830     case OP_CALLER:
 831     case OP_FILENO:
 832     case OP_EOF:
 833     case OP_TELL:
 834     case OP_GETSOCKNAME:
 835     case OP_GETPEERNAME:
 836     case OP_READLINK:
 837     case OP_TELLDIR:
 838     case OP_GETPPID:
 839     case OP_GETPGRP:
 840     case OP_GETPRIORITY:
 841     case OP_TIME:
 842     case OP_TMS:
 843     case OP_LOCALTIME:
 844     case OP_GMTIME:
 845     case OP_GHBYNAME:
 846     case OP_GHBYADDR:
 847     case OP_GHOSTENT:
 848     case OP_GNBYNAME:
 849     case OP_GNBYADDR:
 850     case OP_GNETENT:
 851     case OP_GPBYNAME:
 852     case OP_GPBYNUMBER:
 853     case OP_GPROTOENT:
 854     case OP_GSBYNAME:
 855     case OP_GSBYPORT:
 856     case OP_GSERVENT:
 857     case OP_GPWNAM:
 858     case OP_GPWUID:
 859     case OP_GGRNAM:
 860     case OP_GGRGID:
 861     case OP_GETLOGIN:
 862       func_ops:
 863         if (!(o->op_private & OPpLVAL_INTRO))
 864             useless = op_desc[o->op_type];
 865         break;
 866
 867     case OP_RV2GV:
 868     case OP_RV2SV:
 869     case OP_RV2AV:
 870     case OP_RV2HV:
 871         if (!(o->op_private & OPpLVAL_INTRO) &&
 872                 (!o->op_sibling || o->op_sibling->op_type != OP_READLINE))
 873             useless = "a variable";
 874         break;
 875
 876     case OP_NEXTSTATE:
 877     case OP_DBSTATE:
 878         WITH_THR(PL_curcop = ((COP*)o));                /* for warning below */
 879         break;
 880
 881     case OP_CONST:
 882         sv = cSVOPo->op_sv;
 883         if (PL_dowarn) {
 884             useless = "a constant";
 885             if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
 886                 useless = 0;
 887             else if (SvPOK(sv)) {
 888                 if (strnEQ(SvPVX(sv), "di", 2) ||
 889                     strnEQ(SvPVX(sv), "ds", 2) ||
 890                     strnEQ(SvPVX(sv), "ig", 2))
 891                         useless = 0;
 892             }
 893         }
 894         null(o);                /* don't execute a constant */
 895         SvREFCNT_dec(sv);       /* don't even remember it */
 896         break;
 897
 898     case OP_POSTINC:
 899         o->op_type = OP_PREINC;         /* pre-increment is faster */
 900         o->op_ppaddr = ppaddr[OP_PREINC];
 901         break;
 902
 903     case OP_POSTDEC:
 904         o->op_type = OP_PREDEC;         /* pre-decrement is faster */
 905         o->op_ppaddr = ppaddr[OP_PREDEC];
 906         break;
 907
 908     case OP_OR:
 909     case OP_AND:
 910     case OP_COND_EXPR:
 911         for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
 912             scalarvoid(kid);
 913         break;
 914
 915     case OP_NULL:
 916         if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
 917             WITH_THR(PL_curcop = ((COP*)o));    /* for warning below */
 918         if (o->op_flags & OPf_STACKED)
 919             break;
 920         /* FALL THROUGH */
 921     case OP_ENTERTRY:
 922     case OP_ENTER:
 923     case OP_SCALAR:
 924         if (!(o->op_flags & OPf_KIDS))
 925             break;
 926         /* FALL THROUGH */
 927     case OP_SCOPE:
 928     case OP_LEAVE:
 929     case OP_LEAVETRY:
 930     case OP_LEAVELOOP:
 931     case OP_LINESEQ:
 932     case OP_LIST:
 933         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
 934             scalarvoid(kid);
 935         break;
 936     case OP_ENTEREVAL:
 937         scalarkids(o);
 938         break;
 939     case OP_REQUIRE:
 940         /* all requires must return a boolean value */
 941         o->op_flags &= ~OPf_WANT;
 942         return scalar(o);
 943     case OP_SPLIT:
 944         if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
 945             if (!kPMOP->op_pmreplroot)
 946                 deprecate("implicit split to @_");
 947         }
 948         break;
 949     }
 950     if (useless && PL_dowarn)
 951         warn("Useless use of %s in void context", useless);
 952     return o;
 953 }
 954
 955 OP *
 956 listkids(OP *o)
 957 {
 958     OP *kid;
 959     if (o && o->op_flags & OPf_KIDS) {
 960         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
 961             list(kid);
 962     }
 963     return o;
 964 }
 965
 966 OP *
 967 list(OP *o)
 968 {
 969     OP *kid;
 970
 971     /* assumes no premature commitment */
 972     if (!o || (o->op_flags & OPf_WANT) || PL_error_count
 973          || o->op_type == OP_RETURN)
 974         return o;
 975
 976     o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_LIST;
 977
 978     switch (o->op_type) {
 979     case OP_FLOP:
 980     case OP_REPEAT:
 981         list(cBINOPo->op_first);
 982         break;
 983     case OP_OR:
 984     case OP_AND:
 985     case OP_COND_EXPR:
 986         for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
 987             list(kid);
 988         break;
 989     default:
 990     case OP_MATCH:
 991     case OP_QR:
 992     case OP_SUBST:
 993     case OP_NULL:
 994         if (!(o->op_flags & OPf_KIDS))
 995             break;
 996         if (!o->op_next && cUNOPo->op_first->op_type == OP_FLOP) {
 997             list(cBINOPo->op_first);
 998             return gen_constant_list(o);
 999         }
1000     case OP_LIST:
1001         listkids(o);
1002         break;
1003     case OP_LEAVE:
1004     case OP_LEAVETRY:
1005         kid = cLISTOPo->op_first;
1006         list(kid);
1007         while (kid = kid->op_sibling) {
1008             if (kid->op_sibling)
1009                 scalarvoid(kid);
1010             else
1011                 list(kid);
1012         }
1013         WITH_THR(PL_curcop = &PL_compiling);
1014         break;
1015     case OP_SCOPE:
1016     case OP_LINESEQ:
1017         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
1018             if (kid->op_sibling)
1019                 scalarvoid(kid);
1020             else
1021                 list(kid);
1022         }
1023         WITH_THR(PL_curcop = &PL_compiling);
1024         break;
1025     case OP_REQUIRE:
1026         /* all requires must return a boolean value */
1027         o->op_flags &= ~OPf_WANT;
1028         return scalar(o);
1029     }
1030     return o;
1031 }
1032
1033 OP *
1034 scalarseq(OP *o)
1035 {
1036     OP *kid;
1037
1038     if (o) {
1039         if (o->op_type == OP_LINESEQ ||
1040              o->op_type == OP_SCOPE ||
1041              o->op_type == OP_LEAVE ||
1042              o->op_type == OP_LEAVETRY)
1043         {
1044             dTHR;
1045             for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
1046                 if (kid->op_sibling) {
1047                     scalarvoid(kid);
1048                 }
1049             }
1050             PL_curcop = &PL_compiling;
1051         }
1052         o->op_flags &= ~OPf_PARENS;
1053         if (PL_hints & HINT_BLOCK_SCOPE)
1054             o->op_flags |= OPf_PARENS;
1055     }
1056     else
1057         o = newOP(OP_STUB, 0);
1058     return o;
1059 }
1060
1061 STATIC OP *
1062 modkids(OP *o, I32 type)
1063 {
1064     OP *kid;
1065     if (o && o->op_flags & OPf_KIDS) {
1066         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
1067             mod(kid, type);
1068     }
1069     return o;
1070 }
1071
1072 OP *
1073 mod(OP *o, I32 type)
1074 {
1075     dTHR;
1076     OP *kid;
1077     SV *sv;
1078
1079     if (!o || PL_error_count)
1080         return o;
1081
1082     switch (o->op_type) {
1083     case OP_UNDEF:
1084         PL_modcount++;
1085         return o;
1086     case OP_CONST:
1087         if (!(o->op_private & (OPpCONST_ARYBASE)))
1088             goto nomod;
1089         if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
1090             PL_compiling.cop_arybase = (I32)SvIV(((SVOP*)PL_eval_start)->op_sv);
1091             PL_eval_start = 0;
1092         }
1093         else if (!type) {
1094             SAVEI32(PL_compiling.cop_arybase);
1095             PL_compiling.cop_arybase = 0;
1096         }
1097         else if (type == OP_REFGEN)
1098             goto nomod;
1099         else
1100             croak("That use of $[ is unsupported");
1101         break;
1102     case OP_STUB:
1103         if (o->op_flags & OPf_PARENS)
1104             break;
1105         goto nomod;
1106     case OP_ENTERSUB:
1107         if ((type == OP_UNDEF || type == OP_REFGEN) &&
1108             !(o->op_flags & OPf_STACKED)) {
1109             o->op_type = OP_RV2CV;              /* entersub => rv2cv */
1110             o->op_ppaddr = ppaddr[OP_RV2CV];
1111             assert(cUNOPo->op_first->op_type == OP_NULL);
1112             null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
1113             break;
1114         }
1115         /* FALL THROUGH */
1116     default:
1117       nomod:
1118         /* grep, foreach, subcalls, refgen */
1119         if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
1120             break;
1121         yyerror(form("Can't modify %s in %s",
1122                      op_desc[o->op_type],
1123                      type ? op_desc[type] : "local"));
1124         return o;
1125
1126     case OP_PREINC:
1127     case OP_PREDEC:
1128     case OP_POW:
1129     case OP_MULTIPLY:
1130     case OP_DIVIDE:
1131     case OP_MODULO:
1132     case OP_REPEAT:
1133     case OP_ADD:
1134     case OP_SUBTRACT:
1135     case OP_CONCAT:
1136     case OP_LEFT_SHIFT:
1137     case OP_RIGHT_SHIFT:
1138     case OP_BIT_AND:
1139     case OP_BIT_XOR:
1140     case OP_BIT_OR:
1141     case OP_I_MULTIPLY:
1142     case OP_I_DIVIDE:
1143     case OP_I_MODULO:
1144     case OP_I_ADD:
1145     case OP_I_SUBTRACT:
1146         if (!(o->op_flags & OPf_STACKED))
1147             goto nomod;
1148         PL_modcount++;
1149         break;
1150
1151     case OP_COND_EXPR:
1152         for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
1153             mod(kid, type);
1154         break;
1155
1156     case OP_RV2AV:
1157     case OP_RV2HV:
1158         if (!type && cUNOPo->op_first->op_type != OP_GV)
1159             croak("Can't localize through a reference");
1160         if (type == OP_REFGEN && o->op_flags & OPf_PARENS) {
1161             PL_modcount = 10000;
1162             return o;           /* Treat \(@foo) like ordinary list. */
1163         }
1164         /* FALL THROUGH */
1165     case OP_RV2GV:
1166         if (scalar_mod_type(o, type))
1167             goto nomod;
1168         ref(cUNOPo->op_first, o->op_type);
1169         /* FALL THROUGH */
1170     case OP_AASSIGN:
1171     case OP_ASLICE:
1172     case OP_HSLICE:
1173     case OP_NEXTSTATE:
1174     case OP_DBSTATE:
1175     case OP_REFGEN:
1176     case OP_CHOMP:
1177         PL_modcount = 10000;
1178         break;
1179     case OP_RV2SV:
1180         if (!type && cUNOPo->op_first->op_type != OP_GV)
1181             croak("Can't localize through a reference");
1182         ref(cUNOPo->op_first, o->op_type);
1183         /* FALL THROUGH */
1184     case OP_GV:
1185     case OP_AV2ARYLEN:
1186         PL_hints |= HINT_BLOCK_SCOPE;
1187     case OP_SASSIGN:
1188     case OP_AELEMFAST:
1189         PL_modcount++;
1190         break;
1191
1192     case OP_PADAV:
1193     case OP_PADHV:
1194         PL_modcount = 10000;
1195         if (type == OP_REFGEN && o->op_flags & OPf_PARENS)
1196             return o;           /* Treat \(@foo) like ordinary list. */
1197         if (scalar_mod_type(o, type))
1198             goto nomod;
1199         /* FALL THROUGH */
1200     case OP_PADSV:
1201         PL_modcount++;
1202         if (!type)
1203             croak("Can't localize lexical variable %s",
1204                 SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), PL_na));
1205         break;
1206
1207 #ifdef USE_THREADS
1208     case OP_THREADSV:
1209         PL_modcount++;  /* XXX ??? */
1210         break;
1211 #endif /* USE_THREADS */
1212
1213     case OP_PUSHMARK:
1214         break;
1215
1216     case OP_KEYS:
1217         if (type != OP_SASSIGN)
1218             goto nomod;
1219         goto lvalue_func;
1220     case OP_SUBSTR:
1221         if (o->op_private == 4) /* don't allow 4 arg substr as lvalue */
1222             goto nomod;
1223         /* FALL THROUGH */
1224     case OP_POS:
1225     case OP_VEC:
1226       lvalue_func:
1227         pad_free(o->op_targ);
1228         o->op_targ = pad_alloc(o->op_type, SVs_PADMY);
1229         assert(SvTYPE(PAD_SV(o->op_targ)) == SVt_NULL);
1230         if (o->op_flags & OPf_KIDS)
1231             mod(cBINOPo->op_first->op_sibling, type);
1232         break;
1233
1234     case OP_AELEM:
1235     case OP_HELEM:
1236         ref(cBINOPo->op_first, o->op_type);
1237         if (type == OP_ENTERSUB &&
1238              !(o->op_private & (OPpLVAL_INTRO | OPpDEREF)))
1239             o->op_private |= OPpLVAL_DEFER;
1240         PL_modcount++;
1241         break;
1242
1243     case OP_SCOPE:
1244     case OP_LEAVE:
1245     case OP_ENTER:
1246         if (o->op_flags & OPf_KIDS)
1247             mod(cLISTOPo->op_last, type);
1248         break;
1249
1250     case OP_NULL:
1251         if (!(o->op_flags & OPf_KIDS))
1252             break;
1253         if (o->op_targ != OP_LIST) {
1254             mod(cBINOPo->op_first, type);
1255             break;
1256         }
1257         /* FALL THROUGH */
1258     case OP_LIST:
1259         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
1260             mod(kid, type);
1261         break;
1262     }
1263     o->op_flags |= OPf_MOD;
1264
1265     if (type == OP_AASSIGN || type == OP_SASSIGN)
1266         o->op_flags |= OPf_SPECIAL|OPf_REF;
1267     else if (!type) {
1268         o->op_private |= OPpLVAL_INTRO;
1269         o->op_flags &= ~OPf_SPECIAL;
1270         PL_hints |= HINT_BLOCK_SCOPE;
1271     }
1272     else if (type != OP_GREPSTART && type != OP_ENTERSUB)
1273         o->op_flags |= OPf_REF;
1274     return o;
1275 }
1276
1277 static bool
1278 scalar_mod_type(OP *o, I32 type)
1279 {
1280     switch (type) {
1281     case OP_SASSIGN:
1282         if (o->op_type == OP_RV2GV)
1283             return FALSE;
1284         /* FALL THROUGH */
1285     case OP_PREINC:
1286     case OP_PREDEC:
1287     case OP_POSTINC:
1288     case OP_POSTDEC:
1289     case OP_I_PREINC:
1290     case OP_I_PREDEC:
1291     case OP_I_POSTINC:
1292     case OP_I_POSTDEC:
1293     case OP_POW:
1294     case OP_MULTIPLY:
1295     case OP_DIVIDE:
1296     case OP_MODULO:
1297     case OP_REPEAT:
1298     case OP_ADD:
1299     case OP_SUBTRACT:
1300     case OP_I_MULTIPLY:
1301     case OP_I_DIVIDE:
1302     case OP_I_MODULO:
1303     case OP_I_ADD:
1304     case OP_I_SUBTRACT:
1305     case OP_LEFT_SHIFT:
1306     case OP_RIGHT_SHIFT:
1307     case OP_BIT_AND:
1308     case OP_BIT_XOR:
1309     case OP_BIT_OR:
1310     case OP_CONCAT:
1311     case OP_SUBST:
1312     case OP_TRANS:
1313     case OP_READ:
1314     case OP_SYSREAD:
1315     case OP_RECV:
1316     case OP_ANDASSIGN:  /* may work later */
1317     case OP_ORASSIGN:   /* may work later */
1318         return TRUE;
1319     default:
1320         return FALSE;
1321     }
1322 }
1323
1324 OP *
1325 refkids(OP *o, I32 type)
1326 {
1327     OP *kid;
1328     if (o && o->op_flags & OPf_KIDS) {
1329         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
1330             ref(kid, type);
1331     }
1332     return o;
1333 }
1334
1335 OP *
1336 ref(OP *o, I32 type)
1337 {
1338     OP *kid;
1339
1340     if (!o || PL_error_count)
1341         return o;
1342
1343     switch (o->op_type) {
1344     case OP_ENTERSUB:
1345         if ((type == OP_DEFINED || type == OP_LOCK) &&
1346             !(o->op_flags & OPf_STACKED)) {
1347             o->op_type = OP_RV2CV;             /* entersub => rv2cv */
1348             o->op_ppaddr = ppaddr[OP_RV2CV];
1349             assert(cUNOPo->op_first->op_type == OP_NULL);
1350             null(((LISTOP*)cUNOPo->op_first)->op_first);        /* disable pushmark */
1351             o->op_flags |= OPf_SPECIAL;
1352         }
1353         break;
1354
1355     case OP_COND_EXPR:
1356         for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
1357             ref(kid, type);
1358         break;
1359     case OP_RV2SV:
1360         ref(cUNOPo->op_first, o->op_type);
1361         /* FALL THROUGH */
1362     case OP_PADSV:
1363         if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
1364             o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
1365                               : type == OP_RV2HV ? OPpDEREF_HV
1366                               : OPpDEREF_SV);
1367             o->op_flags |= OPf_MOD;
1368         }
1369         break;
1370
1371     case OP_THREADSV:
1372         o->op_flags |= OPf_MOD;         /* XXX ??? */
1373         break;
1374
1375     case OP_RV2AV:
1376     case OP_RV2HV:
1377         o->op_flags |= OPf_REF;
1378         /* FALL THROUGH */
1379     case OP_RV2GV:
1380         ref(cUNOPo->op_first, o->op_type);
1381         break;
1382
1383     case OP_PADAV:
1384     case OP_PADHV:
1385         o->op_flags |= OPf_REF;
1386         break;
1387
1388     case OP_SCALAR:
1389     case OP_NULL:
1390         if (!(o->op_flags & OPf_KIDS))
1391             break;
1392         ref(cBINOPo->op_first, type);
1393         break;
1394     case OP_AELEM:
1395     case OP_HELEM:
1396         ref(cBINOPo->op_first, o->op_type);
1397         if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
1398             o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
1399                               : type == OP_RV2HV ? OPpDEREF_HV
1400                               : OPpDEREF_SV);
1401             o->op_flags |= OPf_MOD;
1402         }
1403         break;
1404
1405     case OP_SCOPE:
1406     case OP_LEAVE:
1407     case OP_ENTER:
1408     case OP_LIST:
1409         if (!(o->op_flags & OPf_KIDS))
1410             break;
1411         ref(cLISTOPo->op_last, type);
1412         break;
1413     default:
1414         break;
1415     }
1416     return scalar(o);
1417
1418 }
1419
1420 OP *
1421 my(OP *o)
1422 {
1423     OP *kid;
1424     I32 type;
1425
1426     if (!o || PL_error_count)
1427         return o;
1428
1429     type = o->op_type;
1430     if (type == OP_LIST) {
1431         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
1432             my(kid);
1433     } else if (type == OP_UNDEF) {
1434         return o;
1435     } else if (type != OP_PADSV &&
1436              type != OP_PADAV &&
1437              type != OP_PADHV &&
1438              type != OP_PUSHMARK)
1439     {
1440         yyerror(form("Can't declare %s in my", op_desc[o->op_type]));
1441         return o;
1442     }
1443     o->op_flags |= OPf_MOD;
1444     o->op_private |= OPpLVAL_INTRO;
1445     return o;
1446 }
1447
1448 OP *
1449 sawparens(OP *o)
1450 {
1451     if (o)
1452         o->op_flags |= OPf_PARENS;
1453     return o;
1454 }
1455
1456 OP *
1457 bind_match(I32 type, OP *left, OP *right)
1458 {
1459     OP *o;
1460
1461     if (PL_dowarn &&
1462         (left->op_type == OP_RV2AV ||
1463          left->op_type == OP_RV2HV ||
1464          left->op_type == OP_PADAV ||
1465          left->op_type == OP_PADHV)) {
1466         char *desc = op_desc[(right->op_type == OP_SUBST ||
1467                               right->op_type == OP_TRANS)
1468                              ? right->op_type : OP_MATCH];
1469         char *sample = ((left->op_type == OP_RV2AV ||
1470                          left->op_type == OP_PADAV)
1471                         ? "@array" : "%hash");
1472         warn("Applying %s to %s will act on scalar(%s)", desc, sample, sample);
1473     }
1474
1475     if (right->op_type == OP_MATCH ||
1476         right->op_type == OP_SUBST ||
1477         right->op_type == OP_TRANS) {
1478         right->op_flags |= OPf_STACKED;
1479         if (right->op_type != OP_MATCH)
1480             left = mod(left, right->op_type);
1481         if (right->op_type == OP_TRANS)
1482             o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
1483         else
1484             o = prepend_elem(right->op_type, scalar(left), right);
1485         if (type == OP_NOT)
1486             return newUNOP(OP_NOT, 0, scalar(o));
1487         return o;
1488     }
1489     else
1490         return bind_match(type, left,
1491                 pmruntime(newPMOP(OP_MATCH, 0), right, Nullop));
1492 }
1493
1494 OP *
1495 invert(OP *o)
1496 {
1497     if (!o)
1498         return o;
1499     /* XXX need to optimize away NOT NOT here?  Or do we let optimizer do it? */
1500     return newUNOP(OP_NOT, OPf_SPECIAL, scalar(o));
1501 }
1502
1503 OP *
1504 scope(OP *o)
1505 {
1506     if (o) {
1507         if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || PL_tainting) {
1508             o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
1509             o->op_type = OP_LEAVE;
1510             o->op_ppaddr = ppaddr[OP_LEAVE];
1511         }
1512         else {
1513             if (o->op_type == OP_LINESEQ) {
1514                 OP *kid;
1515                 o->op_type = OP_SCOPE;
1516                 o->op_ppaddr = ppaddr[OP_SCOPE];
1517                 kid = ((LISTOP*)o)->op_first;
1518                 if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
1519                     SvREFCNT_dec(((COP*)kid)->cop_filegv);
1520                     null(kid);
1521                 }
1522             }
1523             else
1524                 o = newLISTOP(OP_SCOPE, 0, o, Nullop);
1525         }
1526     }
1527     return o;
1528 }
1529
1530 void
1531 save_hints(void)
1532 {
1533     SAVEI32(PL_hints);
1534     SAVESPTR(GvHV(PL_hintgv));
1535     GvHV(PL_hintgv) = newHVhv(GvHV(PL_hintgv));
1536     SAVEFREESV(GvHV(PL_hintgv));
1537 }
1538
1539 int
1540 block_start(int full)
1541 {
1542     dTHR;
1543     int retval = PL_savestack_ix;
1544
1545     SAVEI32(PL_comppad_name_floor);
1546     if (full) {
1547         if ((PL_comppad_name_fill = AvFILLp(PL_comppad_name)) > 0)
1548             PL_comppad_name_floor = PL_comppad_name_fill;
1549         else
1550             PL_comppad_name_floor = 0;
1551     }
1552     SAVEI32(PL_min_intro_pending);
1553     SAVEI32(PL_max_intro_pending);
1554     PL_min_intro_pending = 0;
1555     SAVEI32(PL_comppad_name_fill);
1556     SAVEI32(PL_padix_floor);
1557     PL_padix_floor = PL_padix;
1558     PL_pad_reset_pending = FALSE;
1559     SAVEHINTS();
1560     PL_hints &= ~HINT_BLOCK_SCOPE;
1561     return retval;
1562 }
1563
1564 OP*
1565 block_end(I32 floor, OP *seq)
1566 {
1567     dTHR;
1568     int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
1569     OP* retval = scalarseq(seq);
1570     LEAVE_SCOPE(floor);
1571     PL_pad_reset_pending = FALSE;
1572     compiling.op_private = PL_hints;
1573     if (needblockscope)
1574         PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
1575     pad_leavemy(PL_comppad_name_fill);
1576     PL_cop_seqmax++;
1577     return retval;
1578 }
1579
1580 STATIC OP *
1581 newDEFSVOP(void)
1582 {
1583 #ifdef USE_THREADS
1584     OP *o = newOP(OP_THREADSV, 0);
1585     o->op_targ = find_threadsv("_");
1586     return o;
1587 #else
1588     return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
1589 #endif /* USE_THREADS */
1590 }
1591
1592 void
1593 newPROG(OP *o)
1594 {
1595     dTHR;
1596     if (PL_in_eval) {
1597         PL_eval_root = newUNOP(OP_LEAVEEVAL, ((PL_in_eval & 4) ? OPf_SPECIAL : 0), o);
1598         PL_eval_start = linklist(PL_eval_root);
1599         PL_eval_root->op_next = 0;
1600         peep(PL_eval_start);
1601     }
1602     else {
1603         if (!o)
1604             return;
1605         PL_main_root = scope(sawparens(scalarvoid(o)));
1606         PL_curcop = &PL_compiling;
1607         PL_main_start = LINKLIST(PL_main_root);
1608         PL_main_root->op_next = 0;
1609         peep(PL_main_start);
1610         PL_compcv = 0;
1611
1612         /* Register with debugger */
1613         if (PERLDB_INTER) {
1614             CV *cv = perl_get_cv("DB::postponed", FALSE);
1615             if (cv) {
1616                 dSP;
1617                 PUSHMARK(SP);
1618                 XPUSHs((SV*)PL_compiling.cop_filegv);
1619                 PUTBACK;
1620                 perl_call_sv((SV*)cv, G_DISCARD);
1621             }
1622         }
1623     }
1624 }
1625
1626 OP *
1627 localize(OP *o, I32 lex)
1628 {
1629     if (o->op_flags & OPf_PARENS)
1630         list(o);
1631     else {
1632         if (PL_dowarn && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',') {
1633             char *s;
1634             for (s = PL_bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
1635             if (*s == ';' || *s == '=')
1636                 warn("Parens missing around \"%s\" list", lex ? "my" : "local");
1637         }
1638     }
1639     PL_in_my = FALSE;
1640     PL_in_my_stash = Nullhv;
1641     if (lex)
1642         return my(o);
1643     else
1644         return mod(o, OP_NULL);         /* a bit kludgey */
1645 }
1646
1647 OP *
1648 jmaybe(OP *o)
1649 {
1650     if (o->op_type == OP_LIST) {
1651         OP *o2;
1652 #ifdef USE_THREADS
1653         o2 = newOP(OP_THREADSV, 0);
1654         o2->op_targ = find_threadsv(";");
1655 #else
1656         o2 = newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
1657 #endif /* USE_THREADS */
1658         o = convert(OP_JOIN, 0, prepend_elem(OP_LIST, o2, o));
1659     }
1660     return o;
1661 }
1662
1663 OP *
1664 fold_constants(register OP *o)
1665 {
1666     dTHR;
1667     register OP *curop;
1668     I32 type = o->op_type;
1669     SV *sv;
1670
1671     if (opargs[type] & OA_RETSCALAR)
1672         scalar(o);
1673     if (opargs[type] & OA_TARGET)
1674         o->op_targ = pad_alloc(type, SVs_PADTMP);
1675
1676     if ((opargs[type] & OA_OTHERINT) && (PL_hints & HINT_INTEGER))
1677         o->op_ppaddr = ppaddr[type = ++(o->op_type)];
1678
1679     if (!(opargs[type] & OA_FOLDCONST))
1680         goto nope;
1681
1682     switch (type) {
1683     case OP_SPRINTF:
1684     case OP_UCFIRST:
1685     case OP_LCFIRST:
1686     case OP_UC:
1687     case OP_LC:
1688     case OP_SLT:
1689     case OP_SGT:
1690     case OP_SLE:
1691     case OP_SGE:
1692     case OP_SCMP:
1693
1694         if (o->op_private & OPpLOCALE)
1695             goto nope;
1696     }
1697
1698     if (PL_error_count)
1699         goto nope;              /* Don't try to run w/ errors */
1700
1701     for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
1702         if (curop->op_type != OP_CONST &&
1703                 curop->op_type != OP_LIST &&
1704                 curop->op_type != OP_SCALAR &&
1705                 curop->op_type != OP_NULL &&
1706                 curop->op_type != OP_PUSHMARK) {
1707             goto nope;
1708         }
1709     }
1710
1711     curop = LINKLIST(o);
1712     o->op_next = 0;
1713     PL_op = curop;
1714     CALLRUNOPS();
1715     sv = *(PL_stack_sp--);
1716     if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */
1717         pad_swipe(o->op_targ);
1718     else if (SvTEMP(sv)) {                      /* grab mortal temp? */
1719         (void)SvREFCNT_inc(sv);
1720         SvTEMP_off(sv);
1721     }
1722     op_free(o);
1723     if (type == OP_RV2GV)
1724         return newGVOP(OP_GV, 0, (GV*)sv);
1725     else {
1726         /* try to smush double to int, but don't smush -2.0 to -2 */
1727         if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK &&
1728             type != OP_NEGATE)
1729         {
1730             IV iv = SvIV(sv);
1731             if ((double)iv == SvNV(sv)) {
1732                 SvREFCNT_dec(sv);
1733                 sv = newSViv(iv);
1734             }
1735             else
1736                 SvIOK_off(sv);                  /* undo SvIV() damage */
1737         }
1738         return newSVOP(OP_CONST, 0, sv);
1739     }
1740
1741   nope:
1742     if (!(opargs[type] & OA_OTHERINT))
1743         return o;
1744
1745     if (!(PL_hints & HINT_INTEGER)) {
1746         if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS))
1747             return o;
1748
1749         for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
1750             if (curop->op_type == OP_CONST) {
1751                 if (SvIOK(((SVOP*)curop)->op_sv))
1752                     continue;
1753                 return o;
1754             }
1755             if (opargs[curop->op_type] & OA_RETINTEGER)
1756                 continue;
1757             return o;
1758         }
1759         o->op_ppaddr = ppaddr[++(o->op_type)];
1760     }
1761
1762     return o;
1763 }
1764
1765 OP *
1766 gen_constant_list(register OP *o)
1767 {
1768     dTHR;
1769     register OP *curop;
1770     I32 oldtmps_floor = PL_tmps_floor;
1771
1772     list(o);
1773     if (PL_error_count)
1774         return o;               /* Don't attempt to run with errors */
1775
1776     PL_op = curop = LINKLIST(o);
1777     o->op_next = 0;
1778     pp_pushmark(ARGS);
1779     CALLRUNOPS();
1780     PL_op = curop;
1781     pp_anonlist(ARGS);
1782     PL_tmps_floor = oldtmps_floor;
1783
1784     o->op_type = OP_RV2AV;
1785     o->op_ppaddr = ppaddr[OP_RV2AV];
1786     curop = ((UNOP*)o)->op_first;
1787     ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--));
1788     op_free(curop);
1789     linklist(o);
1790     return list(o);
1791 }
1792
1793 OP *
1794 convert(I32 type, I32 flags, OP *o)
1795 {
1796     OP *kid;
1797     OP *last = 0;
1798
1799     if (!o || o->op_type != OP_LIST)
1800         o = newLISTOP(OP_LIST, 0, o, Nullop);
1801     else
1802         o->op_flags &= ~OPf_WANT;
1803
1804     if (!(opargs[type] & OA_MARK))
1805         null(cLISTOPo->op_first);
1806
1807     o->op_type = type;
1808     o->op_ppaddr = ppaddr[type];
1809     o->op_flags |= flags;
1810
1811     o = CHECKOP(type, o);
1812     if (o->op_type != type)
1813         return o;
1814
1815     if (cLISTOPo->op_children < 7) {
1816         /* XXX do we really need to do this if we're done appending?? */
1817         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
1818             last = kid;
1819         cLISTOPo->op_last = last;       /* in case check substituted last arg */
1820     }
1821
1822     return fold_constants(o);
1823 }
1824
1825 /* List constructors */
1826
1827 OP *
1828 append_elem(I32 type, OP *first, OP *last)
1829 {
1830     if (!first)
1831         return last;
1832
1833     if (!last)
1834         return first;
1835
1836     if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS)
1837             return newLISTOP(type, 0, first, last);
1838
1839     if (first->op_flags & OPf_KIDS)
1840         ((LISTOP*)first)->op_last->op_sibling = last;
1841     else {
1842         first->op_flags |= OPf_KIDS;
1843         ((LISTOP*)first)->op_first = last;
1844     }
1845     ((LISTOP*)first)->op_last = last;
1846     ((LISTOP*)first)->op_children++;
1847     return first;
1848 }
1849
1850 OP *
1851 append_list(I32 type, LISTOP *first, LISTOP *last)
1852 {
1853     if (!first)
1854         return (OP*)last;
1855
1856     if (!last)
1857         return (OP*)first;
1858
1859     if (first->op_type != type)
1860         return prepend_elem(type, (OP*)first, (OP*)last);
1861
1862     if (last->op_type != type)
1863         return append_elem(type, (OP*)first, (OP*)last);
1864
1865     first->op_last->op_sibling = last->op_first;
1866     first->op_last = last->op_last;
1867     first->op_children += last->op_children;
1868     if (first->op_children)
1869         last->op_flags |= OPf_KIDS;
1870
1871     Safefree(last);
1872     return (OP*)first;
1873 }
1874
1875 OP *
1876 prepend_elem(I32 type, OP *first, OP *last)
1877 {
1878     if (!first)
1879         return last;
1880
1881     if (!last)
1882         return first;
1883
1884     if (last->op_type == type) {
1885         if (type == OP_LIST) {  /* already a PUSHMARK there */
1886             first->op_sibling = ((LISTOP*)last)->op_first->op_sibling;
1887             ((LISTOP*)last)->op_first->op_sibling = first;
1888         }
1889         else {
1890             if (!(last->op_flags & OPf_KIDS)) {
1891                 ((LISTOP*)last)->op_last = first;
1892                 last->op_flags |= OPf_KIDS;
1893             }
1894             first->op_sibling = ((LISTOP*)last)->op_first;
1895             ((LISTOP*)last)->op_first = first;
1896         }
1897         ((LISTOP*)last)->op_children++;
1898         return last;
1899     }
1900
1901     return newLISTOP(type, 0, first, last);
1902 }
1903
1904 /* Constructors */
1905
1906 OP *
1907 newNULLLIST(void)
1908 {
1909     return newOP(OP_STUB, 0);
1910 }
1911
1912 OP *
1913 force_list(OP *o)
1914 {
1915     if (!o || o->op_type != OP_LIST)
1916         o = newLISTOP(OP_LIST, 0, o, Nullop);
1917     null(o);
1918     return o;
1919 }
1920
1921 OP *
1922 newLISTOP(I32 type, I32 flags, OP *first, OP *last)
1923 {
1924     LISTOP *listop;
1925
1926     Newz(1101, listop, 1, LISTOP);
1927
1928     listop->op_type = type;
1929     listop->op_ppaddr = ppaddr[type];
1930     listop->op_children = (first != 0) + (last != 0);
1931     listop->op_flags = flags;
1932
1933     if (!last && first)
1934         last = first;
1935     else if (!first && last)
1936         first = last;
1937     else if (first)
1938         first->op_sibling = last;
1939     listop->op_first = first;
1940     listop->op_last = last;
1941     if (type == OP_LIST) {
1942         OP* pushop;
1943         pushop = newOP(OP_PUSHMARK, 0);
1944         pushop->op_sibling = first;
1945         listop->op_first = pushop;
1946         listop->op_flags |= OPf_KIDS;
1947         if (!last)
1948             listop->op_last = pushop;
1949     }
1950     else if (listop->op_children)
1951         listop->op_flags |= OPf_KIDS;
1952
1953     return (OP*)listop;
1954 }
1955
1956 OP *
1957 newOP(I32 type, I32 flags)
1958 {
1959     OP *o;
1960     Newz(1101, o, 1, OP);
1961     o->op_type = type;
1962     o->op_ppaddr = ppaddr[type];
1963     o->op_flags = flags;
1964
1965     o->op_next = o;
1966     o->op_private = 0 + (flags >> 8);
1967     if (opargs[type] & OA_RETSCALAR)
1968         scalar(o);
1969     if (opargs[type] & OA_TARGET)
1970         o->op_targ = pad_alloc(type, SVs_PADTMP);
1971     return CHECKOP(type, o);
1972 }
1973
1974 OP *
1975 newUNOP(I32 type, I32 flags, OP *first)
1976 {
1977     UNOP *unop;
1978
1979     if (!first)
1980         first = newOP(OP_STUB, 0);
1981     if (opargs[type] & OA_MARK)
1982         first = force_list(first);
1983
1984     Newz(1101, unop, 1, UNOP);
1985     unop->op_type = type;
1986     unop->op_ppaddr = ppaddr[type];
1987     unop->op_first = first;
1988     unop->op_flags = flags | OPf_KIDS;
1989     unop->op_private = 1 | (flags >> 8);
1990     unop = (UNOP*) CHECKOP(type, unop);
1991     if (unop->op_next)
1992         return (OP*)unop;
1993
1994     return fold_constants((OP *) unop);
1995 }
1996
1997 OP *
1998 newBINOP(I32 type, I32 flags, OP *first, OP *last)
1999 {
2000     BINOP *binop;
2001     Newz(1101, binop, 1, BINOP);
2002
2003     if (!first)
2004         first = newOP(OP_NULL, 0);
2005
2006     binop->op_type = type;
2007     binop->op_ppaddr = ppaddr[type];
2008     binop->op_first = first;
2009     binop->op_flags = flags | OPf_KIDS;
2010     if (!last) {
2011         last = first;
2012         binop->op_private = 1 | (flags >> 8);
2013     }
2014     else {
2015         binop->op_private = 2 | (flags >> 8);
2016         first->op_sibling = last;
2017     }
2018
2019     binop = (BINOP*)CHECKOP(type, binop);
2020     if (binop->op_next)
2021         return (OP*)binop;
2022
2023     binop->op_last = last = binop->op_first->op_sibling;
2024
2025     return fold_constants((OP *)binop);
2026 }
2027
2028 static int
2029 utf8compare(const void *a, const void *b)
2030 {
2031     int i;
2032     for (i = 0; i < 10; i++) {
2033         if ((*(U8**)a)[i] < (*(U8**)b)[i])
2034             return -1;
2035         if ((*(U8**)a)[i] > (*(U8**)b)[i])
2036             return 1;
2037     }
2038     return 0;
2039 }
2040
2041 OP *
2042 pmtrans(OP *o, OP *expr, OP *repl)
2043 {
2044     SV *tstr = ((SVOP*)expr)->op_sv;
2045     SV *rstr = ((SVOP*)repl)->op_sv;
2046     STRLEN tlen;
2047     STRLEN rlen;
2048     register U8 *t = (U8*)SvPV(tstr, tlen);
2049     register U8 *r = (U8*)SvPV(rstr, rlen);
2050     register I32 i;
2051     register I32 j;
2052     I32 del;
2053     I32 complement;
2054     I32 squash;
2055     register short *tbl;
2056
2057     complement  = o->op_private & OPpTRANS_COMPLEMENT;
2058     del         = o->op_private & OPpTRANS_DELETE;
2059     squash      = o->op_private & OPpTRANS_SQUASH;
2060
2061     if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
2062         SV* listsv = newSVpv("# comment\n",0);
2063         SV* transv = 0;
2064         U8* tend = t + tlen;
2065         U8* rend = r + rlen;
2066         I32 ulen;
2067         U32 tfirst = 1;
2068         U32 tlast = 0;
2069         I32 tdiff;
2070         U32 rfirst = 1;
2071         U32 rlast = 0;
2072         I32 rdiff;
2073         I32 diff;
2074         I32 none = 0;
2075         U32 max = 0;
2076         I32 bits;
2077         I32 grows = 0;
2078         I32 havefinal = 0;
2079         U32 final;
2080         HV *hv;
2081         I32 from_utf    = o->op_private & OPpTRANS_FROM_UTF;
2082         I32 to_utf      = o->op_private & OPpTRANS_TO_UTF;
2083
2084         if (complement) {
2085             U8 tmpbuf[10];
2086             U8** cp;
2087             UV nextmin = 0;
2088             New(1109, cp, tlen, U8*);
2089             i = 0;
2090             transv = newSVpv("",0);
2091             while (t < tend) {
2092                 cp[i++] = t;
2093                 t += UTF8SKIP(t);
2094                 if (*t == 0xff) {
2095                     t++;
2096                     t += UTF8SKIP(t);
2097                 }
2098             }
2099             qsort(cp, i, sizeof(U8*), utf8compare);
2100             for (j = 0; j < i; j++) {
2101                 U8 *s = cp[j];
2102                 UV val = utf8_to_uv(s, &ulen);
2103                 s += ulen;
2104                 diff = val - nextmin;
2105                 if (diff > 0) {
2106                     t = uv_to_utf8(tmpbuf,nextmin);
2107                     sv_catpvn(transv, tmpbuf, t - tmpbuf);
2108                     if (diff > 1) {
2109                         t = uv_to_utf8(tmpbuf, val - 1);
2110                         sv_catpvn(transv, "\377", 1);
2111                         sv_catpvn(transv, tmpbuf, t - tmpbuf);
2112                     }
2113                 }
2114                 if (*s == 0xff)
2115                     val = utf8_to_uv(s+1, &ulen);
2116                 if (val >= nextmin)
2117                     nextmin = val + 1;
2118             }
2119             t = uv_to_utf8(tmpbuf,nextmin);
2120             sv_catpvn(transv, tmpbuf, t - tmpbuf);
2121             t = uv_to_utf8(tmpbuf, 0x7fffffff);
2122             sv_catpvn(transv, "\377", 1);
2123             sv_catpvn(transv, tmpbuf, t - tmpbuf);
2124             t = SvPVX(transv);
2125             tlen = SvCUR(transv);
2126             tend = t + tlen;
2127         }
2128         else if (!rlen && !del) {
2129             r = t; rlen = tlen; rend = tend;
2130             if (!squash && to_utf && from_utf)
2131                 o->op_private |= OPpTRANS_COUNTONLY;
2132         }
2133
2134         while (t < tend || tfirst <= tlast) {
2135             /* see if we need more "t" chars */
2136             if (tfirst > tlast) {
2137                 tfirst = (I32)utf8_to_uv(t, &ulen);
2138                 t += ulen;
2139                 if (t < tend && *t == 0xff) {   /* illegal utf8 val indicates range */
2140                     tlast = (I32)utf8_to_uv(++t, &ulen);
2141                     t += ulen;
2142                 }
2143                 else
2144                     tlast = tfirst;
2145             }
2146
2147             /* now see if we need more "r" chars */
2148             if (rfirst > rlast) {
2149                 if (r < rend) {
2150                     rfirst = (I32)utf8_to_uv(r, &ulen);
2151                     r += ulen;
2152                     if (r < rend && *r == 0xff) {       /* illegal utf8 val indicates range */
2153                         rlast = (I32)utf8_to_uv(++r, &ulen);
2154                         r += ulen;
2155                     }
2156                     else
2157                         rlast = rfirst;
2158                 }
2159                 else {
2160                     if (!havefinal++)
2161                         final = rlast;
2162                     rfirst = rlast = 0xffffffff;
2163                 }
2164             }
2165
2166             /* now see which range will peter our first, if either. */
2167             tdiff = tlast - tfirst;
2168             rdiff = rlast - rfirst;
2169
2170             if (tdiff <= rdiff)
2171                 diff = tdiff;
2172             else
2173                 diff = rdiff;
2174
2175             if (rfirst == 0xffffffff) {
2176                 diff = tdiff;   /* oops, pretend rdiff is infinite */
2177                 if (diff > 0)
2178                     sv_catpvf(listsv, "%04x\t%04x\tXXXX\n", tfirst, tlast);
2179                 else
2180                     sv_catpvf(listsv, "%04x\t\tXXXX\n", tfirst);
2181             }
2182             else {
2183                 if (diff > 0)
2184                     sv_catpvf(listsv, "%04x\t%04x\t%04x\n", tfirst, tfirst + diff, rfirst);
2185                 else
2186                     sv_catpvf(listsv, "%04x\t\t%04x\n", tfirst, rfirst);
2187
2188                 if (rfirst + diff > max)
2189                     max = rfirst + diff;
2190                 rfirst += diff + 1;
2191                 if (!grows) {
2192                     if (rfirst <= 0x80)
2193                         ;
2194                     else if (rfirst <= 0x800)
2195                         grows |= (tfirst < 0x80);
2196                     else if (rfirst <= 0x10000)
2197                         grows |= (tfirst < 0x800);
2198                     else if (rfirst <= 0x200000)
2199                         grows |= (tfirst < 0x10000);
2200                     else if (rfirst <= 0x4000000)
2201                         grows |= (tfirst < 0x200000);
2202                     else if (rfirst <= 0x80000000)
2203                         grows |= (tfirst < 0x4000000);
2204                 }
2205             }
2206             tfirst += diff + 1;
2207         }
2208
2209         none = ++max;
2210         if (del)
2211             del = ++max;
2212
2213         if (max > 0xffff)
2214             bits = 32;
2215         else if (max > 0xff)
2216             bits = 16;
2217         else
2218             bits = 8;
2219
2220         cSVOPo->op_sv = (SV*)swash_init("utf8", "", listsv, bits, none);
2221         SvREFCNT_dec(listsv);
2222         if (transv)
2223             SvREFCNT_dec(transv);
2224
2225         if (!del && havefinal)
2226             (void)hv_store((HV*)SvRV((cSVOPo->op_sv)), "FINAL", 5, newSViv((IV)final), 0);
2227
2228         if (grows && to_utf)
2229             o->op_private |= OPpTRANS_GROWS;
2230
2231         op_free(expr);
2232         op_free(repl);
2233         return o;
2234     }
2235
2236     tbl = (short*)cPVOPo->op_pv;
2237     if (complement) {
2238         Zero(tbl, 256, short);
2239         for (i = 0; i < tlen; i++)
2240             tbl[t[i]] = -1;
2241         for (i = 0, j = 0; i < 256; i++) {
2242             if (!tbl[i]) {
2243                 if (j >= rlen) {
2244                     if (del)
2245                         tbl[i] = -2;
2246                     else if (rlen)
2247                         tbl[i] = r[j-1];
2248                     else
2249                         tbl[i] = i;
2250                 }
2251                 else
2252                     tbl[i] = r[j++];
2253             }
2254         }
2255     }
2256     else {
2257         if (!rlen && !del) {
2258             r = t; rlen = tlen;
2259             if (!squash)
2260                 o->op_private |= OPpTRANS_COUNTONLY;
2261         }
2262         for (i = 0; i < 256; i++)
2263             tbl[i] = -1;
2264         for (i = 0, j = 0; i < tlen; i++,j++) {
2265             if (j >= rlen) {
2266                 if (del) {
2267                     if (tbl[t[i]] == -1)
2268                         tbl[t[i]] = -2;
2269                     continue;
2270                 }
2271                 --j;
2272             }
2273             if (tbl[t[i]] == -1)
2274                 tbl[t[i]] = r[j];
2275         }
2276     }
2277     op_free(expr);
2278     op_free(repl);
2279
2280     return o;
2281 }
2282
2283 OP *
2284 newPMOP(I32 type, I32 flags)
2285 {
2286     dTHR;
2287     PMOP *pmop;
2288
2289     Newz(1101, pmop, 1, PMOP);
2290     pmop->op_type = type;
2291     pmop->op_ppaddr = ppaddr[type];
2292     pmop->op_flags = flags;
2293     pmop->op_private = 0 | (flags >> 8);
2294
2295     if (PL_hints & HINT_RE_TAINT)
2296         pmop->op_pmpermflags |= PMf_RETAINT;
2297     if (PL_hints & HINT_LOCALE)
2298         pmop->op_pmpermflags |= PMf_LOCALE;
2299     pmop->op_pmflags = pmop->op_pmpermflags;
2300
2301     /* link into pm list */
2302     if (type != OP_TRANS && PL_curstash) {
2303         pmop->op_pmnext = HvPMROOT(PL_curstash);
2304         HvPMROOT(PL_curstash) = pmop;
2305     }
2306
2307     return (OP*)pmop;
2308 }
2309
2310 OP *
2311 pmruntime(OP *o, OP *expr, OP *repl)
2312 {
2313     dTHR;
2314     PMOP *pm;
2315     LOGOP *rcop;
2316     I32 repl_has_vars = 0;
2317
2318     if (o->op_type == OP_TRANS)
2319         return pmtrans(o, expr, repl);
2320
2321     PL_hints |= HINT_BLOCK_SCOPE;
2322     pm = (PMOP*)o;
2323
2324     if (expr->op_type == OP_CONST) {
2325         STRLEN plen;
2326         SV *pat = ((SVOP*)expr)->op_sv;
2327         char *p = SvPV(pat, plen);
2328         if ((o->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
2329             sv_setpvn(pat, "\\s+", 3);
2330             p = SvPV(pat, plen);
2331             pm->op_pmflags |= PMf_SKIPWHITE;
2332         }
2333         pm->op_pmregexp = CALLREGCOMP(p, p + plen, pm);
2334         if (strEQ("\\s+", pm->op_pmregexp->precomp))
2335             pm->op_pmflags |= PMf_WHITE;
2336         op_free(expr);
2337     }
2338     else {
2339         if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL))
2340             expr = newUNOP((!(PL_hints & HINT_RE_EVAL)
2341                             ? OP_REGCRESET
2342                             : OP_REGCMAYBE),0,expr);
2343
2344         Newz(1101, rcop, 1, LOGOP);
2345         rcop->op_type = OP_REGCOMP;
2346         rcop->op_ppaddr = ppaddr[OP_REGCOMP];
2347         rcop->op_first = scalar(expr);
2348         rcop->op_flags |= ((PL_hints & HINT_RE_EVAL)
2349                            ? (OPf_SPECIAL | OPf_KIDS)
2350                            : OPf_KIDS);
2351         rcop->op_private = 1;
2352         rcop->op_other = o;
2353
2354         /* establish postfix order */
2355         if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL)) {
2356             LINKLIST(expr);
2357             rcop->op_next = expr;
2358             ((UNOP*)expr)->op_first->op_next = (OP*)rcop;
2359         }
2360         else {
2361             rcop->op_next = LINKLIST(expr);
2362             expr->op_next = (OP*)rcop;
2363         }
2364
2365         prepend_elem(o->op_type, scalar((OP*)rcop), o);
2366     }
2367
2368     if (repl) {
2369         OP *curop;
2370         if (pm->op_pmflags & PMf_EVAL)
2371             curop = 0;
2372 #ifdef USE_THREADS
2373         else if (repl->op_type == OP_THREADSV
2374                  && strchr("&`'123456789+",
2375                            PL_threadsv_names[repl->op_targ]))
2376         {
2377             curop = 0;
2378         }
2379 #endif /* USE_THREADS */
2380         else if (repl->op_type == OP_CONST)
2381             curop = repl;
2382         else {
2383             OP *lastop = 0;
2384             for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
2385                 if (opargs[curop->op_type] & OA_DANGEROUS) {
2386 #ifdef USE_THREADS
2387                     if (curop->op_type == OP_THREADSV) {
2388                         repl_has_vars = 1;
2389                         if (strchr("&`'123456789+", curop->op_private))
2390                             break;
2391                     }
2392 #else
2393                     if (curop->op_type == OP_GV) {
2394                         GV *gv = ((GVOP*)curop)->op_gv;
2395                         repl_has_vars = 1;
2396                         if (strchr("&`'123456789+", *GvENAME(gv)))
2397                             break;
2398                     }
2399 #endif /* USE_THREADS */
2400                     else if (curop->op_type == OP_RV2CV)
2401                         break;
2402                     else if (curop->op_type == OP_RV2SV ||
2403                              curop->op_type == OP_RV2AV ||
2404                              curop->op_type == OP_RV2HV ||
2405                              curop->op_type == OP_RV2GV) {
2406                         if (lastop && lastop->op_type != OP_GV) /*funny deref?*/
2407                             break;
2408                     }
2409                     else if (curop->op_type == OP_PADSV ||
2410                              curop->op_type == OP_PADAV ||
2411                              curop->op_type == OP_PADHV ||
2412                              curop->op_type == OP_PADANY) {
2413                         repl_has_vars = 1;
2414                     }
2415                     else if (curop->op_type == OP_PUSHRE)
2416                         ; /* Okay here, dangerous in newASSIGNOP */
2417                     else
2418                         break;
2419                 }
2420                 lastop = curop;
2421             }
2422         }
2423         if (curop == repl
2424             && !(repl_has_vars
2425                  && (!pm->op_pmregexp
2426                      || pm->op_pmregexp->reganch & ROPT_EVAL_SEEN))) {
2427             pm->op_pmflags |= PMf_CONST;        /* const for long enough */
2428             pm->op_pmpermflags |= PMf_CONST;    /* const for long enough */
2429             prepend_elem(o->op_type, scalar(repl), o);
2430         }
2431         else {
2432             if (curop == repl && !pm->op_pmregexp) { /* Has variables. */
2433                 pm->op_pmflags |= PMf_MAYBE_CONST;
2434                 pm->op_pmpermflags |= PMf_MAYBE_CONST;
2435             }
2436             Newz(1101, rcop, 1, LOGOP);
2437             rcop->op_type = OP_SUBSTCONT;
2438             rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
2439             rcop->op_first = scalar(repl);
2440             rcop->op_flags |= OPf_KIDS;
2441             rcop->op_private = 1;
2442             rcop->op_other = o;
2443
2444             /* establish postfix order */
2445             rcop->op_next = LINKLIST(repl);
2446             repl->op_next = (OP*)rcop;
2447
2448             pm->op_pmreplroot = scalar((OP*)rcop);
2449             pm->op_pmreplstart = LINKLIST(rcop);
2450             rcop->op_next = 0;
2451         }
2452     }
2453
2454     return (OP*)pm;
2455 }
2456
2457 OP *
2458 newSVOP(I32 type, I32 flags, SV *sv)
2459 {
2460     SVOP *svop;
2461     Newz(1101, svop, 1, SVOP);
2462     svop->op_type = type;
2463     svop->op_ppaddr = ppaddr[type];
2464     svop->op_sv = sv;
2465     svop->op_next = (OP*)svop;
2466     svop->op_flags = flags;
2467     if (opargs[type] & OA_RETSCALAR)
2468         scalar((OP*)svop);
2469     if (opargs[type] & OA_TARGET)
2470         svop->op_targ = pad_alloc(type, SVs_PADTMP);
2471     return CHECKOP(type, svop);
2472 }
2473
2474 OP *
2475 newGVOP(I32 type, I32 flags, GV *gv)
2476 {
2477     dTHR;
2478     GVOP *gvop;
2479     Newz(1101, gvop, 1, GVOP);
2480     gvop->op_type = type;
2481     gvop->op_ppaddr = ppaddr[type];
2482     gvop->op_gv = (GV*)SvREFCNT_inc(gv);
2483     gvop->op_next = (OP*)gvop;
2484     gvop->op_flags = flags;
2485     if (opargs[type] & OA_RETSCALAR)
2486         scalar((OP*)gvop);
2487     if (opargs[type] & OA_TARGET)
2488         gvop->op_targ = pad_alloc(type, SVs_PADTMP);
2489     return CHECKOP(type, gvop);
2490 }
2491
2492 OP *
2493 newPVOP(I32 type, I32 flags, char *pv)
2494 {
2495     PVOP *pvop;
2496     Newz(1101, pvop, 1, PVOP);
2497     pvop->op_type = type;
2498     pvop->op_ppaddr = ppaddr[type];
2499     pvop->op_pv = pv;
2500     pvop->op_next = (OP*)pvop;
2501     pvop->op_flags = flags;
2502     if (opargs[type] & OA_RETSCALAR)
2503         scalar((OP*)pvop);
2504     if (opargs[type] & OA_TARGET)
2505         pvop->op_targ = pad_alloc(type, SVs_PADTMP);
2506     return CHECKOP(type, pvop);
2507 }
2508
2509 void
2510 package(OP *o)
2511 {
2512     dTHR;
2513     SV *sv;
2514
2515     save_hptr(&PL_curstash);
2516     save_item(PL_curstname);
2517     if (o) {
2518         STRLEN len;
2519         char *name;
2520         sv = cSVOPo->op_sv;
2521         name = SvPV(sv, len);
2522         PL_curstash = gv_stashpvn(name,len,TRUE);
2523         sv_setpvn(PL_curstname, name, len);
2524         op_free(o);
2525     }
2526     else {
2527         sv_setpv(PL_curstname,"<none>");
2528         PL_curstash = Nullhv;
2529     }
2530     PL_copline = NOLINE;
2531     PL_expect = XSTATE;
2532 }
2533
2534 void
2535 utilize(int aver, I32 floor, OP *version, OP *id, OP *arg)
2536 {
2537     OP *pack;
2538     OP *meth;
2539     OP *rqop;
2540     OP *imop;
2541     OP *veop;
2542
2543     if (id->op_type != OP_CONST)
2544         croak("Module name must be constant");
2545
2546     veop = Nullop;
2547
2548     if(version != Nullop) {
2549         SV *vesv = ((SVOP*)version)->op_sv;
2550
2551         if (arg == Nullop && !SvNIOK(vesv)) {
2552             arg = version;
2553         }
2554         else {
2555             OP *pack;
2556             OP *meth;
2557
2558             if (version->op_type != OP_CONST || !SvNIOK(vesv))
2559                 croak("Version number must be constant number");
2560
2561             /* Make copy of id so we don't free it twice */
2562             pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
2563
2564             /* Fake up a method call to VERSION */
2565             meth = newSVOP(OP_CONST, 0, newSVpv("VERSION", 7));
2566             veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
2567                             append_elem(OP_LIST,
2568                             prepend_elem(OP_LIST, pack, list(version)),
2569                             newUNOP(OP_METHOD, 0, meth)));
2570         }
2571     }
2572
2573     /* Fake up an import/unimport */
2574     if (arg && arg->op_type == OP_STUB)
2575         imop = arg;             /* no import on explicit () */
2576     else if(SvNIOK(((SVOP*)id)->op_sv)) {
2577         imop = Nullop;          /* use 5.0; */
2578     }
2579     else {
2580         /* Make copy of id so we don't free it twice */
2581         pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
2582         meth = newSVOP(OP_CONST, 0,
2583             aver
2584                 ? newSVpv("import", 6)
2585                 : newSVpv("unimport", 8)
2586             );
2587         imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
2588                     append_elem(OP_LIST,
2589                         prepend_elem(OP_LIST, pack, list(arg)),
2590                         newUNOP(OP_METHOD, 0, meth)));
2591     }
2592
2593     /* Fake up a require */
2594     rqop = newUNOP(OP_REQUIRE, 0, id);
2595
2596     /* Fake up the BEGIN {}, which does its thing immediately. */
2597     newSUB(floor,
2598         newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)),
2599         Nullop,
2600         append_elem(OP_LINESEQ,
2601             append_elem(OP_LINESEQ,
2602                 newSTATEOP(0, Nullch, rqop),
2603                 newSTATEOP(0, Nullch, veop)),
2604             newSTATEOP(0, Nullch, imop) ));
2605
2606     PL_copline = NOLINE;
2607     PL_expect = XSTATE;
2608 }
2609
2610 OP *
2611 newSLICEOP(I32 flags, OP *subscript, OP *listval)
2612 {
2613     return newBINOP(OP_LSLICE, flags,
2614             list(force_list(subscript)),
2615             list(force_list(listval)) );
2616 }
2617
2618 STATIC I32
2619 list_assignment(register OP *o)
2620 {
2621     if (!o)
2622         return TRUE;
2623
2624     if (o->op_type == OP_NULL && o->op_flags & OPf_KIDS)
2625         o = cUNOPo->op_first;
2626
2627     if (o->op_type == OP_COND_EXPR) {
2628         I32 t = list_assignment(cCONDOPo->op_first->op_sibling);
2629         I32 f = list_assignment(cCONDOPo->op_first->op_sibling->op_sibling);
2630
2631         if (t && f)
2632             return TRUE;
2633         if (t || f)
2634             yyerror("Assignment to both a list and a scalar");
2635         return FALSE;
2636     }
2637
2638     if (o->op_type == OP_LIST || o->op_flags & OPf_PARENS ||
2639         o->op_type == OP_RV2AV || o->op_type == OP_RV2HV ||
2640         o->op_type == OP_ASLICE || o->op_type == OP_HSLICE)
2641         return TRUE;
2642
2643     if (o->op_type == OP_PADAV || o->op_type == OP_PADHV)
2644         return TRUE;
2645
2646     if (o->op_type == OP_RV2SV)
2647         return FALSE;
2648
2649     return FALSE;
2650 }
2651
2652 OP *
2653 newASSIGNOP(I32 flags, OP *left, I32 optype, OP *right)
2654 {
2655     OP *o;
2656
2657     if (optype) {
2658         if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) {
2659             return newLOGOP(optype, 0,
2660                 mod(scalar(left), optype),
2661                 newUNOP(OP_SASSIGN, 0, scalar(right)));
2662         }
2663         else {
2664             return newBINOP(optype, OPf_STACKED,
2665                 mod(scalar(left), optype), scalar(right));
2666         }
2667     }
2668
2669     if (list_assignment(left)) {
2670         dTHR;
2671         PL_modcount = 0;
2672         PL_eval_start = right;  /* Grandfathering $[ assignment here.  Bletch.*/
2673         left = mod(left, OP_AASSIGN);
2674         if (PL_eval_start)
2675             PL_eval_start = 0;
2676         else {
2677             op_free(left);
2678             op_free(right);
2679             return Nullop;
2680         }
2681         o = newBINOP(OP_AASSIGN, flags,
2682                 list(force_list(right)),
2683                 list(force_list(left)) );
2684         o->op_private = 0 | (flags >> 8);
2685         if (!(left->op_private & OPpLVAL_INTRO)) {
2686             OP *curop;
2687             OP *lastop = o;
2688             PL_generation++;
2689             for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
2690                 if (opargs[curop->op_type] & OA_DANGEROUS) {
2691                     if (curop->op_type == OP_GV) {
2692                         GV *gv = ((GVOP*)curop)->op_gv;
2693                         if (gv == PL_defgv || SvCUR(gv) == PL_generation)
2694                             break;
2695                         SvCUR(gv) = PL_generation;
2696                     }
2697                     else if (curop->op_type == OP_PADSV ||
2698                              curop->op_type == OP_PADAV ||
2699                              curop->op_type == OP_PADHV ||
2700                              curop->op_type == OP_PADANY) {
2701                         SV **svp = AvARRAY(PL_comppad_name);
2702                         SV *sv = svp[curop->op_targ];
2703                         if (SvCUR(sv) == PL_generation)
2704                             break;
2705                         SvCUR(sv) = PL_generation;      /* (SvCUR not used any more) */
2706                     }
2707                     else if (curop->op_type == OP_RV2CV)
2708                         break;
2709                     else if (curop->op_type == OP_RV2SV ||
2710                              curop->op_type == OP_RV2AV ||
2711                              curop->op_type == OP_RV2HV ||
2712                              curop->op_type == OP_RV2GV) {
2713                         if (lastop->op_type != OP_GV)   /* funny deref? */
2714                             break;
2715                     }
2716                     else if (curop->op_type == OP_PUSHRE) {
2717                         if (((PMOP*)curop)->op_pmreplroot) {
2718                             GV *gv = (GV*)((PMOP*)curop)->op_pmreplroot;
2719                             if (gv == PL_defgv || SvCUR(gv) == PL_generation)
2720                                 break;
2721                             SvCUR(gv) = PL_generation;
2722                         }
2723                     }
2724                     else
2725                         break;
2726                 }
2727                 lastop = curop;
2728             }
2729             if (curop != o)
2730                 o->op_private = OPpASSIGN_COMMON;
2731         }
2732         if (right && right->op_type == OP_SPLIT) {
2733             OP* tmpop;
2734             if ((tmpop = ((LISTOP*)right)->op_first) &&
2735                 tmpop->op_type == OP_PUSHRE)
2736             {
2737                 PMOP *pm = (PMOP*)tmpop;
2738                 if (left->op_type == OP_RV2AV &&
2739                     !(left->op_private & OPpLVAL_INTRO) &&
2740                     !(o->op_private & OPpASSIGN_COMMON) )
2741                 {
2742                     tmpop = ((UNOP*)left)->op_first;
2743                     if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
2744                         pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv;
2745                         pm->op_pmflags |= PMf_ONCE;
2746                         tmpop = cUNOPo->op_first;       /* to list (nulled) */
2747                         tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
2748                         tmpop->op_sibling = Nullop;     /* don't free split */
2749                         right->op_next = tmpop->op_next;  /* fix starting loc */
2750                         op_free(o);                     /* blow off assign */
2751                         right->op_flags &= ~OPf_WANT;
2752                                 /* "I don't know and I don't care." */
2753                         return right;
2754                     }
2755                 }
2756                 else {
2757                     if (PL_modcount < 10000 &&
2758                       ((LISTOP*)right)->op_last->op_type == OP_CONST)
2759                     {
2760                         SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
2761                         if (SvIVX(sv) == 0)
2762                             sv_setiv(sv, PL_modcount+1);
2763                     }
2764                 }
2765             }
2766         }
2767         return o;
2768     }
2769     if (!right)
2770         right = newOP(OP_UNDEF, 0);
2771     if (right->op_type == OP_READLINE) {
2772         right->op_flags |= OPf_STACKED;
2773         return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right));
2774     }
2775     else {
2776         PL_eval_start = right;  /* Grandfathering $[ assignment here.  Bletch.*/
2777         o = newBINOP(OP_SASSIGN, flags,
2778             scalar(right), mod(scalar(left), OP_SASSIGN) );
2779         if (PL_eval_start)
2780             PL_eval_start = 0;
2781         else {
2782             op_free(o);
2783             return Nullop;
2784         }
2785     }
2786     return o;
2787 }
2788
2789 OP *
2790 newSTATEOP(I32 flags, char *label, OP *o)
2791 {
2792     dTHR;
2793     U32 seq = intro_my();
2794     register COP *cop;
2795
2796     Newz(1101, cop, 1, COP);
2797     if (PERLDB_LINE && PL_curcop->cop_line && PL_curstash != PL_debstash) {
2798         cop->op_type = OP_DBSTATE;
2799         cop->op_ppaddr = ppaddr[ OP_DBSTATE ];
2800     }
2801     else {
2802         cop->op_type = OP_NEXTSTATE;
2803         cop->op_ppaddr = ppaddr[ OP_NEXTSTATE ];
2804     }
2805     cop->op_flags = flags;
2806     cop->op_private = (PL_hints & HINT_UTF8);
2807 #ifdef NATIVE_HINTS
2808     cop->op_private |= NATIVE_HINTS;
2809 #endif
2810     compiling.op_private = cop->op_private;
2811     cop->op_next = (OP*)cop;
2812
2813     if (label) {
2814         cop->cop_label = label;
2815         PL_hints |= HINT_BLOCK_SCOPE;
2816     }
2817     cop->cop_seq = seq;
2818     cop->cop_arybase = PL_curcop->cop_arybase;
2819
2820     if (PL_copline == NOLINE)
2821         cop->cop_line = PL_curcop->cop_line;
2822     else {
2823         cop->cop_line = PL_copline;
2824         PL_copline = NOLINE;
2825     }
2826     cop->cop_filegv = (GV*)SvREFCNT_inc(PL_curcop->cop_filegv);
2827     cop->cop_stash = PL_curstash;
2828
2829     if (PERLDB_LINE && PL_curstash != PL_debstash) {
2830         SV **svp = av_fetch(GvAV(PL_curcop->cop_filegv),(I32)cop->cop_line, FALSE);
2831         if (svp && *svp != &PL_sv_undef && !SvIOK(*svp)) {
2832             (void)SvIOK_on(*svp);
2833             SvIVX(*svp) = 1;
2834             SvSTASH(*svp) = (HV*)cop;
2835         }
2836     }
2837
2838     return prepend_elem(OP_LINESEQ, (OP*)cop, o);
2839 }
2840
2841 /* "Introduce" my variables to visible status. */
2842 U32
2843 intro_my(void)
2844 {
2845     SV **svp;
2846     SV *sv;
2847     I32 i;
2848
2849     if (! PL_min_intro_pending)
2850         return PL_cop_seqmax;
2851
2852     svp = AvARRAY(PL_comppad_name);
2853     for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
2854         if ((sv = svp[i]) && sv != &PL_sv_undef && !SvIVX(sv)) {
2855             SvIVX(sv) = 999999999;      /* Don't know scope end yet. */
2856             SvNVX(sv) = (double)PL_cop_seqmax;
2857         }
2858     }
2859     PL_min_intro_pending = 0;
2860     PL_comppad_name_fill = PL_max_intro_pending;        /* Needn't search higher */
2861     return PL_cop_seqmax++;
2862 }
2863
2864 OP *
2865 newLOGOP(I32 type, I32 flags, OP *first, OP *other)
2866 {
2867     return new_logop(type, flags, &first, &other);
2868 }
2869
2870 STATIC OP *
2871 new_logop(I32 type, I32 flags, OP** firstp, OP** otherp)
2872 {
2873     dTHR;
2874     LOGOP *logop;
2875     OP *o;
2876     OP *first = *firstp;
2877     OP *other = *otherp;
2878
2879     if (type == OP_XOR)         /* Not short circuit, but here by precedence. */
2880         return newBINOP(type, flags, scalar(first), scalar(other));
2881
2882     scalarboolean(first);
2883     /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
2884     if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) {
2885         if (type == OP_AND || type == OP_OR) {
2886             if (type == OP_AND)
2887                 type = OP_OR;
2888             else
2889                 type = OP_AND;
2890             o = first;
2891             first = *firstp = cUNOPo->op_first;
2892             if (o->op_next)
2893                 first->op_next = o->op_next;
2894             cUNOPo->op_first = Nullop;
2895             op_free(o);
2896         }
2897     }
2898     if (first->op_type == OP_CONST) {
2899         if (PL_dowarn && (first->op_private & OPpCONST_BARE))
2900             warn("Probable precedence problem on %s", op_desc[type]);
2901         if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
2902             op_free(first);
2903             *firstp = Nullop;
2904             return other;
2905         }
2906         else {
2907             op_free(other);
2908             *otherp = Nullop;
2909             return first;
2910         }
2911     }
2912     else if (first->op_type == OP_WANTARRAY) {
2913         if (type == OP_AND)
2914             list(other);
2915         else
2916             scalar(other);
2917     }
2918     else if (PL_dowarn && (first->op_flags & OPf_KIDS)) {
2919         OP *k1 = ((UNOP*)first)->op_first;
2920         OP *k2 = k1->op_sibling;
2921         OPCODE warnop = 0;
2922         switch (first->op_type)
2923         {
2924         case OP_NULL:
2925             if (k2 && k2->op_type == OP_READLINE
2926                   && (k2->op_flags & OPf_STACKED)
2927                   && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
2928                 warnop = k2->op_type;
2929             break;
2930
2931         case OP_SASSIGN:
2932             if (k1->op_type == OP_READDIR
2933                   || k1->op_type == OP_GLOB
2934                   || k1->op_type == OP_EACH)
2935                 warnop = k1->op_type;
2936             break;
2937         }
2938         if (warnop) {
2939             line_t oldline = PL_curcop->cop_line;
2940             PL_curcop->cop_line = PL_copline;
2941             warn("Value of %s%s can be \"0\"; test with defined()",
2942                  op_desc[warnop],
2943                  ((warnop == OP_READLINE || warnop == OP_GLOB)
2944                   ? " construct" : "() operator"));
2945             PL_curcop->cop_line = oldline;
2946         }
2947     }
2948
2949     if (!other)
2950         return first;
2951
2952     if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
2953         other->op_private |= OPpASSIGN_BACKWARDS;  /* other is an OP_SASSIGN */
2954
2955     Newz(1101, logop, 1, LOGOP);
2956
2957     logop->op_type = type;
2958     logop->op_ppaddr = ppaddr[type];
2959     logop->op_first = first;
2960     logop->op_flags = flags | OPf_KIDS;
2961     logop->op_other = LINKLIST(other);
2962     logop->op_private = 1 | (flags >> 8);
2963
2964     /* establish postfix order */
2965     logop->op_next = LINKLIST(first);
2966     first->op_next = (OP*)logop;
2967     first->op_sibling = other;
2968
2969     o = newUNOP(OP_NULL, 0, (OP*)logop);
2970     other->op_next = o;
2971
2972     return o;
2973 }
2974
2975 OP *
2976 newCONDOP(I32 flags, OP *first, OP *trueop, OP *falseop)
2977 {
2978     dTHR;
2979     CONDOP *condop;
2980     OP *o;
2981
2982     if (!falseop)
2983         return newLOGOP(OP_AND, 0, first, trueop);
2984     if (!trueop)
2985         return newLOGOP(OP_OR, 0, first, falseop);
2986
2987     scalarboolean(first);
2988     if (first->op_type == OP_CONST) {
2989         if (SvTRUE(((SVOP*)first)->op_sv)) {
2990             op_free(first);
2991             op_free(falseop);
2992             return trueop;
2993         }
2994         else {
2995             op_free(first);
2996             op_free(trueop);
2997             return falseop;
2998         }
2999     }
3000     else if (first->op_type == OP_WANTARRAY) {
3001         list(trueop);
3002         scalar(falseop);
3003     }
3004     Newz(1101, condop, 1, CONDOP);
3005
3006     condop->op_type = OP_COND_EXPR;
3007     condop->op_ppaddr = ppaddr[OP_COND_EXPR];
3008     condop->op_first = first;
3009     condop->op_flags = flags | OPf_KIDS;
3010     condop->op_true = LINKLIST(trueop);
3011     condop->op_false = LINKLIST(falseop);
3012     condop->op_private = 1 | (flags >> 8);
3013
3014     /* establish postfix order */
3015     condop->op_next = LINKLIST(first);
3016     first->op_next = (OP*)condop;
3017
3018     first->op_sibling = trueop;
3019     trueop->op_sibling = falseop;
3020     o = newUNOP(OP_NULL, 0, (OP*)condop);
3021
3022     trueop->op_next = o;
3023     falseop->op_next = o;
3024
3025     return o;
3026 }
3027
3028 OP *
3029 newRANGE(I32 flags, OP *left, OP *right)
3030 {
3031     dTHR;
3032     CONDOP *condop;
3033     OP *flip;
3034     OP *flop;
3035     OP *o;
3036
3037     Newz(1101, condop, 1, CONDOP);
3038
3039     condop->op_type = OP_RANGE;
3040     condop->op_ppaddr = ppaddr[OP_RANGE];
3041     condop->op_first = left;
3042     condop->op_flags = OPf_KIDS;
3043     condop->op_true = LINKLIST(left);
3044     condop->op_false = LINKLIST(right);
3045     condop->op_private = 1 | (flags >> 8);
3046
3047     left->op_sibling = right;
3048
3049     condop->op_next = (OP*)condop;
3050     flip = newUNOP(OP_FLIP, flags, (OP*)condop);
3051     flop = newUNOP(OP_FLOP, 0, flip);
3052     o = newUNOP(OP_NULL, 0, flop);
3053     linklist(flop);
3054
3055     left->op_next = flip;
3056     right->op_next = flop;
3057
3058     condop->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
3059     sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV);
3060     flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
3061     sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
3062
3063     flip->op_private =  left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
3064     flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
3065
3066     flip->op_next = o;
3067     if (!flip->op_private || !flop->op_private)
3068         linklist(o);            /* blow off optimizer unless constant */
3069
3070     return o;
3071 }
3072
3073 OP *
3074 newLOOPOP(I32 flags, I32 debuggable, OP *expr, OP *block)
3075 {
3076     dTHR;
3077     OP* listop;
3078     OP* o;
3079     int once = block && block->op_flags & OPf_SPECIAL &&
3080       (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
3081
3082     if (expr) {
3083         if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
3084             return block;       /* do {} while 0 does once */
3085         if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
3086             || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) {
3087             expr = newUNOP(OP_DEFINED, 0,
3088                 newASSIGNOP(0, newDEFSVOP(), 0, expr) );
3089         } else if (expr->op_flags & OPf_KIDS) {
3090             OP *k1 = ((UNOP*)expr)->op_first;
3091             OP *k2 = (k1) ? k1->op_sibling : NULL;
3092             switch (expr->op_type) {
3093               case OP_NULL:
3094                 if (k2 && k2->op_type == OP_READLINE
3095                       && (k2->op_flags & OPf_STACKED)
3096                       && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
3097                     expr = newUNOP(OP_DEFINED, 0, expr);
3098                 break;
3099
3100               case OP_SASSIGN:
3101                 if (k1->op_type == OP_READDIR
3102                       || k1->op_type == OP_GLOB
3103                       || k1->op_type == OP_EACH)
3104                     expr = newUNOP(OP_DEFINED, 0, expr);
3105                 break;
3106             }
3107         }
3108     }
3109
3110     listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
3111     o = new_logop(OP_AND, 0, &expr, &listop);
3112
3113     if (listop)
3114         ((LISTOP*)listop)->op_last->op_next = LINKLIST(o);
3115
3116     if (once && o != listop)
3117         o->op_next = ((LOGOP*)cUNOPo->op_first)->op_other;
3118
3119     if (o == listop)
3120         o = newUNOP(OP_NULL, 0, o);     /* or do {} while 1 loses outer block */
3121
3122     o->op_flags |= flags;
3123     o = scope(o);
3124     o->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/
3125     return o;
3126 }
3127
3128 OP *
3129 newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *block, OP *cont)
3130 {
3131     dTHR;
3132     OP *redo;
3133     OP *next = 0;
3134     OP *listop;
3135     OP *o;
3136     OP *condop;
3137
3138     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB
3139                  || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) {
3140         expr = newUNOP(OP_DEFINED, 0,
3141             newASSIGNOP(0, newDEFSVOP(), 0, expr) );
3142     } else if (expr && (expr->op_flags & OPf_KIDS)) {
3143         OP *k1 = ((UNOP*)expr)->op_first;
3144         OP *k2 = (k1) ? k1->op_sibling : NULL;
3145         switch (expr->op_type) {
3146           case OP_NULL:
3147             if (k2 && k2->op_type == OP_READLINE
3148                   && (k2->op_flags & OPf_STACKED)
3149                   && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
3150                 expr = newUNOP(OP_DEFINED, 0, expr);
3151             break;
3152
3153           case OP_SASSIGN:
3154             if (k1->op_type == OP_READDIR
3155                   || k1->op_type == OP_GLOB
3156                   || k1->op_type == OP_EACH)
3157                 expr = newUNOP(OP_DEFINED, 0, expr);
3158             break;
3159         }
3160     }
3161
3162     if (!block)
3163         block = newOP(OP_NULL, 0);
3164
3165     if (cont)
3166         next = LINKLIST(cont);
3167     if (expr) {
3168         cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
3169         if ((line_t)whileline != NOLINE) {
3170             PL_copline = whileline;
3171             cont = append_elem(OP_LINESEQ, cont,
3172                                newSTATEOP(0, Nullch, Nullop));
3173         }
3174     }
3175
3176     listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
3177     redo = LINKLIST(listop);
3178
3179     if (expr) {
3180         PL_copline = whileline;
3181         scalar(listop);
3182         o = new_logop(OP_AND, 0, &expr, &listop);
3183         if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) {
3184             op_free(expr);              /* oops, it's a while (0) */
3185             op_free((OP*)loop);
3186             return Nullop;              /* listop already freed by new_logop */
3187         }
3188         if (listop)
3189             ((LISTOP*)listop)->op_last->op_next = condop =
3190                 (o == listop ? redo : LINKLIST(o));
3191         if (!next)
3192             next = condop;
3193     }
3194     else
3195         o = listop;
3196
3197     if (!loop) {
3198         Newz(1101,loop,1,LOOP);
3199         loop->op_type = OP_ENTERLOOP;
3200         loop->op_ppaddr = ppaddr[OP_ENTERLOOP];
3201         loop->op_private = 0;
3202         loop->op_next = (OP*)loop;
3203     }
3204
3205     o = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, o);
3206
3207     loop->op_redoop = redo;
3208     loop->op_lastop = o;
3209
3210     if (next)
3211         loop->op_nextop = next;
3212     else
3213         loop->op_nextop = o;
3214
3215     o->op_flags |= flags;
3216     o->op_private |= (flags >> 8);
3217     return o;
3218 }
3219
3220 OP *
3221 newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
3222 {
3223     LOOP *loop;
3224     OP *wop;
3225     int padoff = 0;
3226     I32 iterflags = 0;
3227
3228     if (sv) {
3229         if (sv->op_type == OP_RV2SV) {  /* symbol table variable */
3230             sv->op_type = OP_RV2GV;
3231             sv->op_ppaddr = ppaddr[OP_RV2GV];
3232         }
3233         else if (sv->op_type == OP_PADSV) { /* private variable */
3234             padoff = sv->op_targ;
3235             op_free(sv);
3236             sv = Nullop;
3237         }
3238         else if (sv->op_type == OP_THREADSV) { /* per-thread variable */
3239             padoff = sv->op_targ;
3240             iterflags |= OPf_SPECIAL;
3241             op_free(sv);
3242             sv = Nullop;
3243         }
3244         else
3245             croak("Can't use %s for loop variable", op_desc[sv->op_type]);
3246     }
3247     else {
3248 #ifdef USE_THREADS
3249         padoff = find_threadsv("_");
3250         iterflags |= OPf_SPECIAL;
3251 #else
3252         sv = newGVOP(OP_GV, 0, PL_defgv);
3253 #endif
3254     }
3255     if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
3256         expr = mod(force_list(scalar(ref(expr, OP_ITER))), OP_GREPSTART);
3257         iterflags |= OPf_STACKED;
3258     }
3259     else if (expr->op_type == OP_NULL &&
3260              (expr->op_flags & OPf_KIDS) &&
3261              ((BINOP*)expr)->op_first->op_type == OP_FLOP)
3262     {
3263         /* Basically turn for($x..$y) into the same as for($x,$y), but we
3264          * set the STACKED flag to indicate that these values are to be
3265          * treated as min/max values by 'pp_iterinit'.
3266          */
3267         UNOP* flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first;
3268         CONDOP* range = (CONDOP*) flip->op_first;
3269         OP* left  = range->op_first;
3270         OP* right = left->op_sibling;
3271         LISTOP* listop;
3272
3273         range->op_flags &= ~OPf_KIDS;
3274         range->op_first = Nullop;
3275
3276         listop = (LISTOP*)newLISTOP(OP_LIST, 0, left, right);
3277         listop->op_first->op_next = range->op_true;
3278         left->op_next = range->op_false;
3279         right->op_next = (OP*)listop;
3280         listop->op_next = listop->op_first;
3281
3282         op_free(expr);
3283         expr = (OP*)(listop);
3284         null(expr);
3285         iterflags |= OPf_STACKED;
3286     }
3287     else {
3288         expr = mod(force_list(expr), OP_GREPSTART);
3289     }
3290
3291
3292     loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
3293                                append_elem(OP_LIST, expr, scalar(sv))));
3294     assert(!loop->op_next);
3295     Renew(loop, 1, LOOP);
3296     loop->op_targ = padoff;
3297     wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont);
3298     PL_copline = forline;
3299     return newSTATEOP(0, label, wop);
3300 }
3301
3302 OP*
3303 newLOOPEX(I32 type, OP *label)
3304 {
3305     dTHR;
3306     OP *o;
3307     if (type != OP_GOTO || label->op_type == OP_CONST) {
3308         /* "last()" means "last" */
3309         if (label->op_type == OP_STUB && (label->op_flags & OPf_PARENS))
3310             o = newOP(type, OPf_SPECIAL);
3311         else {
3312             o = newPVOP(type, 0, savepv(label->op_type == OP_CONST
3313                                         ? SvPVx(((SVOP*)label)->op_sv, PL_na)
3314                                         : ""));
3315         }
3316         op_free(label);
3317     }
3318     else {
3319         if (label->op_type == OP_ENTERSUB)
3320             label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
3321         o = newUNOP(type, OPf_STACKED, label);
3322     }
3323     PL_hints |= HINT_BLOCK_SCOPE;
3324     return o;
3325 }
3326
3327 void
3328 cv_undef(CV *cv)
3329 {
3330     dTHR;
3331 #ifdef USE_THREADS
3332     if (CvMUTEXP(cv)) {
3333         MUTEX_DESTROY(CvMUTEXP(cv));
3334         Safefree(CvMUTEXP(cv));
3335         CvMUTEXP(cv) = 0;
3336     }
3337 #endif /* USE_THREADS */
3338
3339     if (!CvXSUB(cv) && CvROOT(cv)) {
3340 #ifdef USE_THREADS
3341         if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr))
3342             croak("Can't undef active subroutine");
3343 #else
3344         if (CvDEPTH(cv))
3345             croak("Can't undef active subroutine");
3346 #endif /* USE_THREADS */
3347         ENTER;
3348
3349         SAVESPTR(PL_curpad);
3350         PL_curpad = 0;
3351
3352         if (!CvCLONED(cv))
3353             op_free(CvROOT(cv));
3354         CvROOT(cv) = Nullop;
3355         LEAVE;
3356     }
3357     SvPOK_off((SV*)cv);         /* forget prototype */
3358     CvFLAGS(cv) = 0;
3359     SvREFCNT_dec(CvGV(cv));
3360     CvGV(cv) = Nullgv;
3361     SvREFCNT_dec(CvOUTSIDE(cv));
3362     CvOUTSIDE(cv) = Nullcv;
3363     if (CvPADLIST(cv)) {
3364         /* may be during global destruction */
3365         if (SvREFCNT(CvPADLIST(cv))) {
3366             I32 i = AvFILLp(CvPADLIST(cv));
3367             while (i >= 0) {
3368                 SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
3369                 SV* sv = svp ? *svp : Nullsv;
3370                 if (!sv)
3371                     continue;
3372                 if (sv == (SV*)PL_comppad_name)
3373                     PL_comppad_name = Nullav;
3374                 else if (sv == (SV*)PL_comppad) {
3375                     PL_comppad = Nullav;
3376                     PL_curpad = Null(SV**);
3377                 }
3378                 SvREFCNT_dec(sv);
3379             }
3380             SvREFCNT_dec((SV*)CvPADLIST(cv));
3381         }
3382         CvPADLIST(cv) = Nullav;
3383     }
3384 }
3385
3386 #ifdef DEBUG_CLOSURES
3387 STATIC void
3388 cv_dump(cv)
3389 CV* cv;
3390 {
3391     CV *outside = CvOUTSIDE(cv);
3392     AV* padlist = CvPADLIST(cv);
3393     AV* pad_name;
3394     AV* pad;
3395     SV** pname;
3396     SV** ppad;
3397     I32 ix;
3398
3399     PerlIO_printf(Perl_debug_log, "\tCV=0x%lx (%s), OUTSIDE=0x%lx (%s)\n",
3400                   cv,
3401                   (CvANON(cv) ? "ANON"
3402                    : (cv == PL_main_cv) ? "MAIN"
3403                    : CvUNIQUE(outside) ? "UNIQUE"
3404                    : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
3405                   outside,
3406                   (!outside ? "null"
3407                    : CvANON(outside) ? "ANON"
3408                    : (outside == PL_main_cv) ? "MAIN"
3409                    : CvUNIQUE(outside) ? "UNIQUE"
3410                    : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
3411
3412     if (!padlist)
3413         return;
3414
3415     pad_name = (AV*)*av_fetch(padlist, 0, FALSE);
3416     pad = (AV*)*av_fetch(padlist, 1, FALSE);
3417     pname = AvARRAY(pad_name);
3418     ppad = AvARRAY(pad);
3419
3420     for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
3421         if (SvPOK(pname[ix]))
3422             PerlIO_printf(Perl_debug_log, "\t%4d. 0x%lx (%s\"%s\" %ld-%ld)\n",
3423                           ix, ppad[ix],
3424                           SvFAKE(pname[ix]) ? "FAKE " : "",
3425                           SvPVX(pname[ix]),
3426                           (long)I_32(SvNVX(pname[ix])),
3427                           (long)SvIVX(pname[ix]));
3428     }
3429 }
3430 #endif /* DEBUG_CLOSURES */
3431
3432 STATIC CV *
3433 cv_clone2(CV *proto, CV *outside)
3434 {
3435     dTHR;
3436     AV* av;
3437     I32 ix;
3438     AV* protopadlist = CvPADLIST(proto);
3439     AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
3440     AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
3441     SV** pname = AvARRAY(protopad_name);
3442     SV** ppad = AvARRAY(protopad);
3443     I32 fname = AvFILLp(protopad_name);
3444     I32 fpad = AvFILLp(protopad);
3445     AV* comppadlist;
3446     CV* cv;
3447
3448     assert(!CvUNIQUE(proto));
3449
3450     ENTER;
3451     SAVESPTR(PL_curpad);
3452     SAVESPTR(PL_comppad);
3453     SAVESPTR(PL_comppad_name);
3454     SAVESPTR(PL_compcv);
3455
3456     cv = PL_compcv = (CV*)NEWSV(1104,0);
3457     sv_upgrade((SV *)cv, SvTYPE(proto));
3458     CvCLONED_on(cv);
3459     if (CvANON(proto))
3460         CvANON_on(cv);
3461
3462 #ifdef USE_THREADS
3463     New(666, CvMUTEXP(cv), 1, perl_mutex);
3464     MUTEX_INIT(CvMUTEXP(cv));
3465     CvOWNER(cv)         = 0;
3466 #endif /* USE_THREADS */
3467     CvFILEGV(cv)        = CvFILEGV(proto);
3468     CvGV(cv)            = (GV*)SvREFCNT_inc(CvGV(proto));
3469     CvSTASH(cv)         = CvSTASH(proto);
3470     CvROOT(cv)          = CvROOT(proto);
3471     CvSTART(cv)         = CvSTART(proto);
3472     if (outside)
3473         CvOUTSIDE(cv)   = (CV*)SvREFCNT_inc(outside);
3474
3475     if (SvPOK(proto))
3476         sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
3477
3478     PL_comppad_name = newAV();
3479     for (ix = fname; ix >= 0; ix--)
3480         av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
3481
3482     PL_comppad = newAV();
3483
3484     comppadlist = newAV();
3485     AvREAL_off(comppadlist);
3486     av_store(comppadlist, 0, (SV*)PL_comppad_name);
3487     av_store(comppadlist, 1, (SV*)PL_comppad);
3488     CvPADLIST(cv) = comppadlist;
3489     av_fill(PL_comppad, AvFILLp(protopad));
3490     PL_curpad = AvARRAY(PL_comppad);
3491
3492     av = newAV();           /* will be @_ */
3493     av_extend(av, 0);
3494     av_store(PL_comppad, 0, (SV*)av);
3495     AvFLAGS(av) = AVf_REIFY;
3496
3497     for (ix = fpad; ix > 0; ix--) {
3498         SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
3499         if (namesv && namesv != &PL_sv_undef) {
3500             char *name = SvPVX(namesv);    /* XXX */
3501             if (SvFLAGS(namesv) & SVf_FAKE) {   /* lexical from outside? */
3502                 I32 off = pad_findlex(name, ix, SvIVX(namesv),
3503                                       CvOUTSIDE(cv), cxstack_ix);
3504                 if (!off)
3505                     PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
3506                 else if (off != ix)
3507                     croak("panic: cv_clone: %s", name);
3508             }
3509             else {                              /* our own lexical */
3510                 SV* sv;
3511                 if (*name == '&') {
3512                     /* anon code -- we'll come back for it */
3513                     sv = SvREFCNT_inc(ppad[ix]);
3514                 }
3515                 else if (*name == '@')
3516                     sv = (SV*)newAV();
3517                 else if (*name == '%')
3518                     sv = (SV*)newHV();
3519                 else
3520                     sv = NEWSV(0,0);
3521                 if (!SvPADBUSY(sv))
3522                     SvPADMY_on(sv);
3523                 PL_curpad[ix] = sv;
3524             }
3525         }
3526         else {
3527             SV* sv = NEWSV(0,0);
3528             SvPADTMP_on(sv);
3529             PL_curpad[ix] = sv;
3530         }
3531     }
3532
3533     /* Now that vars are all in place, clone nested closures. */
3534
3535     for (ix = fpad; ix > 0; ix--) {
3536         SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
3537         if (namesv
3538             && namesv != &PL_sv_undef
3539             && !(SvFLAGS(namesv) & SVf_FAKE)
3540             && *SvPVX(namesv) == '&'
3541             && CvCLONE(ppad[ix]))
3542         {
3543             CV *kid = cv_clone2((CV*)ppad[ix], cv);
3544             SvREFCNT_dec(ppad[ix]);
3545             CvCLONE_on(kid);
3546             SvPADMY_on(kid);
3547             PL_curpad[ix] = (SV*)kid;
3548         }
3549     }
3550
3551 #ifdef DEBUG_CLOSURES
3552     PerlIO_printf(Perl_debug_log, "Cloned inside:\n");
3553     cv_dump(outside);
3554     PerlIO_printf(Perl_debug_log, "  from:\n");
3555     cv_dump(proto);
3556     PerlIO_printf(Perl_debug_log, "   to:\n");
3557     cv_dump(cv);
3558 #endif
3559
3560     LEAVE;
3561     return cv;
3562 }
3563
3564 CV *
3565 cv_clone(CV *proto)
3566 {
3567     return cv_clone2(proto, CvOUTSIDE(proto));
3568 }
3569
3570 void
3571 cv_ckproto(CV *cv, GV *gv, char *p)
3572 {
3573     if ((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) {
3574         SV* msg = sv_newmortal();
3575         SV* name = Nullsv;
3576
3577         if (gv)
3578             gv_efullname3(name = sv_newmortal(), gv, Nullch);
3579         sv_setpv(msg, "Prototype mismatch:");
3580         if (name)
3581             sv_catpvf(msg, " sub %_", name);
3582         if (SvPOK(cv))
3583             sv_catpvf(msg, " (%s)", SvPVX(cv));
3584         sv_catpv(msg, " vs ");
3585         if (p)
3586             sv_catpvf(msg, "(%s)", p);
3587         else
3588             sv_catpv(msg, "none");
3589         warn("%_", msg);
3590     }
3591 }
3592
3593 SV *
3594 cv_const_sv(CV *cv)
3595 {
3596     if (!cv || !SvPOK(cv) || SvCUR(cv))
3597         return Nullsv;
3598     return op_const_sv(CvSTART(cv), cv);
3599 }
3600
3601 SV *
3602 op_const_sv(OP *o, CV *cv)
3603 {
3604     SV *sv = Nullsv;
3605
3606     if(!o)
3607         return Nullsv;
3608
3609     if(o->op_type == OP_LINESEQ && cLISTOPo->op_first)
3610         o = cLISTOPo->op_first->op_sibling;
3611
3612     for (; o; o = o->op_next) {
3613         OPCODE type = o->op_type;
3614
3615         if(sv && o->op_next == o)
3616             return sv;
3617         if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
3618             continue;
3619         if (type == OP_LEAVESUB || type == OP_RETURN)
3620             break;
3621         if (sv)
3622             return Nullsv;
3623         if (type == OP_CONST)
3624             sv = cSVOPo->op_sv;
3625         else if (type == OP_PADSV && cv) {
3626             AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
3627             sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
3628             if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
3629                 return Nullsv;
3630         }
3631         else
3632             return Nullsv;
3633     }
3634     if (sv)
3635         SvREADONLY_on(sv);
3636     return sv;
3637 }
3638
3639 CV *
3640 newSUB(I32 floor, OP *o, OP *proto, OP *block)
3641 {
3642     dTHR;
3643     char *name = o ? SvPVx(cSVOPo->op_sv, PL_na) : Nullch;
3644     GV *gv = gv_fetchpv(name ? name : "__ANON__",
3645                         GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV);
3646     char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, PL_na) : Nullch;
3647     register CV *cv=0;
3648     I32 ix;
3649
3650     if (o)
3651         SAVEFREEOP(o);
3652     if (proto)
3653         SAVEFREEOP(proto);
3654
3655     if (SvTYPE(gv) != SVt_PVGV) {       /* Prototype now, and had
3656                                            maximum a prototype before. */
3657         if (SvTYPE(gv) > SVt_NULL) {
3658             if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1))
3659                 warn("Runaway prototype");
3660             cv_ckproto((CV*)gv, NULL, ps);
3661         }
3662         if (ps)
3663             sv_setpv((SV*)gv, ps);
3664         else
3665             sv_setiv((SV*)gv, -1);
3666         SvREFCNT_dec(PL_compcv);
3667         cv = PL_compcv = NULL;
3668         PL_sub_generation++;
3669         goto noblock;
3670     }
3671
3672     if (!name || GvCVGEN(gv))
3673         cv = Nullcv;
3674     else if (cv = GvCV(gv)) {
3675         cv_ckproto(cv, gv, ps);
3676         /* already defined (or promised)? */
3677         if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
3678             SV* const_sv;
3679             bool const_changed = TRUE;
3680             if (!block) {
3681                 /* just a "sub foo;" when &foo is already defined */
3682                 SAVEFREESV(PL_compcv);
3683                 goto done;
3684             }
3685             /* ahem, death to those who redefine active sort subs */
3686             if (PL_curstackinfo->si_type == PERLSI_SORT && PL_sortcop == CvSTART(cv))
3687                 croak("Can't redefine active sort subroutine %s", name);
3688             if(const_sv = cv_const_sv(cv))
3689                 const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv));
3690             if ((const_sv && const_changed) || PL_dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
3691                                         && HvNAME(GvSTASH(CvGV(cv)))
3692                                         && strEQ(HvNAME(GvSTASH(CvGV(cv))),
3693                                                  "autouse"))) {
3694                 line_t oldline = PL_curcop->cop_line;
3695                 PL_curcop->cop_line = PL_copline;
3696                 warn(const_sv ? "Constant subroutine %s redefined"
3697                      : "Subroutine %s redefined", name);
3698                 PL_curcop->cop_line = oldline;
3699             }
3700             SvREFCNT_dec(cv);
3701             cv = Nullcv;
3702         }
3703     }
3704     if (cv) {                           /* must reuse cv if autoloaded */
3705         cv_undef(cv);
3706         CvFLAGS(cv) = CvFLAGS(PL_compcv);
3707         CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
3708         CvOUTSIDE(PL_compcv) = 0;
3709         CvPADLIST(cv) = CvPADLIST(PL_compcv);
3710         CvPADLIST(PL_compcv) = 0;
3711         if (SvREFCNT(PL_compcv) > 1) /* XXX Make closures transit through stub. */
3712             CvOUTSIDE(PL_compcv) = (CV*)SvREFCNT_inc((SV*)cv);
3713         SvREFCNT_dec(PL_compcv);
3714     }
3715     else {
3716         cv = PL_compcv;
3717         if (name) {
3718             GvCV(gv) = cv;
3719             GvCVGEN(gv) = 0;
3720             PL_sub_generation++;
3721         }
3722     }
3723     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
3724     CvFILEGV(cv) = PL_curcop->cop_filegv;
3725     CvSTASH(cv) = PL_curstash;
3726 #ifdef USE_THREADS
3727     CvOWNER(cv) = 0;
3728     if (!CvMUTEXP(cv))
3729         New(666, CvMUTEXP(cv), 1, perl_mutex);
3730     MUTEX_INIT(CvMUTEXP(cv));
3731 #endif /* USE_THREADS */
3732
3733     if (ps)
3734         sv_setpv((SV*)cv, ps);
3735
3736     if (PL_error_count) {
3737         op_free(block);
3738         block = Nullop;
3739         if (name) {
3740             char *s = strrchr(name, ':');
3741             s = s ? s+1 : name;
3742             if (strEQ(s, "BEGIN")) {
3743                 char *not_safe =
3744                     "BEGIN not safe after errors--compilation aborted";
3745                 if (PL_in_eval & 4)
3746                     croak(not_safe);
3747                 else {
3748                     /* force display of errors found but not reported */
3749                     sv_catpv(ERRSV, not_safe);
3750                     croak("%s", SvPVx(ERRSV, PL_na));
3751                 }
3752             }
3753         }
3754     }
3755     if (!block) {
3756       noblock:
3757         PL_copline = NOLINE;
3758         LEAVE_SCOPE(floor);
3759         return cv;
3760     }
3761
3762     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
3763         av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
3764
3765     if (CvCLONE(cv)) {
3766         SV **namep = AvARRAY(PL_comppad_name);
3767         for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
3768             SV *namesv;
3769
3770             if (SvIMMORTAL(PL_curpad[ix]))
3771                 continue;
3772             /*
3773              * The only things that a clonable function needs in its
3774              * pad are references to outer lexicals and anonymous subs.
3775              * The rest are created anew during cloning.
3776              */
3777             if (!((namesv = namep[ix]) != Nullsv &&
3778                   namesv != &PL_sv_undef &&
3779                   (SvFAKE(namesv) ||
3780                    *SvPVX(namesv) == '&')))
3781             {
3782                 SvREFCNT_dec(PL_curpad[ix]);
3783                 PL_curpad[ix] = Nullsv;
3784             }
3785         }
3786     }
3787     else {
3788         AV *av = newAV();                       /* Will be @_ */
3789         av_extend(av, 0);
3790         av_store(PL_comppad, 0, (SV*)av);
3791         AvFLAGS(av) = AVf_REIFY;
3792
3793         for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
3794             if (SvIMMORTAL(PL_curpad[ix]))
3795                 continue;
3796             if (!SvPADMY(PL_curpad[ix]))
3797                 SvPADTMP_on(PL_curpad[ix]);
3798         }
3799     }
3800
3801     CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
3802     CvSTART(cv) = LINKLIST(CvROOT(cv));
3803     CvROOT(cv)->op_next = 0;
3804     peep(CvSTART(cv));
3805
3806     if (name) {
3807         char *s;
3808
3809         if (PERLDB_SUBLINE && PL_curstash != PL_debstash) {
3810             SV *sv = NEWSV(0,0);
3811             SV *tmpstr = sv_newmortal();
3812             GV *db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
3813             CV *cv;
3814             HV *hv;
3815
3816             sv_setpvf(sv, "%_:%ld-%ld",
3817                     GvSV(PL_curcop->cop_filegv),
3818                     (long)PL_subline, (long)PL_curcop->cop_line);
3819             gv_efullname3(tmpstr, gv, Nullch);
3820             hv_store(GvHV(PL_DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
3821             hv = GvHVn(db_postponed);
3822             if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
3823                   && (cv = GvCV(db_postponed))) {
3824                 dSP;
3825                 PUSHMARK(SP);
3826                 XPUSHs(tmpstr);
3827                 PUTBACK;
3828                 perl_call_sv((SV*)cv, G_DISCARD);
3829             }
3830         }
3831
3832         if ((s = strrchr(name,':')))
3833             s++;
3834         else
3835             s = name;
3836         if (strEQ(s, "BEGIN")) {
3837             I32 oldscope = PL_scopestack_ix;
3838             ENTER;
3839             SAVESPTR(PL_compiling.cop_filegv);
3840             SAVEI16(PL_compiling.cop_line);
3841             save_svref(&PL_rs);
3842             sv_setsv(PL_rs, PL_nrs);
3843
3844             if (!PL_beginav)
3845                 PL_beginav = newAV();
3846             DEBUG_x( dump_sub(gv) );
3847             av_push(PL_beginav, (SV *)cv);
3848             GvCV(gv) = 0;
3849             call_list(oldscope, PL_beginav);
3850
3851             PL_curcop = &PL_compiling;
3852             PL_compiling.op_private = PL_hints;
3853             LEAVE;
3854         }
3855         else if (strEQ(s, "END") && !PL_error_count) {
3856             if (!PL_endav)
3857                 PL_endav = newAV();
3858             av_unshift(PL_endav, 1);
3859             av_store(PL_endav, 0, (SV *)cv);
3860             GvCV(gv) = 0;
3861         }
3862         else if (strEQ(s, "INIT") && !PL_error_count) {
3863             if (!PL_initav)
3864                 PL_initav = newAV();
3865             av_push(PL_initav, SvREFCNT_inc(cv));
3866             GvCV(gv) = 0;
3867         }
3868     }
3869
3870   done:
3871     PL_copline = NOLINE;
3872     LEAVE_SCOPE(floor);
3873     return cv;
3874 }
3875
3876 void
3877 newCONSTSUB(HV *stash, char *name, SV *sv)
3878 {
3879     dTHR;
3880     U32 oldhints = PL_hints;
3881     HV *old_cop_stash = PL_curcop->cop_stash;
3882     HV *old_curstash = PL_curstash;
3883     line_t oldline = PL_curcop->cop_line;
3884     PL_curcop->cop_line = PL_copline;
3885
3886     PL_hints &= ~HINT_BLOCK_SCOPE;
3887     if(stash)
3888         PL_curstash = PL_curcop->cop_stash = stash;
3889
3890     newSUB(
3891         start_subparse(FALSE, 0),
3892         newSVOP(OP_CONST, 0, newSVpv(name,0)),
3893         newSVOP(OP_CONST, 0, &PL_sv_no),        /* SvPV(&PL_sv_no) == "" -- GMB */
3894         newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
3895     );
3896
3897     PL_hints = oldhints;
3898     PL_curcop->cop_stash = old_cop_stash;
3899     PL_curstash = old_curstash;
3900     PL_curcop->cop_line = oldline;
3901 }
3902
3903 CV *
3904 newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename)
3905 {
3906     dTHR;
3907     GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
3908     register CV *cv;
3909
3910     if (cv = (name ? GvCV(gv) : Nullcv)) {
3911         if (GvCVGEN(gv)) {
3912             /* just a cached method */
3913             SvREFCNT_dec(cv);
3914             cv = 0;
3915         }
3916         else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
3917             /* already defined (or promised) */
3918             if (PL_dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv))
3919                             && HvNAME(GvSTASH(CvGV(cv)))
3920                             && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) {
3921                 line_t oldline = PL_curcop->cop_line;
3922                 PL_curcop->cop_line = PL_copline;
3923                 warn("Subroutine %s redefined",name);
3924                 PL_curcop->cop_line = oldline;
3925             }
3926             SvREFCNT_dec(cv);
3927             cv = 0;
3928         }
3929     }
3930
3931     if (cv)                             /* must reuse cv if autoloaded */
3932         cv_undef(cv);
3933     else {
3934         cv = (CV*)NEWSV(1105,0);
3935         sv_upgrade((SV *)cv, SVt_PVCV);
3936         if (name) {
3937             GvCV(gv) = cv;
3938             GvCVGEN(gv) = 0;
3939             PL_sub_generation++;
3940         }
3941     }
3942     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
3943 #ifdef USE_THREADS
3944     New(666, CvMUTEXP(cv), 1, perl_mutex);
3945     MUTEX_INIT(CvMUTEXP(cv));
3946     CvOWNER(cv) = 0;
3947 #endif /* USE_THREADS */
3948     CvFILEGV(cv) = gv_fetchfile(filename);
3949     CvXSUB(cv) = subaddr;
3950
3951     if (name) {
3952         char *s = strrchr(name,':');
3953         if (s)
3954             s++;
3955         else
3956             s = name;
3957         if (strEQ(s, "BEGIN")) {
3958             if (!PL_beginav)
3959                 PL_beginav = newAV();
3960             av_push(PL_beginav, (SV *)cv);
3961             GvCV(gv) = 0;
3962         }
3963         else if (strEQ(s, "END")) {
3964             if (!PL_endav)
3965                 PL_endav = newAV();
3966             av_unshift(PL_endav, 1);
3967             av_store(PL_endav, 0, (SV *)cv);
3968             GvCV(gv) = 0;
3969         }
3970         else if (strEQ(s, "INIT")) {
3971             if (!PL_initav)
3972                 PL_initav = newAV();
3973             av_push(PL_initav, (SV *)cv);
3974         }
3975     }
3976     else
3977         CvANON_on(cv);
3978
3979     return cv;
3980 }
3981
3982 void
3983 newFORM(I32 floor, OP *o, OP *block)
3984 {
3985     dTHR;
3986     register CV *cv;
3987     char *name;
3988     GV *gv;
3989     I32 ix;
3990
3991     if (o)
3992         name = SvPVx(cSVOPo->op_sv, PL_na);
3993     else
3994         name = "STDOUT";
3995     gv = gv_fetchpv(name,TRUE, SVt_PVFM);
3996     GvMULTI_on(gv);
3997     if (cv = GvFORM(gv)) {
3998         if (PL_dowarn) {
3999             line_t oldline = PL_curcop->cop_line;
4000
4001             PL_curcop->cop_line = PL_copline;
4002             warn("Format %s redefined",name);
4003             PL_curcop->cop_line = oldline;
4004         }
4005         SvREFCNT_dec(cv);
4006     }
4007     cv = PL_compcv;
4008     GvFORM(gv) = cv;
4009     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
4010     CvFILEGV(cv) = PL_curcop->cop_filegv;
4011
4012     for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
4013         if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
4014             SvPADTMP_on(PL_curpad[ix]);
4015     }
4016
4017     CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
4018     CvSTART(cv) = LINKLIST(CvROOT(cv));
4019     CvROOT(cv)->op_next = 0;
4020     peep(CvSTART(cv));
4021     op_free(o);
4022     PL_copline = NOLINE;
4023     LEAVE_SCOPE(floor);
4024 }
4025
4026 OP *
4027 newANONLIST(OP *o)
4028 {
4029     return newUNOP(OP_REFGEN, 0,
4030         mod(list(convert(OP_ANONLIST, 0, o)), OP_REFGEN));
4031 }
4032
4033 OP *
4034 newANONHASH(OP *o)
4035 {
4036     return newUNOP(OP_REFGEN, 0,
4037         mod(list(convert(OP_ANONHASH, 0, o)), OP_REFGEN));
4038 }
4039
4040 OP *
4041 newANONSUB(I32 floor, OP *proto, OP *block)
4042 {
4043     return newUNOP(OP_REFGEN, 0,
4044         newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, proto, block)));
4045 }
4046
4047 OP *
4048 oopsAV(OP *o)
4049 {
4050     switch (o->op_type) {
4051     case OP_PADSV:
4052         o->op_type = OP_PADAV;
4053         o->op_ppaddr = ppaddr[OP_PADAV];
4054         return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV);
4055
4056     case OP_RV2SV:
4057         o->op_type = OP_RV2AV;
4058         o->op_ppaddr = ppaddr[OP_RV2AV];
4059         ref(o, OP_RV2AV);
4060         break;
4061
4062     default:
4063         warn("oops: oopsAV");
4064         break;
4065     }
4066     return o;
4067 }
4068
4069 OP *
4070 oopsHV(OP *o)
4071 {
4072     switch (o->op_type) {
4073     case OP_PADSV:
4074     case OP_PADAV:
4075         o->op_type = OP_PADHV;
4076         o->op_ppaddr = ppaddr[OP_PADHV];
4077         return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV);
4078
4079     case OP_RV2SV:
4080     case OP_RV2AV:
4081         o->op_type = OP_RV2HV;
4082         o->op_ppaddr = ppaddr[OP_RV2HV];
4083         ref(o, OP_RV2HV);
4084         break;
4085
4086     default:
4087         warn("oops: oopsHV");
4088         break;
4089     }
4090     return o;
4091 }
4092
4093 OP *
4094 newAVREF(OP *o)
4095 {
4096     if (o->op_type == OP_PADANY) {
4097         o->op_type = OP_PADAV;
4098         o->op_ppaddr = ppaddr[OP_PADAV];
4099         return o;
4100     }
4101     return newUNOP(OP_RV2AV, 0, scalar(o));
4102 }
4103
4104 OP *
4105 newGVREF(I32 type, OP *o)
4106 {
4107     if (type == OP_MAPSTART)
4108         return newUNOP(OP_NULL, 0, o);
4109     return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
4110 }
4111
4112 OP *
4113 newHVREF(OP *o)
4114 {
4115     if (o->op_type == OP_PADANY) {
4116         o->op_type = OP_PADHV;
4117         o->op_ppaddr = ppaddr[OP_PADHV];
4118         return o;
4119     }
4120     return newUNOP(OP_RV2HV, 0, scalar(o));
4121 }
4122
4123 OP *
4124 oopsCV(OP *o)
4125 {
4126     croak("NOT IMPL LINE %d",__LINE__);
4127     /* STUB */
4128     return o;
4129 }
4130
4131 OP *
4132 newCVREF(I32 flags, OP *o)
4133 {
4134     return newUNOP(OP_RV2CV, flags, scalar(o));
4135 }
4136
4137 OP *
4138 newSVREF(OP *o)
4139 {
4140     if (o->op_type == OP_PADANY) {
4141         o->op_type = OP_PADSV;
4142         o->op_ppaddr = ppaddr[OP_PADSV];
4143         return o;
4144     }
4145     else if (o->op_type == OP_THREADSV && !(o->op_flags & OPpDONE_SVREF)) {
4146         o->op_flags |= OPpDONE_SVREF;
4147         return o;
4148     }
4149     return newUNOP(OP_RV2SV, 0, scalar(o));
4150 }
4151
4152 /* Check routines. */
4153
4154 OP *
4155 ck_anoncode(OP *o)
4156 {
4157     PADOFFSET ix;
4158     SV* name;
4159
4160     name = NEWSV(1106,0);
4161     sv_upgrade(name, SVt_PVNV);
4162     sv_setpvn(name, "&", 1);
4163     SvIVX(name) = -1;
4164     SvNVX(name) = 1;
4165     ix = pad_alloc(o->op_type, SVs_PADMY);
4166     av_store(PL_comppad_name, ix, name);
4167     av_store(PL_comppad, ix, cSVOPo->op_sv);
4168     SvPADMY_on(cSVOPo->op_sv);
4169     cSVOPo->op_sv = Nullsv;
4170     cSVOPo->op_targ = ix;
4171     return o;
4172 }
4173
4174 OP *
4175 ck_bitop(OP *o)
4176 {
4177     o->op_private = PL_hints;
4178     return o;
4179 }
4180
4181 OP *
4182 ck_concat(OP *o)
4183 {
4184     if (cUNOPo->op_first->op_type == OP_CONCAT)
4185         o->op_flags |= OPf_STACKED;
4186     return o;
4187 }
4188
4189 OP *
4190 ck_spair(OP *o)
4191 {
4192     if (o->op_flags & OPf_KIDS) {
4193         OP* newop;
4194         OP* kid;
4195         OPCODE type = o->op_type;
4196         o = modkids(ck_fun(o), type);
4197         kid = cUNOPo->op_first;
4198         newop = kUNOP->op_first->op_sibling;
4199         if (newop &&
4200             (newop->op_sibling ||
4201              !(opargs[newop->op_type] & OA_RETSCALAR) ||
4202              newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
4203              newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
4204
4205             return o;
4206         }
4207         op_free(kUNOP->op_first);
4208         kUNOP->op_first = newop;
4209     }
4210     o->op_ppaddr = ppaddr[++o->op_type];
4211     return ck_fun(o);
4212 }
4213
4214 OP *
4215 ck_delete(OP *o)
4216 {
4217     o = ck_fun(o);
4218     o->op_private = 0;
4219     if (o->op_flags & OPf_KIDS) {
4220         OP *kid = cUNOPo->op_first;
4221         if (kid->op_type == OP_HSLICE)
4222             o->op_private |= OPpSLICE;
4223         else if (kid->op_type != OP_HELEM)
4224             croak("%s argument is not a HASH element or slice",
4225                   op_desc[o->op_type]);
4226         null(kid);
4227     }
4228     return o;
4229 }
4230
4231 OP *
4232 ck_eof(OP *o)
4233 {
4234     I32 type = o->op_type;
4235
4236     if (o->op_flags & OPf_KIDS) {
4237         if (cLISTOPo->op_first->op_type == OP_STUB) {
4238             op_free(o);
4239             o = newUNOP(type, OPf_SPECIAL,
4240                 newGVOP(OP_GV, 0, gv_fetchpv("main::ARGV", TRUE, SVt_PVAV)));
4241         }
4242         return ck_fun(o);
4243     }
4244     return o;
4245 }
4246
4247 OP *
4248 ck_eval(OP *o)
4249 {
4250     PL_hints |= HINT_BLOCK_SCOPE;
4251     if (o->op_flags & OPf_KIDS) {
4252         SVOP *kid = (SVOP*)cUNOPo->op_first;
4253
4254         if (!kid) {
4255             o->op_flags &= ~OPf_KIDS;
4256             null(o);
4257         }
4258         else if (kid->op_type == OP_LINESEQ) {
4259             LOGOP *enter;
4260
4261             kid->op_next = o->op_next;
4262             cUNOPo->op_first = 0;
4263             op_free(o);
4264
4265             Newz(1101, enter, 1, LOGOP);
4266             enter->op_type = OP_ENTERTRY;
4267             enter->op_ppaddr = ppaddr[OP_ENTERTRY];
4268             enter->op_private = 0;
4269
4270             /* establish postfix order */
4271             enter->op_next = (OP*)enter;
4272
4273             o = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
4274             o->op_type = OP_LEAVETRY;
4275             o->op_ppaddr = ppaddr[OP_LEAVETRY];
4276             enter->op_other = o;
4277             return o;
4278         }
4279         else
4280             scalar((OP*)kid);
4281     }
4282     else {
4283         op_free(o);
4284         o = newUNOP(OP_ENTEREVAL, 0, newDEFSVOP());
4285     }
4286     o->op_targ = (PADOFFSET)PL_hints;
4287     return o;
4288 }
4289
4290 OP *
4291 ck_exec(OP *o)
4292 {
4293     OP *kid;
4294     if (o->op_flags & OPf_STACKED) {
4295         o = ck_fun(o);
4296         kid = cUNOPo->op_first->op_sibling;
4297         if (kid->op_type == OP_RV2GV)
4298             null(kid);
4299     }
4300     else
4301         o = listkids(o);
4302     return o;
4303 }
4304
4305 OP *
4306 ck_exists(OP *o)
4307 {
4308     o = ck_fun(o);
4309     if (o->op_flags & OPf_KIDS) {
4310         OP *kid = cUNOPo->op_first;
4311         if (kid->op_type != OP_HELEM)
4312             croak("%s argument is not a HASH element", op_desc[o->op_type]);
4313         null(kid);
4314     }
4315     return o;
4316 }
4317
4318 OP *
4319 ck_gvconst(register OP *o)
4320 {
4321     o = fold_constants(o);
4322     if (o->op_type == OP_CONST)
4323         o->op_type = OP_GV;
4324     return o;
4325 }
4326
4327 OP *
4328 ck_rvconst(register OP *o)
4329 {
4330     dTHR;
4331     SVOP *kid = (SVOP*)cUNOPo->op_first;
4332
4333     o->op_private |= (PL_hints & HINT_STRICT_REFS);
4334     if (kid->op_type == OP_CONST) {
4335         char *name;
4336         int iscv;
4337         GV *gv;
4338
4339         name = SvPV(kid->op_sv, PL_na);
4340         if ((PL_hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
4341             char *badthing = Nullch;
4342             switch (o->op_type) {
4343             case OP_RV2SV:
4344                 badthing = "a SCALAR";
4345                 break;
4346             case OP_RV2AV:
4347                 badthing = "an ARRAY";
4348                 break;
4349             case OP_RV2HV:
4350                 badthing = "a HASH";
4351                 break;
4352             }
4353             if (badthing)
4354                 croak(
4355           "Can't use bareword (\"%s\") as %s ref while \"strict refs\" in use",
4356                       name, badthing);
4357         }
4358         /*
4359          * This is a little tricky.  We only want to add the symbol if we
4360          * didn't add it in the lexer.  Otherwise we get duplicate strict
4361          * warnings.  But if we didn't add it in the lexer, we must at
4362          * least pretend like we wanted to add it even if it existed before,
4363          * or we get possible typo warnings.  OPpCONST_ENTERED says
4364          * whether the lexer already added THIS instance of this symbol.
4365          */
4366         iscv = (o->op_type == OP_RV2CV) * 2;
4367         do {
4368             gv = gv_fetchpv(name,
4369                 iscv | !(kid->op_private & OPpCONST_ENTERED),
4370                 iscv
4371                     ? SVt_PVCV
4372                     : o->op_type == OP_RV2SV
4373                         ? SVt_PV
4374                         : o->op_type == OP_RV2AV
4375                             ? SVt_PVAV
4376                             : o->op_type == OP_RV2HV
4377                                 ? SVt_PVHV
4378                                 : SVt_PVGV);
4379         } while (!gv && !(kid->op_private & OPpCONST_ENTERED) && !iscv++);
4380         if (gv) {
4381             kid->op_type = OP_GV;
4382             SvREFCNT_dec(kid->op_sv);
4383             kid->op_sv = SvREFCNT_inc(gv);
4384         }
4385     }
4386     return o;
4387 }
4388
4389 OP *
4390 ck_ftst(OP *o)
4391 {
4392     dTHR;
4393     I32 type = o->op_type;
4394
4395     if (o->op_flags & OPf_REF)
4396         return o;
4397
4398     if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
4399         SVOP *kid = (SVOP*)cUNOPo->op_first;
4400
4401         if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
4402             OP *newop = newGVOP(type, OPf_REF,
4403                 gv_fetchpv(SvPVx(kid->op_sv, PL_na), TRUE, SVt_PVIO));
4404             op_free(o);
4405             return newop;
4406         }
4407     }
4408     else {
4409         op_free(o);
4410         if (type == OP_FTTTY)
4411            return newGVOP(type, OPf_REF, gv_fetchpv("main::STDIN", TRUE,
4412                                 SVt_PVIO));
4413         else
4414             return newUNOP(type, 0, newDEFSVOP());
4415     }
4416     return o;
4417 }
4418
4419 OP *
4420 ck_fun(OP *o)
4421 {
4422     dTHR;
4423     register OP *kid;
4424     OP **tokid;
4425     OP *sibl;
4426     I32 numargs = 0;
4427     int type = o->op_type;
4428     register I32 oa = opargs[type] >> OASHIFT;
4429
4430     if (o->op_flags & OPf_STACKED) {
4431         if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
4432             oa &= ~OA_OPTIONAL;
4433         else
4434             return no_fh_allowed(o);
4435     }
4436
4437     if (o->op_flags & OPf_KIDS) {
4438         tokid = &cLISTOPo->op_first;
4439         kid = cLISTOPo->op_first;
4440         if (kid->op_type == OP_PUSHMARK ||
4441             kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
4442         {
4443             tokid = &kid->op_sibling;
4444             kid = kid->op_sibling;
4445         }
4446         if (!kid && opargs[type] & OA_DEFGV)
4447             *tokid = kid = newDEFSVOP();
4448
4449         while (oa && kid) {
4450             numargs++;
4451             sibl = kid->op_sibling;
4452             switch (oa & 7) {
4453             case OA_SCALAR:
4454                 scalar(kid);
4455                 break;
4456             case OA_LIST:
4457                 if (oa < 16) {
4458                     kid = 0;
4459                     continue;
4460                 }
4461                 else
4462                     list(kid);
4463                 break;
4464             case OA_AVREF:
4465                 if (kid->op_type == OP_CONST &&
4466                   (kid->op_private & OPpCONST_BARE)) {
4467                     char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
4468                     OP *newop = newAVREF(newGVOP(OP_GV, 0,
4469                         gv_fetchpv(name, TRUE, SVt_PVAV) ));
4470                     if (PL_dowarn)
4471                         warn("Array @%s missing the @ in argument %ld of %s()",
4472                             name, (long)numargs, op_desc[type]);
4473                     op_free(kid);
4474                     kid = newop;
4475                     kid->op_sibling = sibl;
4476                     *tokid = kid;
4477                 }
4478                 else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
4479                     bad_type(numargs, "array", op_desc[o->op_type], kid);
4480                 mod(kid, type);
4481                 break;
4482             case OA_HVREF:
4483                 if (kid->op_type == OP_CONST &&
4484                   (kid->op_private & OPpCONST_BARE)) {
4485                     char *name = SvPVx(((SVOP*)kid)->op_sv, PL_na);
4486                     OP *newop = newHVREF(newGVOP(OP_GV, 0,
4487                         gv_fetchpv(name, TRUE, SVt_PVHV) ));
4488                     if (PL_dowarn)
4489                         warn("Hash %%%s missing the %% in argument %ld of %s()",
4490                             name, (long)numargs, op_desc[type]);
4491                     op_free(kid);
4492                     kid = newop;
4493                     kid->op_sibling = sibl;
4494                     *tokid = kid;
4495                 }
4496                 else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
4497                     bad_type(numargs, "hash", op_desc[o->op_type], kid);
4498                 mod(kid, type);
4499                 break;
4500             case OA_CVREF:
4501                 {
4502                     OP *newop = newUNOP(OP_NULL, 0, kid);
4503                     kid->op_sibling = 0;
4504                     linklist(kid);
4505                     newop->op_next = newop;
4506                     kid = newop;
4507                     kid->op_sibling = sibl;
4508                     *tokid = kid;
4509                 }
4510                 break;
4511             case OA_FILEREF:
4512                 if (kid->op_type != OP_GV && kid->op_type != OP_RV2GV) {
4513                     if (kid->op_type == OP_CONST &&
4514                       (kid->op_private & OPpCONST_BARE)) {
4515                         OP *newop = newGVOP(OP_GV, 0,
4516                             gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, PL_na), TRUE,
4517                                         SVt_PVIO) );
4518                         op_free(kid);
4519                         kid = newop;
4520                     }
4521                     else {
4522                         kid->op_sibling = 0;
4523                         kid = newUNOP(OP_RV2GV, 0, scalar(kid));
4524                     }
4525                     kid->op_sibling = sibl;
4526                     *tokid = kid;
4527                 }
4528                 scalar(kid);
4529                 break;
4530             case OA_SCALARREF:
4531                 mod(scalar(kid), type);
4532                 break;
4533             }
4534             oa >>= 4;
4535             tokid = &kid->op_sibling;
4536             kid = kid->op_sibling;
4537         }
4538         o->op_private |= numargs;
4539         if (kid)
4540             return too_many_arguments(o,op_desc[o->op_type]);
4541         listkids(o);
4542     }
4543     else if (opargs[type] & OA_DEFGV) {
4544         op_free(o);
4545         return newUNOP(type, 0, newDEFSVOP());
4546     }
4547
4548     if (oa) {
4549         while (oa & OA_OPTIONAL)
4550             oa >>= 4;
4551         if (oa && oa != OA_LIST)
4552             return too_few_arguments(o,op_desc[o->op_type]);
4553     }
4554     return o;
4555 }
4556
4557 OP *
4558 ck_glob(OP *o)
4559 {
4560     GV *gv;
4561
4562     if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
4563         append_elem(OP_GLOB, o, newDEFSVOP());
4564
4565     if (!((gv = gv_fetchpv("glob", FALSE, SVt_PVCV)) && GvIMPORTED_CV(gv)))
4566         gv = gv_fetchpv("CORE::GLOBAL::glob", FALSE, SVt_PVCV);
4567
4568     if (gv && GvIMPORTED_CV(gv)) {
4569         static int glob_index;
4570
4571         append_elem(OP_GLOB, o,
4572                     newSVOP(OP_CONST, 0, newSViv(glob_index++)));
4573         o->op_type = OP_LIST;
4574         o->op_ppaddr = ppaddr[OP_LIST];
4575         cLISTOPo->op_first->op_type = OP_PUSHMARK;
4576         cLISTOPo->op_first->op_ppaddr = ppaddr[OP_PUSHMARK];
4577         o = newUNOP(OP_ENTERSUB, OPf_STACKED,
4578                     append_elem(OP_LIST, o,
4579                                 scalar(newUNOP(OP_RV2CV, 0,
4580                                                newGVOP(OP_GV, 0, gv)))));
4581         o = newUNOP(OP_NULL, 0, ck_subr(o));
4582         o->op_targ = OP_GLOB;           /* hint at what it used to be */
4583         return o;
4584     }
4585     gv = newGVgen("main");
4586     gv_IOadd(gv);
4587     append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
4588     scalarkids(o);
4589     return ck_fun(o);
4590 }
4591
4592 OP *
4593 ck_grep(OP *o)
4594 {
4595     LOGOP *gwop;
4596     OP *kid;
4597     OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
4598
4599     o->op_ppaddr = ppaddr[OP_GREPSTART];
4600     Newz(1101, gwop, 1, LOGOP);
4601
4602     if (o->op_flags & OPf_STACKED) {
4603         OP* k;
4604         o = ck_sort(o);
4605         kid = cLISTOPo->op_first->op_sibling;
4606         for (k = cLISTOPo->op_first->op_sibling->op_next; k; k = k->op_next) {
4607             kid = k;
4608         }
4609         kid->op_next = (OP*)gwop;
4610         o->op_flags &= ~OPf_STACKED;
4611     }
4612     kid = cLISTOPo->op_first->op_sibling;
4613     if (type == OP_MAPWHILE)
4614         list(kid);
4615     else
4616         scalar(kid);
4617     o = ck_fun(o);
4618     if (PL_error_count)
4619         return o;
4620     kid = cLISTOPo->op_first->op_sibling;
4621     if (kid->op_type != OP_NULL)
4622         croak("panic: ck_grep");
4623     kid = kUNOP->op_first;
4624
4625     gwop->op_type = type;
4626     gwop->op_ppaddr = ppaddr[type];
4627     gwop->op_first = listkids(o);
4628     gwop->op_flags |= OPf_KIDS;
4629     gwop->op_private = 1;
4630     gwop->op_other = LINKLIST(kid);
4631     gwop->op_targ = pad_alloc(type, SVs_PADTMP);
4632     kid->op_next = (OP*)gwop;
4633
4634     kid = cLISTOPo->op_first->op_sibling;
4635     if (!kid || !kid->op_sibling)
4636         return too_few_arguments(o,op_desc[o->op_type]);
4637     for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
4638         mod(kid, OP_GREPSTART);
4639
4640     return (OP*)gwop;
4641 }
4642
4643 OP *
4644 ck_index(OP *o)
4645 {
4646     if (o->op_flags & OPf_KIDS) {
4647         OP *kid = cLISTOPo->op_first->op_sibling;       /* get past pushmark */
4648         if (kid && kid->op_type == OP_CONST)
4649             fbm_compile(((SVOP*)kid)->op_sv, 0);
4650     }
4651     return ck_fun(o);
4652 }
4653
4654 OP *
4655 ck_lengthconst(OP *o)
4656 {
4657     /* XXX length optimization goes here */
4658     return ck_fun(o);
4659 }
4660
4661 OP *
4662 ck_lfun(OP *o)
4663 {
4664     OPCODE type = o->op_type;
4665     return modkids(ck_fun(o), type);
4666 }
4667
4668 OP *
4669 ck_rfun(OP *o)
4670 {
4671     OPCODE type = o->op_type;
4672     return refkids(ck_fun(o), type);
4673 }
4674
4675 OP *
4676 ck_listiob(OP *o)
4677 {
4678     register OP *kid;
4679
4680     kid = cLISTOPo->op_first;
4681     if (!kid) {
4682         o = force_list(o);
4683         kid = cLISTOPo->op_first;
4684     }
4685     if (kid->op_type == OP_PUSHMARK)
4686         kid = kid->op_sibling;
4687     if (kid && o->op_flags & OPf_STACKED)
4688         kid = kid->op_sibling;
4689     else if (kid && !kid->op_sibling) {         /* print HANDLE; */
4690         if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
4691             o->op_flags |= OPf_STACKED; /* make it a filehandle */
4692             kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
4693             cLISTOPo->op_first->op_sibling = kid;
4694             cLISTOPo->op_last = kid;
4695             kid = kid->op_sibling;
4696         }
4697     }
4698
4699     if (!kid)
4700         append_elem(o->op_type, o, newDEFSVOP());
4701
4702     o = listkids(o);
4703
4704     o->op_private = 0;
4705 #ifdef USE_LOCALE
4706     if (PL_hints & HINT_LOCALE)
4707         o->op_private |= OPpLOCALE;
4708 #endif
4709
4710     return o;
4711 }
4712
4713 OP *
4714 ck_fun_locale(OP *o)
4715 {
4716     o = ck_fun(o);
4717
4718     o->op_private = 0;
4719 #ifdef USE_LOCALE
4720     if (PL_hints & HINT_LOCALE)
4721         o->op_private |= OPpLOCALE;
4722 #endif
4723
4724     return o;
4725 }
4726
4727 OP *
4728 ck_scmp(OP *o)
4729 {
4730     o->op_private = 0;
4731 #ifdef USE_LOCALE
4732     if (PL_hints & HINT_LOCALE)
4733         o->op_private |= OPpLOCALE;
4734 #endif
4735
4736     return o;
4737 }
4738
4739 OP *
4740 ck_match(OP *o)
4741 {
4742     o->op_private |= OPpRUNTIME;
4743     return o;
4744 }
4745
4746 OP *
4747 ck_null(OP *o)
4748 {
4749     return o;
4750 }
4751
4752 OP *
4753 ck_repeat(OP *o)
4754 {
4755     if (cBINOPo->op_first->op_flags & OPf_PARENS) {
4756         o->op_private |= OPpREPEAT_DOLIST;
4757         cBINOPo->op_first = force_list(cBINOPo->op_first);
4758     }
4759     else
4760         scalar(o);
4761     return o;
4762 }
4763
4764 OP *
4765 ck_require(OP *o)
4766 {
4767     if (o->op_flags & OPf_KIDS) {       /* Shall we supply missing .pm? */
4768         SVOP *kid = (SVOP*)cUNOPo->op_first;
4769
4770         if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
4771             char *s;
4772             for (s = SvPVX(kid->op_sv); *s; s++) {
4773                 if (*s == ':' && s[1] == ':') {
4774                     *s = '/';
4775                     Move(s+2, s+1, strlen(s+2)+1, char);
4776                     --SvCUR(kid->op_sv);
4777                 }
4778             }
4779             sv_catpvn(kid->op_sv, ".pm", 3);
4780         }
4781     }
4782     return ck_fun(o);
4783 }
4784
4785 OP *
4786 ck_retarget(OP *o)
4787 {
4788     croak("NOT IMPL LINE %d",__LINE__);
4789     /* STUB */
4790     return o;
4791 }
4792
4793 OP *
4794 ck_select(OP *o)
4795 {
4796     OP* kid;
4797     if (o->op_flags & OPf_KIDS) {
4798         kid = cLISTOPo->op_first->op_sibling;   /* get past pushmark */
4799         if (kid && kid->op_sibling) {
4800             o->op_type = OP_SSELECT;
4801             o->op_ppaddr = ppaddr[OP_SSELECT];
4802             o = ck_fun(o);
4803             return fold_constants(o);
4804         }
4805     }
4806     o = ck_fun(o);
4807     kid = cLISTOPo->op_first->op_sibling;    /* get past pushmark */
4808     if (kid && kid->op_type == OP_RV2GV)
4809         kid->op_private &= ~HINT_STRICT_REFS;
4810     return o;
4811 }
4812
4813 OP *
4814 ck_shift(OP *o)
4815 {
4816     I32 type = o->op_type;
4817
4818     if (!(o->op_flags & OPf_KIDS)) {
4819         OP *argop;
4820
4821         op_free(o);
4822 #ifdef USE_THREADS
4823         if (!CvUNIQUE(PL_compcv)) {
4824             argop = newOP(OP_PADAV, OPf_REF);
4825             argop->op_targ = 0;         /* PL_curpad[0] is @_ */
4826         }
4827         else {
4828             argop = newUNOP(OP_RV2AV, 0,
4829                 scalar(newGVOP(OP_GV, 0,
4830                     gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
4831         }
4832 #else
4833         argop = newUNOP(OP_RV2AV, 0,
4834             scalar(newGVOP(OP_GV, 0, !CvUNIQUE(PL_compcv) ?
4835                            PL_defgv : gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
4836 #endif /* USE_THREADS */
4837         return newUNOP(type, 0, scalar(argop));
4838     }
4839     return scalar(modkids(ck_fun(o), type));
4840 }
4841
4842 OP *
4843 ck_sort(OP *o)
4844 {
4845     o->op_private = 0;
4846 #ifdef USE_LOCALE
4847     if (PL_hints & HINT_LOCALE)
4848         o->op_private |= OPpLOCALE;
4849 #endif
4850
4851     if (o->op_flags & OPf_STACKED) {
4852         OP *kid = cLISTOPo->op_first->op_sibling;       /* get past pushmark */
4853         OP *k;
4854         kid = kUNOP->op_first;                          /* get past rv2gv */
4855
4856         if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
4857             linklist(kid);
4858             if (kid->op_type == OP_SCOPE) {
4859                 k = kid->op_next;
4860                 kid->op_next = 0;
4861             }
4862             else if (kid->op_type == OP_LEAVE) {
4863                 if (o->op_type == OP_SORT) {
4864                     null(kid);                  /* wipe out leave */
4865                     kid->op_next = kid;
4866
4867                     for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
4868                         if (k->op_next == kid)
4869                             k->op_next = 0;
4870                     }
4871                 }
4872                 else
4873                     kid->op_next = 0;           /* just disconnect the leave */
4874                 k = kLISTOP->op_first;
4875             }
4876             peep(k);
4877
4878             kid = cLISTOPo->op_first->op_sibling;       /* get past pushmark */
4879             null(kid);                                  /* wipe out rv2gv */
4880             if (o->op_type == OP_SORT)
4881                 kid->op_next = kid;
4882             else
4883                 kid->op_next = k;
4884             o->op_flags |= OPf_SPECIAL;
4885         }
4886     }
4887
4888     return o;
4889 }
4890
4891 OP *
4892 ck_split(OP *o)
4893 {
4894     register OP *kid;
4895
4896     if (o->op_flags & OPf_STACKED)
4897         return no_fh_allowed(o);
4898
4899     kid = cLISTOPo->op_first;
4900     if (kid->op_type != OP_NULL)
4901         croak("panic: ck_split");
4902     kid = kid->op_sibling;
4903     op_free(cLISTOPo->op_first);
4904     cLISTOPo->op_first = kid;
4905     if (!kid) {
4906         cLISTOPo->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
4907         cLISTOPo->op_last = kid; /* There was only one element previously */
4908     }
4909
4910     if (kid->op_type != OP_MATCH) {
4911         OP *sibl = kid->op_sibling;
4912         kid->op_sibling = 0;
4913         kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
4914         if (cLISTOPo->op_first == cLISTOPo->op_last)
4915             cLISTOPo->op_last = kid;
4916         cLISTOPo->op_first = kid;
4917         kid->op_sibling = sibl;
4918     }
4919
4920     kid->op_type = OP_PUSHRE;
4921     kid->op_ppaddr = ppaddr[OP_PUSHRE];
4922     scalar(kid);
4923
4924     if (!kid->op_sibling)
4925         append_elem(OP_SPLIT, o, newDEFSVOP());
4926
4927     kid = kid->op_sibling;
4928     scalar(kid);
4929
4930     if (!kid->op_sibling)
4931         append_elem(OP_SPLIT, o, newSVOP(OP_CONST, 0, newSViv(0)));
4932
4933     kid = kid->op_sibling;
4934     scalar(kid);
4935
4936     if (kid->op_sibling)
4937         return too_many_arguments(o,op_desc[o->op_type]);
4938
4939     return o;
4940 }
4941
4942 OP *
4943 ck_subr(OP *o)
4944 {
4945     dTHR;
4946     OP *prev = ((cUNOPo->op_first->op_sibling)
4947              ? cUNOPo : ((UNOP*)cUNOPo->op_first))->op_first;
4948     OP *o2 = prev->op_sibling;
4949     OP *cvop;
4950     char *proto = 0;
4951     CV *cv = 0;
4952     GV *namegv = 0;
4953     int optional = 0;
4954     I32 arg = 0;
4955
4956     for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
4957     if (cvop->op_type == OP_RV2CV) {
4958         SVOP* tmpop;
4959         o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
4960         null(cvop);             /* disable rv2cv */
4961         tmpop = (SVOP*)((UNOP*)cvop)->op_first;
4962         if (tmpop->op_type == OP_GV) {
4963             cv = GvCVu(tmpop->op_sv);
4964             if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) {
4965                 namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
4966                 proto = SvPV((SV*)cv, PL_na);
4967             }
4968         }
4969     }
4970     o->op_private |= (PL_hints & HINT_STRICT_REFS);
4971     if (PERLDB_SUB && PL_curstash != PL_debstash)
4972         o->op_private |= OPpENTERSUB_DB;
4973     while (o2 != cvop) {
4974         if (proto) {
4975             switch (*proto) {
4976             case '\0':
4977                 return too_many_arguments(o, gv_ename(namegv));
4978             case ';':
4979                 optional = 1;
4980                 proto++;
4981                 continue;
4982             case '$':
4983                 proto++;
4984                 arg++;
4985                 scalar(o2);
4986                 break;
4987             case '%':
4988             case '@':
4989                 list(o2);
4990                 arg++;
4991                 break;
4992             case '&':
4993                 proto++;
4994                 arg++;
4995                 if (o2->op_type != OP_REFGEN && o2->op_type != OP_UNDEF)
4996                     bad_type(arg, "block", gv_ename(namegv), o2);
4997                 break;
4998             case '*':
4999                 proto++;
5000                 arg++;
5001                 if (o2->op_type == OP_RV2GV)
5002                     goto wrapref;
5003                 {
5004                     OP* kid = o2;
5005                     OP* sib = kid->op_sibling;
5006                     kid->op_sibling = 0;
5007                     o2 = newUNOP(OP_RV2GV, 0, kid);
5008                     o2->op_sibling = sib;
5009                     prev->op_sibling = o2;
5010                 }
5011                 goto wrapref;
5012             case '\\':
5013                 proto++;
5014                 arg++;
5015                 switch (*proto++) {
5016                 case '*':
5017                     if (o2->op_type != OP_RV2GV)
5018                         bad_type(arg, "symbol", gv_ename(namegv), o2);
5019                     goto wrapref;
5020                 case '&':
5021                     if (o2->op_type != OP_RV2CV)
5022                         bad_type(arg, "sub", gv_ename(namegv), o2);
5023                     goto wrapref;
5024                 case '$':
5025                     if (o2->op_type != OP_RV2SV
5026                         && o2->op_type != OP_PADSV
5027                         && o2->op_type != OP_THREADSV)
5028                     {
5029                         bad_type(arg, "scalar", gv_ename(namegv), o2);
5030                     }
5031                     goto wrapref;
5032                 case '@':
5033                     if (o2->op_type != OP_RV2AV && o2->op_type != OP_PADAV)
5034                         bad_type(arg, "array", gv_ename(namegv), o2);
5035                     goto wrapref;
5036                 case '%':
5037                     if (o2->op_type != OP_RV2HV && o2->op_type != OP_PADHV)
5038                         bad_type(arg, "hash", gv_ename(namegv), o2);
5039                   wrapref:
5040                     {
5041                         OP* kid = o2;
5042                         OP* sib = kid->op_sibling;
5043                         kid->op_sibling = 0;
5044                         o2 = newUNOP(OP_REFGEN, 0, kid);
5045                         o2->op_sibling = sib;
5046                         prev->op_sibling = o2;
5047                     }
5048                     break;
5049                 default: goto oops;
5050                 }
5051                 break;
5052             case ' ':
5053                 proto++;
5054                 continue;
5055             default:
5056               oops:
5057                 croak("Malformed prototype for %s: %s",
5058                         gv_ename(namegv), SvPV((SV*)cv, PL_na));
5059             }
5060         }
5061         else
5062             list(o2);
5063         mod(o2, OP_ENTERSUB);
5064         prev = o2;
5065         o2 = o2->op_sibling;
5066     }
5067     if (proto && !optional &&
5068           (*proto && *proto != '@' && *proto != '%' && *proto != ';'))
5069         return too_few_arguments(o, gv_ename(namegv));
5070     return o;
5071 }
5072
5073 OP *
5074 ck_svconst(OP *o)
5075 {
5076     SvREADONLY_on(cSVOPo->op_sv);
5077     return o;
5078 }
5079
5080 OP *
5081 ck_trunc(OP *o)
5082 {
5083     if (o->op_flags & OPf_KIDS) {
5084         SVOP *kid = (SVOP*)cUNOPo->op_first;
5085
5086         if (kid->op_type == OP_NULL)
5087             kid = (SVOP*)kid->op_sibling;
5088         if (kid &&
5089           kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
5090             o->op_flags |= OPf_SPECIAL;
5091     }
5092     return ck_fun(o);
5093 }
5094
5095 /* A peephole optimizer.  We visit the ops in the order they're to execute. */
5096
5097 void
5098 peep(register OP *o)
5099 {
5100     dTHR;
5101     register OP* oldop = 0;
5102     if (!o || o->op_seq)
5103         return;
5104     ENTER;
5105     SAVEOP();
5106     SAVESPTR(PL_curcop);
5107     for (; o; o = o->op_next) {
5108         if (o->op_seq)
5109             break;
5110         if (!PL_op_seqmax)
5111             PL_op_seqmax++;
5112         PL_op = o;
5113         switch (o->op_type) {
5114         case OP_NEXTSTATE:
5115         case OP_DBSTATE:
5116             PL_curcop = ((COP*)o);              /* for warnings */
5117             o->op_seq = PL_op_seqmax++;
5118             break;
5119
5120         case OP_CONCAT:
5121         case OP_CONST:
5122         case OP_JOIN:
5123         case OP_UC:
5124         case OP_UCFIRST:
5125         case OP_LC:
5126         case OP_LCFIRST:
5127         case OP_QUOTEMETA:
5128             if (o->op_next && o->op_next->op_type == OP_STRINGIFY)
5129                 null(o->op_next);
5130             o->op_seq = PL_op_seqmax++;
5131             break;
5132         case OP_STUB:
5133             if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
5134                 o->op_seq = PL_op_seqmax++;
5135                 break; /* Scalar stub must produce undef.  List stub is noop */
5136             }
5137             goto nothin;
5138         case OP_NULL:
5139             if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
5140                 PL_curcop = ((COP*)o);
5141             goto nothin;
5142         case OP_SCALAR:
5143         case OP_LINESEQ:
5144         case OP_SCOPE:
5145           nothin:
5146             if (oldop && o->op_next) {
5147                 oldop->op_next = o->op_next;
5148                 continue;
5149             }
5150             o->op_seq = PL_op_seqmax++;
5151             break;
5152
5153         case OP_GV:
5154             if (o->op_next->op_type == OP_RV2SV) {
5155                 if (!(o->op_next->op_private & OPpDEREF)) {
5156                     null(o->op_next);
5157                     o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
5158                     o->op_next = o->op_next->op_next;
5159                     o->op_type = OP_GVSV;
5160                     o->op_ppaddr = ppaddr[OP_GVSV];
5161                 }
5162             }
5163             else if (o->op_next->op_type == OP_RV2AV) {
5164                 OP* pop = o->op_next->op_next;
5165                 IV i;
5166                 if (pop->op_type == OP_CONST &&
5167                     (PL_op = pop->op_next) &&
5168                     pop->op_next->op_type == OP_AELEM &&
5169                     !(pop->op_next->op_private &
5170                       (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF)) &&
5171                     (i = SvIV(((SVOP*)pop)->op_sv) - PL_compiling.cop_arybase)
5172                                 <= 255 &&
5173                     i >= 0)
5174                 {
5175                     SvREFCNT_dec(((SVOP*)pop)->op_sv);
5176                     null(o->op_next);
5177                     null(pop->op_next);
5178                     null(pop);
5179                     o->op_flags |= pop->op_next->op_flags & OPf_MOD;
5180                     o->op_next = pop->op_next->op_next;
5181                     o->op_type = OP_AELEMFAST;
5182                     o->op_ppaddr = ppaddr[OP_AELEMFAST];
5183                     o->op_private = (U8)i;
5184                     GvAVn(((GVOP*)o)->op_gv);
5185                 }
5186             }
5187             o->op_seq = PL_op_seqmax++;
5188             break;
5189
5190         case OP_PADAV:
5191             if (o->op_next->op_type == OP_RV2AV
5192                 && (o->op_next->op_flags & OPf_REF))
5193             {
5194                 null(o->op_next);
5195                 o->op_next = o->op_next->op_next;
5196             }
5197             break;
5198
5199         case OP_PADHV:
5200             if (o->op_next->op_type == OP_RV2HV
5201                 && (o->op_next->op_flags & OPf_REF))
5202             {
5203                 null(o->op_next);
5204                 o->op_next = o->op_next->op_next;
5205             }
5206             break;
5207
5208         case OP_MAPWHILE:
5209         case OP_GREPWHILE:
5210         case OP_AND:
5211         case OP_OR:
5212             o->op_seq = PL_op_seqmax++;
5213             while (cLOGOP->op_other->op_type == OP_NULL)
5214                 cLOGOP->op_other = cLOGOP->op_other->op_next;
5215             peep(cLOGOP->op_other);
5216             break;
5217
5218         case OP_COND_EXPR:
5219             o->op_seq = PL_op_seqmax++;
5220             peep(cCONDOP->op_true);
5221             peep(cCONDOP->op_false);
5222             break;
5223
5224         case OP_ENTERLOOP:
5225             o->op_seq = PL_op_seqmax++;
5226             peep(cLOOP->op_redoop);
5227             peep(cLOOP->op_nextop);
5228             peep(cLOOP->op_lastop);
5229             break;
5230
5231         case OP_QR:
5232         case OP_MATCH:
5233         case OP_SUBST:
5234             o->op_seq = PL_op_seqmax++;
5235             peep(cPMOP->op_pmreplstart);
5236             break;
5237
5238         case OP_EXEC:
5239             o->op_seq = PL_op_seqmax++;
5240             if (PL_dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
5241                 if (o->op_next->op_sibling &&
5242                         o->op_next->op_sibling->op_type != OP_EXIT &&
5243                         o->op_next->op_sibling->op_type != OP_WARN &&
5244                         o->op_next->op_sibling->op_type != OP_DIE) {
5245                     line_t oldline = PL_curcop->cop_line;
5246
5247                     PL_curcop->cop_line = ((COP*)o->op_next)->cop_line;
5248                     warn("Statement unlikely to be reached");
5249                     warn("(Maybe you meant system() when you said exec()?)\n");
5250                     PL_curcop->cop_line = oldline;
5251                 }
5252             }
5253             break;
5254
5255         case OP_HELEM: {
5256             UNOP *rop;
5257             SV *lexname;
5258             GV **fields;
5259             SV **svp, **indsvp;
5260             I32 ind;
5261             char *key;
5262             STRLEN keylen;
5263
5264             if (o->op_private & (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)
5265                 || ((BINOP*)o)->op_last->op_type != OP_CONST)
5266                 break;
5267             rop = (UNOP*)((BINOP*)o)->op_first;
5268             if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV)
5269                 break;
5270             lexname = *av_fetch(PL_comppad_name, rop->op_first->op_targ, TRUE);
5271             if (!SvOBJECT(lexname))
5272                 break;
5273             fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
5274             if (!fields || !GvHV(*fields))
5275                 break;
5276             svp = &((SVOP*)((BINOP*)o)->op_last)->op_sv;
5277             key = SvPV(*svp, keylen);
5278             indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
5279             if (!indsvp) {
5280                 croak("No such field \"%s\" in variable %s of type %s",
5281                       key, SvPV(lexname, PL_na), HvNAME(SvSTASH(lexname)));
5282             }
5283             ind = SvIV(*indsvp);
5284             if (ind < 1)
5285                 croak("Bad index while coercing array into hash");
5286             rop->op_type = OP_RV2AV;
5287             rop->op_ppaddr = ppaddr[OP_RV2AV];
5288             o->op_type = OP_AELEM;
5289             o->op_ppaddr = ppaddr[OP_AELEM];
5290             SvREFCNT_dec(*svp);
5291             *svp = newSViv(ind);
5292             break;
5293         }
5294
5295         default:
5296             o->op_seq = PL_op_seqmax++;
5297             break;
5298         }
5299         oldop = o;
5300     }
5301     LEAVE;
5302 }