op.c

   1 /*    op.c
   2  *
   3  *    Copyright (c) 1991-1994, 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 #define USE_OP_MASK  /* Turned on by default in 5.002beta1h */
  22
  23 #ifdef USE_OP_MASK
  24 /*
  25  * In the following definition, the ", (OP *) op" is just to make the compiler
  26  * think the expression is of the right type: croak actually does a Siglongjmp.
  27  */
  28 #define CHECKOP(type,o) \
  29     ((op_mask && op_mask[type]) \
  30      ? (croak("%s trapped by operation mask", op_desc[type]), (OP*)o) \
  31      : (*check[type])((OP*)o))
  32 #else
  33 #define CHECKOP(type,o) (*check[type])(o)
  34 #endif /* USE_OP_MASK */
  35
  36 static I32 list_assignment _((OP *o));
  37 static void bad_type _((I32 n, char *t, char *name, OP *kid));
  38 static OP *modkids _((OP *o, I32 type));
  39 static OP *no_fh_allowed _((OP *o));
  40 static OP *scalarboolean _((OP *o));
  41 static OP *too_few_arguments _((OP *o, char* name));
  42 static OP *too_many_arguments _((OP *o, char* name));
  43 static void null _((OP* o));
  44 static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, I32 seq,
  45         CV* startcv, I32 cx_ix));
  46
  47 static char*
  48 CvNAME(cv)
  49 CV* cv;
  50 {
  51     SV* tmpsv = sv_newmortal();
  52     gv_efullname(tmpsv, CvGV(cv));
  53     return SvPV(tmpsv,na);
  54 }
  55
  56 static OP *
  57 no_fh_allowed(o)
  58 OP *o;
  59 {
  60     sprintf(tokenbuf,"Missing comma after first argument to %s function",
  61         op_desc[o->op_type]);
  62     yyerror(tokenbuf);
  63     return o;
  64 }
  65
  66 static OP *
  67 too_few_arguments(o, name)
  68 OP* o;
  69 char* name;
  70 {
  71     sprintf(tokenbuf,"Not enough arguments for %s", name);
  72     yyerror(tokenbuf);
  73     return o;
  74 }
  75
  76 static OP *
  77 too_many_arguments(o, name)
  78 OP *o;
  79 char* name;
  80 {
  81     sprintf(tokenbuf,"Too many arguments for %s", name);
  82     yyerror(tokenbuf);
  83     return o;
  84 }
  85
  86 static void
  87 bad_type(n, t, name, kid)
  88 I32 n;
  89 char *t;
  90 char *name;
  91 OP *kid;
  92 {
  93     sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)",
  94         (int) n, name, t, op_desc[kid->op_type]);
  95     yyerror(tokenbuf);
  96 }
  97
  98 void
  99 assertref(o)
 100 OP *o;
 101 {
 102     int type = o->op_type;
 103     if (type != OP_AELEM && type != OP_HELEM) {
 104         sprintf(tokenbuf, "Can't use subscript on %s", op_desc[type]);
 105         yyerror(tokenbuf);
 106         if (type == OP_RV2HV || type == OP_ENTERSUB)
 107             warn("(Did you mean $ or @ instead of %c?)\n",
 108                 type == OP_RV2HV ? '%' : '&');
 109     }
 110 }
 111
 112 /* "register" allocation */
 113
 114 PADOFFSET
 115 pad_allocmy(name)
 116 char *name;
 117 {
 118     dTHR;
 119     PADOFFSET off;
 120     SV *sv;
 121
 122     if (!(isALPHA(name[1]) || name[1] == '_' && (int)strlen(name) > 2)) {
 123         if (!isprint(name[1]))
 124             sprintf(name+1, "^%c", name[1] ^ 64); /* XXX is tokenbuf, really */
 125         croak("Can't use global %s in \"my\"",name);
 126     }
 127     off = pad_alloc(OP_PADSV, SVs_PADMY);
 128     sv = NEWSV(1102,0);
 129     sv_upgrade(sv, SVt_PVNV);
 130     sv_setpv(sv, name);
 131     av_store(comppad_name, off, sv);
 132     SvNVX(sv) = (double)999999999;
 133     SvIVX(sv) = 0;                      /* Not yet introduced--see newSTATEOP */
 134     if (!min_intro_pending)
 135         min_intro_pending = off;
 136     max_intro_pending = off;
 137     if (*name == '@')
 138         av_store(comppad, off, (SV*)newAV());
 139     else if (*name == '%')
 140         av_store(comppad, off, (SV*)newHV());
 141     SvPADMY_on(curpad[off]);
 142     return off;
 143 }
 144
 145 static PADOFFSET
 146 #ifndef CAN_PROTOTYPE
 147 pad_findlex(name, newoff, seq, startcv, cx_ix)
 148 char *name;
 149 PADOFFSET newoff;
 150 I32 seq;
 151 CV* startcv;
 152 I32 cx_ix;
 153 #else
 154 pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix)
 155 #endif
 156 {
 157     dTHR;
 158     CV *cv;
 159     I32 off;
 160     SV *sv;
 161     register I32 i;
 162     register CONTEXT *cx;
 163     int saweval;
 164
 165     for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
 166         AV* curlist = CvPADLIST(cv);
 167         SV** svp = av_fetch(curlist, 0, FALSE);
 168         AV *curname;
 169         if (!svp || *svp == &sv_undef)
 170             continue;
 171         curname = (AV*)*svp;
 172         svp = AvARRAY(curname);
 173         for (off = AvFILL(curname); off > 0; off--) {
 174             if ((sv = svp[off]) &&
 175                 sv != &sv_undef &&
 176                 seq <= SvIVX(sv) &&
 177                 seq > (I32)SvNVX(sv) &&
 178                 strEQ(SvPVX(sv), name))
 179             {
 180                 I32 depth = CvDEPTH(cv) ? CvDEPTH(cv) : 1;
 181                 AV *oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
 182                 SV *oldsv = *av_fetch(oldpad, off, TRUE);
 183                 if (!newoff) {          /* Not a mere clone operation. */
 184                     SV *sv = NEWSV(1103,0);
 185                     newoff = pad_alloc(OP_PADSV, SVs_PADMY);
 186                     sv_upgrade(sv, SVt_PVNV);
 187                     sv_setpv(sv, name);
 188                     av_store(comppad_name, newoff, sv);
 189                     SvNVX(sv) = (double)curcop->cop_seq;
 190                     SvIVX(sv) = 999999999;      /* A ref, intro immediately */
 191                     SvFLAGS(sv) |= SVf_FAKE;
 192                 }
 193                 av_store(comppad, newoff, SvREFCNT_inc(oldsv));
 194                 CvCLONE_on(compcv);
 195                 return newoff;
 196             }
 197         }
 198     }
 199
 200     /* Nothing in current lexical context--try eval's context, if any.
 201      * This is necessary to let the perldb get at lexically scoped variables.
 202      * XXX This will also probably interact badly with eval tree caching.
 203      */
 204
 205     saweval = 0;
 206     for (i = cx_ix; i >= 0; i--) {
 207         cx = &cxstack[i];
 208         switch (cx->cx_type) {
 209         default:
 210             if (i == 0 && saweval) {
 211                 seq = cxstack[saweval].blk_oldcop->cop_seq;
 212                 return pad_findlex(name, newoff, seq, main_cv, 0);
 213             }
 214             break;
 215         case CXt_EVAL:
 216             if (cx->blk_eval.old_op_type != OP_ENTEREVAL &&
 217                 cx->blk_eval.old_op_type != OP_ENTERTRY)
 218                 return 0;       /* require must have its own scope */
 219             saweval = i;
 220             break;
 221         case CXt_SUB:
 222             if (!saweval)
 223                 return 0;
 224             cv = cx->blk_sub.cv;
 225             if (debstash && CvSTASH(cv) == debstash) {  /* ignore DB'* scope */
 226                 saweval = i;    /* so we know where we were called from */
 227                 continue;
 228             }
 229             seq = cxstack[saweval].blk_oldcop->cop_seq;
 230             return pad_findlex(name, newoff, seq, cv, i-1);
 231         }
 232     }
 233
 234     return 0;
 235 }
 236
 237 PADOFFSET
 238 pad_findmy(name)
 239 char *name;
 240 {
 241     dTHR;
 242     I32 off;
 243     SV *sv;
 244     SV **svp = AvARRAY(comppad_name);
 245     I32 seq = cop_seqmax;
 246
 247 #ifdef USE_THREADS
 248     /*
 249      * Special case to get lexical (and hence per-thread) @_.
 250      * XXX I need to find out how to tell at parse-time whether use
 251      * of @_ should refer to a lexical (from a sub) or defgv (global
 252      * scope and maybe weird sub-ish things like formats). See
 253      * startsub in perly.y.  It's possible that @_ could be lexical
 254      * (at least from subs) even in non-threaded perl.
 255      */
 256     if (strEQ(name, "@_"))
 257         return 0;               /* success. (NOT_IN_PAD indicates failure) */
 258 #endif /* USE_THREADS */
 259
 260     /* The one we're looking for is probably just before comppad_name_fill. */
 261     for (off = AvFILL(comppad_name); off > 0; off--) {
 262         if ((sv = svp[off]) &&
 263             sv != &sv_undef &&
 264             seq <= SvIVX(sv) &&
 265             seq > (I32)SvNVX(sv) &&
 266             strEQ(SvPVX(sv), name))
 267         {
 268             return (PADOFFSET)off;
 269         }
 270     }
 271
 272     /* See if it's in a nested scope */
 273     off = pad_findlex(name, 0, seq, CvOUTSIDE(compcv), cxstack_ix);
 274     if (off)
 275         return off;             /* pad_findlex returns 0 for failure...*/
 276
 277     return NOT_IN_PAD;          /* ...but we return NOT_IN_PAD for failure */
 278 }
 279
 280 void
 281 pad_leavemy(fill)
 282 I32 fill;
 283 {
 284     I32 off;
 285     SV **svp = AvARRAY(comppad_name);
 286     SV *sv;
 287     if (min_intro_pending && fill < min_intro_pending) {
 288         for (off = max_intro_pending; off >= min_intro_pending; off--) {
 289             if ((sv = svp[off]) && sv != &sv_undef)
 290                 warn("%s never introduced", SvPVX(sv));
 291         }
 292     }
 293     /* "Deintroduce" my variables that are leaving with this scope. */
 294     for (off = AvFILL(comppad_name); off > fill; off--) {
 295         if ((sv = svp[off]) && sv != &sv_undef && SvIVX(sv) == 999999999)
 296             SvIVX(sv) = cop_seqmax;
 297     }
 298 }
 299
 300 PADOFFSET
 301 pad_alloc(optype,tmptype)
 302 I32 optype;
 303 U32 tmptype;
 304 {
 305     dTHR;
 306     SV *sv;
 307     I32 retval;
 308
 309     if (AvARRAY(comppad) != curpad)
 310         croak("panic: pad_alloc");
 311     if (pad_reset_pending)
 312         pad_reset();
 313     if (tmptype & SVs_PADMY) {
 314         do {
 315             sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE);
 316         } while (SvPADBUSY(sv));                /* need a fresh one */
 317         retval = AvFILL(comppad);
 318     }
 319     else {
 320         do {
 321             sv = *av_fetch(comppad, ++padix, TRUE);
 322         } while (SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY));
 323         retval = padix;
 324     }
 325     SvFLAGS(sv) |= tmptype;
 326     curpad = AvARRAY(comppad);
 327 #ifdef USE_THREADS
 328     DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx alloc %ld for %s\n",
 329                     (unsigned long) thr, (unsigned long) curpad,
 330                     (long) retval, op_name[optype]));
 331 #else
 332     DEBUG_X(fprintf(stderr, "Pad alloc %ld for %s\n", (long) retval, op_name[optype]));
 333 #endif /* USE_THREADS */
 334     return (PADOFFSET)retval;
 335 }
 336
 337 SV *
 338 #ifndef CAN_PROTOTYPE
 339 pad_sv(po)
 340 PADOFFSET po;
 341 #else
 342 pad_sv(PADOFFSET po)
 343 #endif /* CAN_PROTOTYPE */
 344 {
 345     dTHR;
 346 #ifdef USE_THREADS
 347     DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx sv %d\n",
 348                     (unsigned long) thr, (unsigned long) curpad, po));
 349 #else
 350     if (!po)
 351         croak("panic: pad_sv po");
 352     DEBUG_X(fprintf(stderr, "Pad sv %d\n", po));
 353 #endif /* USE_THREADS */
 354     return curpad[po];          /* eventually we'll turn this into a macro */
 355 }
 356
 357 void
 358 #ifndef CAN_PROTOTYPE
 359 pad_free(po)
 360 PADOFFSET po;
 361 #else
 362 pad_free(PADOFFSET po)
 363 #endif /* CAN_PROTOTYPE */
 364 {
 365     dTHR;
 366     if (!curpad)
 367         return;
 368     if (AvARRAY(comppad) != curpad)
 369         croak("panic: pad_free curpad");
 370     if (!po)
 371         croak("panic: pad_free po");
 372 #ifdef USE_THREADS
 373     DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx free %d\n",
 374                     (unsigned long) thr, (unsigned long) curpad, po));
 375 #else
 376     DEBUG_X(fprintf(stderr, "Pad free %d\n", po));
 377 #endif /* USE_THREADS */
 378     if (curpad[po] && curpad[po] != &sv_undef)
 379         SvPADTMP_off(curpad[po]);
 380     if ((I32)po < padix)
 381         padix = po - 1;
 382 }
 383
 384 void
 385 #ifndef CAN_PROTOTYPE
 386 pad_swipe(po)
 387 PADOFFSET po;
 388 #else
 389 pad_swipe(PADOFFSET po)
 390 #endif /* CAN_PROTOTYPE */
 391 {
 392     dTHR;
 393     if (AvARRAY(comppad) != curpad)
 394         croak("panic: pad_swipe curpad");
 395     if (!po)
 396         croak("panic: pad_swipe po");
 397 #ifdef USE_THREADS
 398     DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx swipe %d\n",
 399                     (unsigned long) thr, (unsigned long) curpad, po));
 400 #else
 401     DEBUG_X(fprintf(stderr, "Pad swipe %d\n", po));
 402 #endif /* USE_THREADS */
 403     SvPADTMP_off(curpad[po]);
 404     curpad[po] = NEWSV(1107,0);
 405     SvPADTMP_on(curpad[po]);
 406     if ((I32)po < padix)
 407         padix = po - 1;
 408 }
 409
 410 void
 411 pad_reset()
 412 {
 413     dTHR;
 414     register I32 po;
 415
 416     if (AvARRAY(comppad) != curpad)
 417         croak("panic: pad_reset curpad");
 418 #ifdef USE_THREADS
 419     DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx reset\n",
 420                     (unsigned long) thr, (unsigned long) curpad));
 421 #else
 422     DEBUG_X(fprintf(stderr, "Pad reset\n"));
 423 #endif /* USE_THREADS */
 424     if (!tainting) {    /* Can't mix tainted and non-tainted temporaries. */
 425         for (po = AvMAX(comppad); po > padix_floor; po--) {
 426             if (curpad[po] && curpad[po] != &sv_undef)
 427                 SvPADTMP_off(curpad[po]);
 428         }
 429         padix = padix_floor;
 430     }
 431     pad_reset_pending = FALSE;
 432 }
 433
 434 /* Destructor */
 435
 436 void
 437 op_free(o)
 438 OP *o;
 439 {
 440     register OP *kid, *nextkid;
 441
 442     if (!o)
 443         return;
 444
 445     if (o->op_flags & OPf_KIDS) {
 446         for (kid = cUNOPo->op_first; kid; kid = nextkid) {
 447             nextkid = kid->op_sibling; /* Get before next freeing kid */
 448             op_free(kid);
 449         }
 450     }
 451
 452     switch (o->op_type) {
 453     case OP_NULL:
 454         o->op_targ = 0; /* Was holding old type, if any. */
 455         break;
 456     case OP_ENTEREVAL:
 457         o->op_targ = 0; /* Was holding hints. */
 458         break;
 459     case OP_GVSV:
 460     case OP_GV:
 461         SvREFCNT_dec(cGVOPo->op_gv);
 462         break;
 463     case OP_NEXTSTATE:
 464     case OP_DBSTATE:
 465         SvREFCNT_dec(cCOPo->cop_filegv);
 466         break;
 467     case OP_CONST:
 468         SvREFCNT_dec(cSVOPo->op_sv);
 469         break;
 470     case OP_GOTO:
 471     case OP_NEXT:
 472     case OP_LAST:
 473     case OP_REDO:
 474         if (o->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
 475             break;
 476         /* FALL THROUGH */
 477     case OP_TRANS:
 478         Safefree(cPVOPo->op_pv);
 479         break;
 480     case OP_SUBST:
 481         op_free(cPMOPo->op_pmreplroot);
 482         /* FALL THROUGH */
 483     case OP_PUSHRE:
 484     case OP_MATCH:
 485         pregfree(cPMOPo->op_pmregexp);
 486         SvREFCNT_dec(cPMOPo->op_pmshort);
 487         break;
 488     default:
 489         break;
 490     }
 491
 492     if (o->op_targ > 0)
 493         pad_free(o->op_targ);
 494
 495     Safefree(o);
 496 }
 497
 498 static void
 499 null(o)
 500 OP* o;
 501 {
 502     if (o->op_type != OP_NULL && o->op_targ > 0)
 503         pad_free(o->op_targ);
 504     o->op_targ = o->op_type;
 505     o->op_type = OP_NULL;
 506     o->op_ppaddr = ppaddr[OP_NULL];
 507 }
 508
 509 /* Contextualizers */
 510
 511 #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
 512
 513 OP *
 514 linklist(o)
 515 OP *o;
 516 {
 517     register OP *kid;
 518
 519     if (o->op_next)
 520         return o->op_next;
 521
 522     /* establish postfix order */
 523     if (cUNOPo->op_first) {
 524         o->op_next = LINKLIST(cUNOPo->op_first);
 525         for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
 526             if (kid->op_sibling)
 527                 kid->op_next = LINKLIST(kid->op_sibling);
 528             else
 529                 kid->op_next = o;
 530         }
 531     }
 532     else
 533         o->op_next = o;
 534
 535     return o->op_next;
 536 }
 537
 538 OP *
 539 scalarkids(o)
 540 OP *o;
 541 {
 542     OP *kid;
 543     if (o && o->op_flags & OPf_KIDS) {
 544         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
 545             scalar(kid);
 546     }
 547     return o;
 548 }
 549
 550 static OP *
 551 scalarboolean(o)
 552 OP *o;
 553 {
 554     if (dowarn &&
 555         o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
 556         line_t oldline = curcop->cop_line;
 557
 558         if (copline != NOLINE)
 559             curcop->cop_line = copline;
 560         warn("Found = in conditional, should be ==");
 561         curcop->cop_line = oldline;
 562     }
 563     return scalar(o);
 564 }
 565
 566 OP *
 567 scalar(o)
 568 OP *o;
 569 {
 570     OP *kid;
 571
 572     /* assumes no premature commitment */
 573     if (!o || (o->op_flags & OPf_KNOW) || error_count)
 574         return o;
 575
 576     o->op_flags &= ~OPf_LIST;
 577     o->op_flags |= OPf_KNOW;
 578
 579     switch (o->op_type) {
 580     case OP_REPEAT:
 581         if (o->op_private & OPpREPEAT_DOLIST)
 582             null(((LISTOP*)cBINOPo->op_first)->op_first);
 583         scalar(cBINOPo->op_first);
 584         break;
 585     case OP_OR:
 586     case OP_AND:
 587     case OP_COND_EXPR:
 588         for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
 589             scalar(kid);
 590         break;
 591     case OP_SPLIT:
 592         if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
 593             if (!kPMOP->op_pmreplroot)
 594                 deprecate("implicit split to @_");
 595         }
 596         /* FALL THROUGH */
 597     case OP_MATCH:
 598     case OP_SUBST:
 599     case OP_NULL:
 600     default:
 601         if (o->op_flags & OPf_KIDS) {
 602             for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
 603                 scalar(kid);
 604         }
 605         break;
 606     case OP_LEAVE:
 607     case OP_LEAVETRY:
 608         scalar(cLISTOPo->op_first);
 609         /* FALL THROUGH */
 610     case OP_SCOPE:
 611     case OP_LINESEQ:
 612     case OP_LIST:
 613         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
 614             if (kid->op_sibling)
 615                 scalarvoid(kid);
 616             else
 617                 scalar(kid);
 618         }
 619         curcop = &compiling;
 620         break;
 621     }
 622     return o;
 623 }
 624
 625 OP *
 626 scalarvoid(o)
 627 OP *o;
 628 {
 629     OP *kid;
 630     char* useless = 0;
 631     SV* sv;
 632
 633     if (!o || error_count)
 634         return o;
 635     if (o->op_flags & OPf_LIST)
 636         return o;
 637
 638     o->op_flags |= OPf_KNOW;
 639
 640     switch (o->op_type) {
 641     default:
 642         if (!(opargs[o->op_type] & OA_FOLDCONST))
 643             break;
 644         if (o->op_flags & OPf_STACKED)
 645             break;
 646         /* FALL THROUGH */
 647     case OP_GVSV:
 648     case OP_WANTARRAY:
 649     case OP_GV:
 650     case OP_PADSV:
 651     case OP_PADAV:
 652     case OP_PADHV:
 653     case OP_PADANY:
 654     case OP_AV2ARYLEN:
 655     case OP_REF:
 656     case OP_REFGEN:
 657     case OP_SREFGEN:
 658     case OP_DEFINED:
 659     case OP_HEX:
 660     case OP_OCT:
 661     case OP_LENGTH:
 662     case OP_SUBSTR:
 663     case OP_VEC:
 664     case OP_INDEX:
 665     case OP_RINDEX:
 666     case OP_SPRINTF:
 667     case OP_AELEM:
 668     case OP_AELEMFAST:
 669     case OP_ASLICE:
 670     case OP_VALUES:
 671     case OP_KEYS:
 672     case OP_HELEM:
 673     case OP_HSLICE:
 674     case OP_UNPACK:
 675     case OP_PACK:
 676     case OP_JOIN:
 677     case OP_LSLICE:
 678     case OP_ANONLIST:
 679     case OP_ANONHASH:
 680     case OP_SORT:
 681     case OP_REVERSE:
 682     case OP_RANGE:
 683     case OP_FLIP:
 684     case OP_FLOP:
 685     case OP_CALLER:
 686     case OP_FILENO:
 687     case OP_EOF:
 688     case OP_TELL:
 689     case OP_GETSOCKNAME:
 690     case OP_GETPEERNAME:
 691     case OP_READLINK:
 692     case OP_TELLDIR:
 693     case OP_GETPPID:
 694     case OP_GETPGRP:
 695     case OP_GETPRIORITY:
 696     case OP_TIME:
 697     case OP_TMS:
 698     case OP_LOCALTIME:
 699     case OP_GMTIME:
 700     case OP_GHBYNAME:
 701     case OP_GHBYADDR:
 702     case OP_GHOSTENT:
 703     case OP_GNBYNAME:
 704     case OP_GNBYADDR:
 705     case OP_GNETENT:
 706     case OP_GPBYNAME:
 707     case OP_GPBYNUMBER:
 708     case OP_GPROTOENT:
 709     case OP_GSBYNAME:
 710     case OP_GSBYPORT:
 711     case OP_GSERVENT:
 712     case OP_GPWNAM:
 713     case OP_GPWUID:
 714     case OP_GGRNAM:
 715     case OP_GGRGID:
 716     case OP_GETLOGIN:
 717         if (!(o->op_private & OPpLVAL_INTRO))
 718             useless = op_desc[o->op_type];
 719         break;
 720
 721     case OP_RV2GV:
 722     case OP_RV2SV:
 723     case OP_RV2AV:
 724     case OP_RV2HV:
 725         if (!(o->op_private & OPpLVAL_INTRO) &&
 726                 (!o->op_sibling || o->op_sibling->op_type != OP_READLINE))
 727             useless = "a variable";
 728         break;
 729
 730     case OP_NEXTSTATE:
 731     case OP_DBSTATE:
 732         curcop = ((COP*)o);             /* for warning below */
 733         break;
 734
 735     case OP_CONST:
 736         sv = cSVOPo->op_sv;
 737         if (dowarn) {
 738             useless = "a constant";
 739             if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
 740                 useless = 0;
 741             else if (SvPOK(sv)) {
 742                 if (strnEQ(SvPVX(sv), "di", 2) ||
 743                     strnEQ(SvPVX(sv), "ds", 2) ||
 744                     strnEQ(SvPVX(sv), "ig", 2))
 745                         useless = 0;
 746             }
 747         }
 748         null(o);                /* don't execute a constant */
 749         SvREFCNT_dec(sv);       /* don't even remember it */
 750         break;
 751
 752     case OP_POSTINC:
 753         o->op_type = OP_PREINC;         /* pre-increment is faster */
 754         o->op_ppaddr = ppaddr[OP_PREINC];
 755         break;
 756
 757     case OP_POSTDEC:
 758         o->op_type = OP_PREDEC;         /* pre-decrement is faster */
 759         o->op_ppaddr = ppaddr[OP_PREDEC];
 760         break;
 761
 762     case OP_REPEAT:
 763         scalarvoid(cBINOPo->op_first);
 764         useless = op_desc[o->op_type];
 765         break;
 766
 767     case OP_OR:
 768     case OP_AND:
 769     case OP_COND_EXPR:
 770         for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
 771             scalarvoid(kid);
 772         break;
 773     case OP_NULL:
 774         if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
 775             curcop = ((COP*)o);         /* for warning below */
 776         if (o->op_flags & OPf_STACKED)
 777             break;
 778     case OP_ENTERTRY:
 779     case OP_ENTER:
 780     case OP_SCALAR:
 781         if (!(o->op_flags & OPf_KIDS))
 782             break;
 783     case OP_SCOPE:
 784     case OP_LEAVE:
 785     case OP_LEAVETRY:
 786     case OP_LEAVELOOP:
 787         o->op_private |= OPpLEAVE_VOID;
 788     case OP_LINESEQ:
 789     case OP_LIST:
 790         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
 791             scalarvoid(kid);
 792         break;
 793     case OP_SPLIT:
 794         if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
 795             if (!kPMOP->op_pmreplroot)
 796                 deprecate("implicit split to @_");
 797         }
 798         break;
 799     case OP_DELETE:
 800         o->op_private |= OPpLEAVE_VOID;
 801         break;
 802     }
 803     if (useless && dowarn)
 804         warn("Useless use of %s in void context", useless);
 805     return o;
 806 }
 807
 808 OP *
 809 listkids(o)
 810 OP *o;
 811 {
 812     OP *kid;
 813     if (o && o->op_flags & OPf_KIDS) {
 814         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
 815             list(kid);
 816     }
 817     return o;
 818 }
 819
 820 OP *
 821 list(o)
 822 OP *o;
 823 {
 824     OP *kid;
 825
 826     /* assumes no premature commitment */
 827     if (!o || (o->op_flags & OPf_KNOW) || error_count)
 828         return o;
 829
 830     o->op_flags |= (OPf_KNOW | OPf_LIST);
 831
 832     switch (o->op_type) {
 833     case OP_FLOP:
 834     case OP_REPEAT:
 835         list(cBINOPo->op_first);
 836         break;
 837     case OP_OR:
 838     case OP_AND:
 839     case OP_COND_EXPR:
 840         for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
 841             list(kid);
 842         break;
 843     default:
 844     case OP_MATCH:
 845     case OP_SUBST:
 846     case OP_NULL:
 847         if (!(o->op_flags & OPf_KIDS))
 848             break;
 849         if (!o->op_next && cUNOPo->op_first->op_type == OP_FLOP) {
 850             list(cBINOPo->op_first);
 851             return gen_constant_list(o);
 852         }
 853     case OP_LIST:
 854         listkids(o);
 855         break;
 856     case OP_LEAVE:
 857     case OP_LEAVETRY:
 858         list(cLISTOPo->op_first);
 859         /* FALL THROUGH */
 860     case OP_SCOPE:
 861     case OP_LINESEQ:
 862         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
 863             if (kid->op_sibling)
 864                 scalarvoid(kid);
 865             else
 866                 list(kid);
 867         }
 868         curcop = &compiling;
 869         break;
 870     }
 871     return o;
 872 }
 873
 874 OP *
 875 scalarseq(o)
 876 OP *o;
 877 {
 878     OP *kid;
 879
 880     if (o) {
 881         if (o->op_type == OP_LINESEQ ||
 882              o->op_type == OP_SCOPE ||
 883              o->op_type == OP_LEAVE ||
 884              o->op_type == OP_LEAVETRY)
 885         {
 886             for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
 887                 if (kid->op_sibling) {
 888                     scalarvoid(kid);
 889                 }
 890             }
 891             curcop = &compiling;
 892         }
 893         o->op_flags &= ~OPf_PARENS;
 894         if (hints & HINT_BLOCK_SCOPE)
 895             o->op_flags |= OPf_PARENS;
 896     }
 897     else
 898         o = newOP(OP_STUB, 0);
 899     return o;
 900 }
 901
 902 static OP *
 903 modkids(o, type)
 904 OP *o;
 905 I32 type;
 906 {
 907     OP *kid;
 908     if (o && o->op_flags & OPf_KIDS) {
 909         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
 910             mod(kid, type);
 911     }
 912     return o;
 913 }
 914
 915 static I32 modcount;
 916
 917 OP *
 918 mod(o, type)
 919 OP *o;
 920 I32 type;
 921 {
 922     dTHR;
 923     OP *kid;
 924     SV *sv;
 925     char mtype;
 926
 927     if (!o || error_count)
 928         return o;
 929
 930     switch (o->op_type) {
 931     case OP_CONST:
 932         if (!(o->op_private & (OPpCONST_ARYBASE)))
 933             goto nomod;
 934         if (eval_start && eval_start->op_type == OP_CONST) {
 935             compiling.cop_arybase = (I32)SvIV(((SVOP*)eval_start)->op_sv);
 936             eval_start = 0;
 937         }
 938         else if (!type) {
 939             SAVEI32(compiling.cop_arybase);
 940             compiling.cop_arybase = 0;
 941         }
 942         else if (type == OP_REFGEN)
 943             goto nomod;
 944         else
 945             croak("That use of $[ is unsupported");
 946         break;
 947     case OP_ENTERSUB:
 948         if ((type == OP_UNDEF || type == OP_REFGEN) &&
 949             !(o->op_flags & OPf_STACKED)) {
 950             o->op_type = OP_RV2CV;              /* entersub => rv2cv */
 951             o->op_ppaddr = ppaddr[OP_RV2CV];
 952             assert(cUNOPo->op_first->op_type == OP_NULL);
 953             null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
 954             break;
 955         }
 956         /* FALL THROUGH */
 957     default:
 958       nomod:
 959         /* grep, foreach, subcalls, refgen */
 960         if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
 961             break;
 962         sprintf(tokenbuf, "Can't modify %s in %s",
 963             op_desc[o->op_type],
 964             type ? op_desc[type] : "local");
 965         yyerror(tokenbuf);
 966         return o;
 967
 968     case OP_PREINC:
 969     case OP_PREDEC:
 970     case OP_POW:
 971     case OP_MULTIPLY:
 972     case OP_DIVIDE:
 973     case OP_MODULO:
 974     case OP_REPEAT:
 975     case OP_ADD:
 976     case OP_SUBTRACT:
 977     case OP_CONCAT:
 978     case OP_LEFT_SHIFT:
 979     case OP_RIGHT_SHIFT:
 980     case OP_BIT_AND:
 981     case OP_BIT_XOR:
 982     case OP_BIT_OR:
 983     case OP_I_MULTIPLY:
 984     case OP_I_DIVIDE:
 985     case OP_I_MODULO:
 986     case OP_I_ADD:
 987     case OP_I_SUBTRACT:
 988         if (!(o->op_flags & OPf_STACKED))
 989             goto nomod;
 990         modcount++;
 991         break;
 992
 993     case OP_COND_EXPR:
 994         for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
 995             mod(kid, type);
 996         break;
 997
 998     case OP_RV2AV:
 999     case OP_RV2HV:
1000         if (type == OP_REFGEN && o->op_flags & OPf_PARENS) {
1001             modcount = 10000;
1002             return o;           /* Treat \(@foo) like ordinary list. */
1003         }
1004         /* FALL THROUGH */
1005     case OP_RV2GV:
1006         ref(cUNOPo->op_first, o->op_type);
1007         /* FALL THROUGH */
1008     case OP_AASSIGN:
1009     case OP_ASLICE:
1010     case OP_HSLICE:
1011     case OP_NEXTSTATE:
1012     case OP_DBSTATE:
1013     case OP_REFGEN:
1014     case OP_CHOMP:
1015         modcount = 10000;
1016         break;
1017     case OP_RV2SV:
1018         if (!type && cUNOPo->op_first->op_type != OP_GV)
1019             croak("Can't localize a reference");
1020         ref(cUNOPo->op_first, o->op_type);
1021         /* FALL THROUGH */
1022     case OP_UNDEF:
1023     case OP_GV:
1024     case OP_AV2ARYLEN:
1025     case OP_SASSIGN:
1026     case OP_AELEMFAST:
1027         modcount++;
1028         break;
1029
1030     case OP_PADAV:
1031     case OP_PADHV:
1032         modcount = 10000;
1033         /* FALL THROUGH */
1034     case OP_PADSV:
1035         modcount++;
1036         if (!type)
1037             croak("Can't localize lexical variable %s",
1038                 SvPV(*av_fetch(comppad_name, o->op_targ, 4), na));
1039         break;
1040
1041     case OP_PUSHMARK:
1042         break;
1043
1044     case OP_POS:
1045         mtype = '.';
1046         goto makelv;
1047     case OP_VEC:
1048         mtype = 'v';
1049         goto makelv;
1050     case OP_SUBSTR:
1051         mtype = 'x';
1052       makelv:
1053         pad_free(o->op_targ);
1054         o->op_targ = pad_alloc(o->op_type, SVs_PADMY);
1055         sv = PAD_SV(o->op_targ);
1056         sv_upgrade(sv, SVt_PVLV);
1057         sv_magic(sv, Nullsv, mtype, Nullch, 0);
1058         curpad[o->op_targ] = sv;
1059         if (o->op_flags & OPf_KIDS)
1060             mod(cBINOPo->op_first->op_sibling, type);
1061         break;
1062
1063     case OP_AELEM:
1064     case OP_HELEM:
1065         ref(cBINOPo->op_first, o->op_type);
1066         modcount++;
1067         break;
1068
1069     case OP_SCOPE:
1070     case OP_LEAVE:
1071     case OP_ENTER:
1072         if (o->op_flags & OPf_KIDS)
1073             mod(cLISTOPo->op_last, type);
1074         break;
1075
1076     case OP_NULL:
1077         if (!(o->op_flags & OPf_KIDS))
1078             break;
1079         if (o->op_targ != OP_LIST) {
1080             mod(cBINOPo->op_first, type);
1081             break;
1082         }
1083         /* FALL THROUGH */
1084     case OP_LIST:
1085         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
1086             mod(kid, type);
1087         break;
1088     }
1089     o->op_flags |= OPf_MOD;
1090
1091     if (type == OP_AASSIGN || type == OP_SASSIGN)
1092         o->op_flags |= OPf_SPECIAL|OPf_REF;
1093     else if (!type) {
1094         o->op_private |= OPpLVAL_INTRO;
1095         o->op_flags &= ~OPf_SPECIAL;
1096     }
1097     else if (type != OP_GREPSTART && type != OP_ENTERSUB)
1098         o->op_flags |= OPf_REF;
1099     return o;
1100 }
1101
1102 OP *
1103 refkids(o, type)
1104 OP *o;
1105 I32 type;
1106 {
1107     OP *kid;
1108     if (o && o->op_flags & OPf_KIDS) {
1109         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
1110             ref(kid, type);
1111     }
1112     return o;
1113 }
1114
1115 OP *
1116 ref(o, type)
1117 OP *o;
1118 I32 type;
1119 {
1120     OP *kid;
1121
1122     if (!o || error_count)
1123         return o;
1124
1125     switch (o->op_type) {
1126     case OP_ENTERSUB:
1127         if ((type == OP_DEFINED) &&
1128             !(o->op_flags & OPf_STACKED)) {
1129             o->op_type = OP_RV2CV;             /* entersub => rv2cv */
1130             o->op_ppaddr = ppaddr[OP_RV2CV];
1131             assert(cUNOPo->op_first->op_type == OP_NULL);
1132             null(((LISTOP*)cUNOPo->op_first)->op_first);        /* disable pushmark */
1133             o->op_flags |= OPf_SPECIAL;
1134         }
1135         break;
1136
1137     case OP_COND_EXPR:
1138         for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
1139             ref(kid, type);
1140         break;
1141     case OP_RV2SV:
1142         ref(cUNOPo->op_first, o->op_type);
1143         /* FALL THROUGH */
1144     case OP_PADSV:
1145         if (type == OP_RV2AV || type == OP_RV2HV) {
1146             o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV);
1147             o->op_flags |= OPf_MOD;
1148         }
1149         break;
1150
1151     case OP_RV2AV:
1152     case OP_RV2HV:
1153         o->op_flags |= OPf_REF;
1154         /* FALL THROUGH */
1155     case OP_RV2GV:
1156         ref(cUNOPo->op_first, o->op_type);
1157         break;
1158
1159     case OP_PADAV:
1160     case OP_PADHV:
1161         o->op_flags |= OPf_REF;
1162         break;
1163
1164     case OP_SCALAR:
1165     case OP_NULL:
1166         if (!(o->op_flags & OPf_KIDS))
1167             break;
1168         ref(cBINOPo->op_first, type);
1169         break;
1170     case OP_AELEM:
1171     case OP_HELEM:
1172         ref(cBINOPo->op_first, o->op_type);
1173         if (type == OP_RV2AV || type == OP_RV2HV) {
1174             o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV);
1175             o->op_flags |= OPf_MOD;
1176         }
1177         break;
1178
1179     case OP_SCOPE:
1180     case OP_LEAVE:
1181     case OP_ENTER:
1182     case OP_LIST:
1183         if (!(o->op_flags & OPf_KIDS))
1184             break;
1185         ref(cLISTOPo->op_last, type);
1186         break;
1187     default:
1188         break;
1189     }
1190     return scalar(o);
1191
1192 }
1193
1194 OP *
1195 my(o)
1196 OP *o;
1197 {
1198     OP *kid;
1199     I32 type;
1200
1201     if (!o || error_count)
1202         return o;
1203
1204     type = o->op_type;
1205     if (type == OP_LIST) {
1206         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
1207             my(kid);
1208     }
1209     else if (type != OP_PADSV &&
1210              type != OP_PADAV &&
1211              type != OP_PADHV &&
1212              type != OP_PUSHMARK)
1213     {
1214         sprintf(tokenbuf, "Can't declare %s in my", op_desc[o->op_type]);
1215         yyerror(tokenbuf);
1216         return o;
1217     }
1218     o->op_flags |= OPf_MOD;
1219     o->op_private |= OPpLVAL_INTRO;
1220     return o;
1221 }
1222
1223 OP *
1224 sawparens(o)
1225 OP *o;
1226 {
1227     if (o)
1228         o->op_flags |= OPf_PARENS;
1229     return o;
1230 }
1231
1232 OP *
1233 bind_match(type, left, right)
1234 I32 type;
1235 OP *left;
1236 OP *right;
1237 {
1238     OP *o;
1239
1240     if (right->op_type == OP_MATCH ||
1241         right->op_type == OP_SUBST ||
1242         right->op_type == OP_TRANS) {
1243         right->op_flags |= OPf_STACKED;
1244         if (right->op_type != OP_MATCH)
1245             left = mod(left, right->op_type);
1246         if (right->op_type == OP_TRANS)
1247             o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
1248         else
1249             o = prepend_elem(right->op_type, scalar(left), right);
1250         if (type == OP_NOT)
1251             return newUNOP(OP_NOT, 0, scalar(o));
1252         return o;
1253     }
1254     else
1255         return bind_match(type, left,
1256                 pmruntime(newPMOP(OP_MATCH, 0), right, Nullop));
1257 }
1258
1259 OP *
1260 invert(o)
1261 OP *o;
1262 {
1263     if (!o)
1264         return o;
1265     /* XXX need to optimize away NOT NOT here?  Or do we let optimizer do it? */
1266     return newUNOP(OP_NOT, OPf_SPECIAL, scalar(o));
1267 }
1268
1269 OP *
1270 scope(o)
1271 OP *o;
1272 {
1273     if (o) {
1274         if (o->op_flags & OPf_PARENS || perldb || tainting) {
1275             o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
1276             o->op_type = OP_LEAVE;
1277             o->op_ppaddr = ppaddr[OP_LEAVE];
1278         }
1279         else {
1280             if (o->op_type == OP_LINESEQ) {
1281                 OP *kid;
1282                 o->op_type = OP_SCOPE;
1283                 o->op_ppaddr = ppaddr[OP_SCOPE];
1284                 kid = ((LISTOP*)o)->op_first;
1285                 if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
1286                     SvREFCNT_dec(((COP*)kid)->cop_filegv);
1287                     null(kid);
1288                 }
1289             }
1290             else
1291                 o = newLISTOP(OP_SCOPE, 0, o, Nullop);
1292         }
1293     }
1294     return o;
1295 }
1296
1297 int
1298 block_start()
1299 {
1300     dTHR;
1301     int retval = savestack_ix;
1302     comppad_name_fill = AvFILL(comppad_name);
1303     SAVEINT(min_intro_pending);
1304     SAVEINT(max_intro_pending);
1305     min_intro_pending = 0;
1306     SAVEINT(comppad_name_fill);
1307     SAVEINT(padix_floor);
1308     padix_floor = padix;
1309     pad_reset_pending = FALSE;
1310     SAVEINT(hints);
1311     hints &= ~HINT_BLOCK_SCOPE;
1312     return retval;
1313 }
1314
1315 OP*
1316 block_end(line, floor, seq)
1317 int line;
1318 int floor;
1319 OP* seq;
1320 {
1321     dTHR;
1322     int needblockscope = hints & HINT_BLOCK_SCOPE;
1323     OP* retval = scalarseq(seq);
1324     if (copline > (line_t)line)
1325         copline = line;
1326     LEAVE_SCOPE(floor);
1327     pad_reset_pending = FALSE;
1328     if (needblockscope)
1329         hints |= HINT_BLOCK_SCOPE; /* propagate out */
1330     pad_leavemy(comppad_name_fill);
1331     return retval;
1332 }
1333
1334 void
1335 newPROG(o)
1336 OP *o;
1337 {
1338     dTHR;
1339     if (in_eval) {
1340         eval_root = newUNOP(OP_LEAVEEVAL, 0, o);
1341         eval_start = linklist(eval_root);
1342         eval_root->op_next = 0;
1343         peep(eval_start);
1344     }
1345     else {
1346         if (!o) {
1347             main_start = 0;
1348             return;
1349         }
1350         main_root = scope(sawparens(scalarvoid(o)));
1351         curcop = &compiling;
1352         main_start = LINKLIST(main_root);
1353         main_root->op_next = 0;
1354         peep(main_start);
1355         main_cv = compcv;
1356         compcv = 0;
1357     }
1358 }
1359
1360 OP *
1361 localize(o, lex)
1362 OP *o;
1363 I32 lex;
1364 {
1365     if (o->op_flags & OPf_PARENS)
1366         list(o);
1367     else {
1368         scalar(o);
1369         if (dowarn && bufptr > oldbufptr && bufptr[-1] == ',') {
1370             char *s;
1371             for (s = bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
1372             if (*s == ';' || *s == '=')
1373                 warn("Parens missing around \"%s\" list", lex ? "my" : "local");
1374         }
1375     }
1376     in_my = FALSE;
1377     if (lex)
1378         return my(o);
1379     else
1380         return mod(o, OP_NULL);         /* a bit kludgey */
1381 }
1382
1383 OP *
1384 jmaybe(o)
1385 OP *o;
1386 {
1387     if (o->op_type == OP_LIST) {
1388         o = convert(OP_JOIN, 0,
1389                 prepend_elem(OP_LIST,
1390                     newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
1391                     o));
1392     }
1393     return o;
1394 }
1395
1396 OP *
1397 fold_constants(o)
1398 register OP *o;
1399 {
1400     dTHR;
1401     register OP *curop;
1402     I32 type = o->op_type;
1403     SV *sv;
1404
1405     if (opargs[type] & OA_RETSCALAR)
1406         scalar(o);
1407     if (opargs[type] & OA_TARGET)
1408         o->op_targ = pad_alloc(type, SVs_PADTMP);
1409
1410     if ((opargs[type] & OA_OTHERINT) && (hints & HINT_INTEGER))
1411         o->op_ppaddr = ppaddr[type = ++(o->op_type)];
1412
1413     if (!(opargs[type] & OA_FOLDCONST))
1414         goto nope;
1415
1416     if (error_count)
1417         goto nope;              /* Don't try to run w/ errors */
1418
1419     for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
1420         if (curop->op_type != OP_CONST &&
1421                 curop->op_type != OP_LIST &&
1422                 curop->op_type != OP_SCALAR &&
1423                 curop->op_type != OP_NULL &&
1424                 curop->op_type != OP_PUSHMARK) {
1425             goto nope;
1426         }
1427     }
1428
1429     curop = LINKLIST(o);
1430     o->op_next = 0;
1431     op = curop;
1432     runops();
1433     sv = *(stack_sp--);
1434     if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */
1435         pad_swipe(o->op_targ);
1436     else if (SvTEMP(sv)) {                      /* grab mortal temp? */
1437         (void)SvREFCNT_inc(sv);
1438         SvTEMP_off(sv);
1439     }
1440     op_free(o);
1441     if (type == OP_RV2GV)
1442         return newGVOP(OP_GV, 0, sv);
1443     else {
1444         if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK) {
1445             IV iv = SvIV(sv);
1446             if ((double)iv == SvNV(sv)) {       /* can we smush double to int */
1447                 SvREFCNT_dec(sv);
1448                 sv = newSViv(iv);
1449             }
1450         }
1451         return newSVOP(OP_CONST, 0, sv);
1452     }
1453
1454   nope:
1455     if (!(opargs[type] & OA_OTHERINT))
1456         return o;
1457
1458     if (!(hints & HINT_INTEGER)) {
1459         int vars = 0;
1460
1461         if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS))
1462             return o;
1463
1464         for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
1465             if (curop->op_type == OP_CONST) {
1466                 if (SvIOK(((SVOP*)curop)->op_sv)) {
1467                     if (SvIVX(((SVOP*)curop)->op_sv) <= 0 && vars++)
1468                         return o;       /* negatives truncate wrong way, alas */
1469                     continue;
1470                 }
1471                 return o;
1472             }
1473             if (opargs[curop->op_type] & OA_RETINTEGER)
1474                 continue;
1475             if (curop->op_type == OP_PADSV || curop->op_type == OP_RV2SV) {
1476                 if (vars++)
1477                     return o;
1478                 if (((o->op_type == OP_LT || o->op_type == OP_GE) &&
1479                         curop == ((BINOP*)o)->op_first ) ||
1480                     ((o->op_type == OP_GT || o->op_type == OP_LE) &&
1481                         curop == ((BINOP*)o)->op_last ))
1482                 {
1483                     /* Allow "$i < 100" and variants to integerize */
1484                     continue;
1485                 }
1486             }
1487             return o;
1488         }
1489         o->op_ppaddr = ppaddr[++(o->op_type)];
1490     }
1491
1492     return o;
1493 }
1494
1495 OP *
1496 gen_constant_list(o)
1497 register OP *o;
1498 {
1499     dTHR;
1500     register OP *curop;
1501     I32 oldtmps_floor = tmps_floor;
1502
1503     list(o);
1504     if (error_count)
1505         return o;               /* Don't attempt to run with errors */
1506
1507     op = curop = LINKLIST(o);
1508     o->op_next = 0;
1509     pp_pushmark(ARGS);
1510     runops();
1511     op = curop;
1512     pp_anonlist(ARGS);
1513     tmps_floor = oldtmps_floor;
1514
1515     o->op_type = OP_RV2AV;
1516     o->op_ppaddr = ppaddr[OP_RV2AV];
1517     curop = ((UNOP*)o)->op_first;
1518     ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*stack_sp--));
1519     op_free(curop);
1520     linklist(o);
1521     return list(o);
1522 }
1523
1524 OP *
1525 convert(type, flags, o)
1526 I32 type;
1527 I32 flags;
1528 OP* o;
1529 {
1530     OP *kid;
1531     OP *last = 0;
1532
1533     if (!o || o->op_type != OP_LIST)
1534         o = newLISTOP(OP_LIST, 0, o, Nullop);
1535     else
1536         o->op_flags &= ~(OPf_KNOW|OPf_LIST);
1537
1538     if (!(opargs[type] & OA_MARK))
1539         null(cLISTOPo->op_first);
1540
1541     o->op_type = type;
1542     o->op_ppaddr = ppaddr[type];
1543     o->op_flags |= flags;
1544
1545     o = CHECKOP(type, o);
1546     if (o->op_type != type)
1547         return o;
1548
1549     if (cLISTOPo->op_children < 7) {
1550         /* XXX do we really need to do this if we're done appending?? */
1551         for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
1552             last = kid;
1553         cLISTOPo->op_last = last;       /* in case check substituted last arg */
1554     }
1555
1556     return fold_constants(o);
1557 }
1558
1559 /* List constructors */
1560
1561 OP *
1562 append_elem(type, first, last)
1563 I32 type;
1564 OP* first;
1565 OP* last;
1566 {
1567     if (!first)
1568         return last;
1569
1570     if (!last)
1571         return first;
1572
1573     if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS)
1574             return newLISTOP(type, 0, first, last);
1575
1576     if (first->op_flags & OPf_KIDS)
1577         ((LISTOP*)first)->op_last->op_sibling = last;
1578     else {
1579         first->op_flags |= OPf_KIDS;
1580         ((LISTOP*)first)->op_first = last;
1581     }
1582     ((LISTOP*)first)->op_last = last;
1583     ((LISTOP*)first)->op_children++;
1584     return first;
1585 }
1586
1587 OP *
1588 append_list(type, first, last)
1589 I32 type;
1590 LISTOP* first;
1591 LISTOP* last;
1592 {
1593     if (!first)
1594         return (OP*)last;
1595
1596     if (!last)
1597         return (OP*)first;
1598
1599     if (first->op_type != type)
1600         return prepend_elem(type, (OP*)first, (OP*)last);
1601
1602     if (last->op_type != type)
1603         return append_elem(type, (OP*)first, (OP*)last);
1604
1605     first->op_last->op_sibling = last->op_first;
1606     first->op_last = last->op_last;
1607     first->op_children += last->op_children;
1608     if (first->op_children)
1609         last->op_flags |= OPf_KIDS;
1610
1611     Safefree(last);
1612     return (OP*)first;
1613 }
1614
1615 OP *
1616 prepend_elem(type, first, last)
1617 I32 type;
1618 OP* first;
1619 OP* last;
1620 {
1621     if (!first)
1622         return last;
1623
1624     if (!last)
1625         return first;
1626
1627     if (last->op_type == type) {
1628         if (type == OP_LIST) {  /* already a PUSHMARK there */
1629             first->op_sibling = ((LISTOP*)last)->op_first->op_sibling;
1630             ((LISTOP*)last)->op_first->op_sibling = first;
1631         }
1632         else {
1633             if (!(last->op_flags & OPf_KIDS)) {
1634                 ((LISTOP*)last)->op_last = first;
1635                 last->op_flags |= OPf_KIDS;
1636             }
1637             first->op_sibling = ((LISTOP*)last)->op_first;
1638             ((LISTOP*)last)->op_first = first;
1639         }
1640         ((LISTOP*)last)->op_children++;
1641         return last;
1642     }
1643
1644     return newLISTOP(type, 0, first, last);
1645 }
1646
1647 /* Constructors */
1648
1649 OP *
1650 newNULLLIST()
1651 {
1652     return newOP(OP_STUB, 0);
1653 }
1654
1655 OP *
1656 force_list(o)
1657 OP *o;
1658 {
1659     if (!o || o->op_type != OP_LIST)
1660         o = newLISTOP(OP_LIST, 0, o, Nullop);
1661     null(o);
1662     return o;
1663 }
1664
1665 OP *
1666 newLISTOP(type, flags, first, last)
1667 I32 type;
1668 I32 flags;
1669 OP* first;
1670 OP* last;
1671 {
1672     LISTOP *listop;
1673
1674     Newz(1101, listop, 1, LISTOP);
1675
1676     listop->op_type = type;
1677     listop->op_ppaddr = ppaddr[type];
1678     listop->op_children = (first != 0) + (last != 0);
1679     listop->op_flags = flags;
1680
1681     if (!last && first)
1682         last = first;
1683     else if (!first && last)
1684         first = last;
1685     else if (first)
1686         first->op_sibling = last;
1687     listop->op_first = first;
1688     listop->op_last = last;
1689     if (type == OP_LIST) {
1690         OP* pushop;
1691         pushop = newOP(OP_PUSHMARK, 0);
1692         pushop->op_sibling = first;
1693         listop->op_first = pushop;
1694         listop->op_flags |= OPf_KIDS;
1695         if (!last)
1696             listop->op_last = pushop;
1697     }
1698     else if (listop->op_children)
1699         listop->op_flags |= OPf_KIDS;
1700
1701     return (OP*)listop;
1702 }
1703
1704 OP *
1705 newOP(type, flags)
1706 I32 type;
1707 I32 flags;
1708 {
1709     OP *o;
1710     Newz(1101, o, 1, OP);
1711     o->op_type = type;
1712     o->op_ppaddr = ppaddr[type];
1713     o->op_flags = flags;
1714
1715     o->op_next = o;
1716     o->op_private = 0 + (flags >> 8);
1717     if (opargs[type] & OA_RETSCALAR)
1718         scalar(o);
1719     if (opargs[type] & OA_TARGET)
1720         o->op_targ = pad_alloc(type, SVs_PADTMP);
1721     return CHECKOP(type, o);
1722 }
1723
1724 OP *
1725 newUNOP(type, flags, first)
1726 I32 type;
1727 I32 flags;
1728 OP* first;
1729 {
1730     UNOP *unop;
1731
1732     if (!first)
1733         first = newOP(OP_STUB, 0);
1734     if (opargs[type] & OA_MARK)
1735         first = force_list(first);
1736
1737     Newz(1101, unop, 1, UNOP);
1738     unop->op_type = type;
1739     unop->op_ppaddr = ppaddr[type];
1740     unop->op_first = first;
1741     unop->op_flags = flags | OPf_KIDS;
1742     unop->op_private = 1 | (flags >> 8);
1743
1744     unop = (UNOP*) CHECKOP(type, unop);
1745     if (unop->op_next)
1746         return (OP*)unop;
1747
1748     return fold_constants((OP *) unop);
1749 }
1750
1751 OP *
1752 newBINOP(type, flags, first, last)
1753 I32 type;
1754 I32 flags;
1755 OP* first;
1756 OP* last;
1757 {
1758     BINOP *binop;
1759     Newz(1101, binop, 1, BINOP);
1760
1761     if (!first)
1762         first = newOP(OP_NULL, 0);
1763
1764     binop->op_type = type;
1765     binop->op_ppaddr = ppaddr[type];
1766     binop->op_first = first;
1767     binop->op_flags = flags | OPf_KIDS;
1768     if (!last) {
1769         last = first;
1770         binop->op_private = 1 | (flags >> 8);
1771     }
1772     else {
1773         binop->op_private = 2 | (flags >> 8);
1774         first->op_sibling = last;
1775     }
1776
1777     binop = (BINOP*)CHECKOP(type, binop);
1778     if (binop->op_next)
1779         return (OP*)binop;
1780
1781     binop->op_last = last = binop->op_first->op_sibling;
1782
1783     return fold_constants((OP *)binop);
1784 }
1785
1786 OP *
1787 pmtrans(o, expr, repl)
1788 OP *o;
1789 OP *expr;
1790 OP *repl;
1791 {
1792     SV *tstr = ((SVOP*)expr)->op_sv;
1793     SV *rstr = ((SVOP*)repl)->op_sv;
1794     STRLEN tlen;
1795     STRLEN rlen;
1796     register U8 *t = (U8*)SvPV(tstr, tlen);
1797     register U8 *r = (U8*)SvPV(rstr, rlen);
1798     register I32 i;
1799     register I32 j;
1800     I32 delete;
1801     I32 complement;
1802     register short *tbl;
1803
1804     tbl = (short*)cPVOPo->op_pv;
1805     complement  = o->op_private & OPpTRANS_COMPLEMENT;
1806     delete      = o->op_private & OPpTRANS_DELETE;
1807     /* squash   = o->op_private & OPpTRANS_SQUASH; */
1808
1809     if (complement) {
1810         Zero(tbl, 256, short);
1811         for (i = 0; i < tlen; i++)
1812             tbl[t[i]] = -1;
1813         for (i = 0, j = 0; i < 256; i++) {
1814             if (!tbl[i]) {
1815                 if (j >= rlen) {
1816                     if (delete)
1817                         tbl[i] = -2;
1818                     else if (rlen)
1819                         tbl[i] = r[j-1];
1820                     else
1821                         tbl[i] = i;
1822                 }
1823                 else
1824                     tbl[i] = r[j++];
1825             }
1826         }
1827     }
1828     else {
1829         if (!rlen && !delete) {
1830             r = t; rlen = tlen;
1831         }
1832         for (i = 0; i < 256; i++)
1833             tbl[i] = -1;
1834         for (i = 0, j = 0; i < tlen; i++,j++) {
1835             if (j >= rlen) {
1836                 if (delete) {
1837                     if (tbl[t[i]] == -1)
1838                         tbl[t[i]] = -2;
1839                     continue;
1840                 }
1841                 --j;
1842             }
1843             if (tbl[t[i]] == -1)
1844                 tbl[t[i]] = r[j];
1845         }
1846     }
1847     op_free(expr);
1848     op_free(repl);
1849
1850     return o;
1851 }
1852
1853 OP *
1854 newPMOP(type, flags)
1855 I32 type;
1856 I32 flags;
1857 {
1858     dTHR;
1859     PMOP *pmop;
1860
1861     Newz(1101, pmop, 1, PMOP);
1862     pmop->op_type = type;
1863     pmop->op_ppaddr = ppaddr[type];
1864     pmop->op_flags = flags;
1865     pmop->op_private = 0 | (flags >> 8);
1866
1867     /* link into pm list */
1868     if (type != OP_TRANS && curstash) {
1869         pmop->op_pmnext = HvPMROOT(curstash);
1870         HvPMROOT(curstash) = pmop;
1871     }
1872
1873     return (OP*)pmop;
1874 }
1875
1876 OP *
1877 pmruntime(o, expr, repl)
1878 OP *o;
1879 OP *expr;
1880 OP *repl;
1881 {
1882     PMOP *pm;
1883     LOGOP *rcop;
1884
1885     if (o->op_type == OP_TRANS)
1886         return pmtrans(o, expr, repl);
1887
1888     pm = (PMOP*)o;
1889
1890     if (expr->op_type == OP_CONST) {
1891         STRLEN plen;
1892         SV *pat = ((SVOP*)expr)->op_sv;
1893         char *p = SvPV(pat, plen);
1894         if ((o->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
1895             sv_setpvn(pat, "\\s+", 3);
1896             p = SvPV(pat, plen);
1897             pm->op_pmflags |= PMf_SKIPWHITE;
1898         }
1899         pm->op_pmregexp = pregcomp(p, p + plen, pm);
1900         if (strEQ("\\s+", pm->op_pmregexp->precomp))
1901             pm->op_pmflags |= PMf_WHITE;
1902         hoistmust(pm);
1903         op_free(expr);
1904     }
1905     else {
1906         if (pm->op_pmflags & PMf_KEEP)
1907             expr = newUNOP(OP_REGCMAYBE,0,expr);
1908
1909         Newz(1101, rcop, 1, LOGOP);
1910         rcop->op_type = OP_REGCOMP;
1911         rcop->op_ppaddr = ppaddr[OP_REGCOMP];
1912         rcop->op_first = scalar(expr);
1913         rcop->op_flags |= OPf_KIDS;
1914         rcop->op_private = 1;
1915         rcop->op_other = o;
1916
1917         /* establish postfix order */
1918         if (pm->op_pmflags & PMf_KEEP) {
1919             LINKLIST(expr);
1920             rcop->op_next = expr;
1921             ((UNOP*)expr)->op_first->op_next = (OP*)rcop;
1922         }
1923         else {
1924             rcop->op_next = LINKLIST(expr);
1925             expr->op_next = (OP*)rcop;
1926         }
1927
1928         prepend_elem(o->op_type, scalar((OP*)rcop), o);
1929     }
1930
1931     if (repl) {
1932         OP *curop;
1933         if (pm->op_pmflags & PMf_EVAL)
1934             curop = 0;
1935         else if (repl->op_type == OP_CONST)
1936             curop = repl;
1937         else {
1938             OP *lastop = 0;
1939             for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
1940                 if (opargs[curop->op_type] & OA_DANGEROUS) {
1941                     if (curop->op_type == OP_GV) {
1942                         GV *gv = ((GVOP*)curop)->op_gv;
1943                         if (strchr("&`'123456789+", *GvENAME(gv)))
1944                             break;
1945                     }
1946                     else if (curop->op_type == OP_RV2CV)
1947                         break;
1948                     else if (curop->op_type == OP_RV2SV ||
1949                              curop->op_type == OP_RV2AV ||
1950                              curop->op_type == OP_RV2HV ||
1951                              curop->op_type == OP_RV2GV) {
1952                         if (lastop && lastop->op_type != OP_GV) /*funny deref?*/
1953                             break;
1954                     }
1955                     else if (curop->op_type == OP_PADSV ||
1956                              curop->op_type == OP_PADAV ||
1957                              curop->op_type == OP_PADHV ||
1958                              curop->op_type == OP_PADANY) {
1959                              /* is okay */
1960                     }
1961                     else
1962                         break;
1963                 }
1964                 lastop = curop;
1965             }
1966         }
1967         if (curop == repl) {
1968             pm->op_pmflags |= PMf_CONST;        /* const for long enough */
1969             pm->op_pmpermflags |= PMf_CONST;    /* const for long enough */
1970             prepend_elem(o->op_type, scalar(repl), o);
1971         }
1972         else {
1973             Newz(1101, rcop, 1, LOGOP);
1974             rcop->op_type = OP_SUBSTCONT;
1975             rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
1976             rcop->op_first = scalar(repl);
1977             rcop->op_flags |= OPf_KIDS;
1978             rcop->op_private = 1;
1979             rcop->op_other = o;
1980
1981             /* establish postfix order */
1982             rcop->op_next = LINKLIST(repl);
1983             repl->op_next = (OP*)rcop;
1984
1985             pm->op_pmreplroot = scalar((OP*)rcop);
1986             pm->op_pmreplstart = LINKLIST(rcop);
1987             rcop->op_next = 0;
1988         }
1989     }
1990
1991     return (OP*)pm;
1992 }
1993
1994 OP *
1995 newSVOP(type, flags, sv)
1996 I32 type;
1997 I32 flags;
1998 SV *sv;
1999 {
2000     SVOP *svop;
2001     Newz(1101, svop, 1, SVOP);
2002     svop->op_type = type;
2003     svop->op_ppaddr = ppaddr[type];
2004     svop->op_sv = sv;
2005     svop->op_next = (OP*)svop;
2006     svop->op_flags = flags;
2007     if (opargs[type] & OA_RETSCALAR)
2008         scalar((OP*)svop);
2009     if (opargs[type] & OA_TARGET)
2010         svop->op_targ = pad_alloc(type, SVs_PADTMP);
2011     return CHECKOP(type, svop);
2012 }
2013
2014 OP *
2015 newGVOP(type, flags, gv)
2016 I32 type;
2017 I32 flags;
2018 GV *gv;
2019 {
2020     dTHR;
2021     GVOP *gvop;
2022     Newz(1101, gvop, 1, GVOP);
2023     gvop->op_type = type;
2024     gvop->op_ppaddr = ppaddr[type];
2025     gvop->op_gv = (GV*)SvREFCNT_inc(gv);
2026     gvop->op_next = (OP*)gvop;
2027     gvop->op_flags = flags;
2028     if (opargs[type] & OA_RETSCALAR)
2029         scalar((OP*)gvop);
2030     if (opargs[type] & OA_TARGET)
2031         gvop->op_targ = pad_alloc(type, SVs_PADTMP);
2032     return CHECKOP(type, gvop);
2033 }
2034
2035 OP *
2036 newPVOP(type, flags, pv)
2037 I32 type;
2038 I32 flags;
2039 char *pv;
2040 {
2041     PVOP *pvop;
2042     Newz(1101, pvop, 1, PVOP);
2043     pvop->op_type = type;
2044     pvop->op_ppaddr = ppaddr[type];
2045     pvop->op_pv = pv;
2046     pvop->op_next = (OP*)pvop;
2047     pvop->op_flags = flags;
2048     if (opargs[type] & OA_RETSCALAR)
2049         scalar((OP*)pvop);
2050     if (opargs[type] & OA_TARGET)
2051         pvop->op_targ = pad_alloc(type, SVs_PADTMP);
2052     return CHECKOP(type, pvop);
2053 }
2054
2055 void
2056 package(o)
2057 OP *o;
2058 {
2059     dTHR;
2060     SV *sv;
2061
2062     save_hptr(&curstash);
2063     save_item(curstname);
2064     if (o) {
2065         STRLEN len;
2066         char *name;
2067         sv = cSVOPo->op_sv;
2068         name = SvPV(sv, len);
2069         curstash = gv_stashpv(name,TRUE);
2070         sv_setpvn(curstname, name, len);
2071         op_free(o);
2072     }
2073     else {
2074         sv_setpv(curstname,"<none>");
2075         curstash = Nullhv;
2076     }
2077     copline = NOLINE;
2078     expect = XSTATE;
2079 }
2080
2081 void
2082 utilize(aver, floor, id, arg)
2083 int aver;
2084 I32 floor;
2085 OP *id;
2086 OP *arg;
2087 {
2088     OP *pack;
2089     OP *meth;
2090     OP *rqop;
2091     OP *imop;
2092
2093     if (id->op_type != OP_CONST)
2094         croak("Module name must be constant");
2095
2096     /* Fake up an import/unimport */
2097     if (arg && arg->op_type == OP_STUB)
2098         imop = arg;             /* no import on explicit () */
2099     else {
2100         /* Make copy of id so we don't free it twice */
2101         pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
2102
2103         meth = newSVOP(OP_CONST, 0,
2104             aver
2105                 ? newSVpv("import", 6)
2106                 : newSVpv("unimport", 8)
2107             );
2108         imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
2109                     append_elem(OP_LIST,
2110                         prepend_elem(OP_LIST, pack, list(arg)),
2111                         newUNOP(OP_METHOD, 0, meth)));
2112     }
2113
2114     /* Fake up a require */
2115     rqop = newUNOP(OP_REQUIRE, 0, id);
2116
2117     /* Fake up the BEGIN {}, which does its thing immediately. */
2118     newSUB(floor,
2119         newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)),
2120         Nullop,
2121         append_elem(OP_LINESEQ,
2122             newSTATEOP(0, Nullch, rqop),
2123             newSTATEOP(0, Nullch, imop) ));
2124
2125     copline = NOLINE;
2126     expect = XSTATE;
2127 }
2128
2129 OP *
2130 newSLICEOP(flags, subscript, listval)
2131 I32 flags;
2132 OP *subscript;
2133 OP *listval;
2134 {
2135     return newBINOP(OP_LSLICE, flags,
2136             list(force_list(subscript)),
2137             list(force_list(listval)) );
2138 }
2139
2140 static I32
2141 list_assignment(o)
2142 register OP *o;
2143 {
2144     if (!o)
2145         return TRUE;
2146
2147     if (o->op_type == OP_NULL && o->op_flags & OPf_KIDS)
2148         o = cUNOPo->op_first;
2149
2150     if (o->op_type == OP_COND_EXPR) {
2151         I32 t = list_assignment(cCONDOPo->op_first->op_sibling);
2152         I32 f = list_assignment(cCONDOPo->op_first->op_sibling->op_sibling);
2153
2154         if (t && f)
2155             return TRUE;
2156         if (t || f)
2157             yyerror("Assignment to both a list and a scalar");
2158         return FALSE;
2159     }
2160
2161     if (o->op_type == OP_LIST || o->op_flags & OPf_PARENS ||
2162         o->op_type == OP_RV2AV || o->op_type == OP_RV2HV ||
2163         o->op_type == OP_ASLICE || o->op_type == OP_HSLICE)
2164         return TRUE;
2165
2166     if (o->op_type == OP_PADAV || o->op_type == OP_PADHV)
2167         return TRUE;
2168
2169     if (o->op_type == OP_RV2SV)
2170         return FALSE;
2171
2172     return FALSE;
2173 }
2174
2175 OP *
2176 newASSIGNOP(flags, left, optype, right)
2177 I32 flags;
2178 OP *left;
2179 I32 optype;
2180 OP *right;
2181 {
2182     OP *o;
2183
2184     if (optype) {
2185         if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) {
2186             return newLOGOP(optype, 0,
2187                 mod(scalar(left), optype),
2188                 newUNOP(OP_SASSIGN, 0, scalar(right)));
2189         }
2190         else {
2191             return newBINOP(optype, OPf_STACKED,
2192                 mod(scalar(left), optype), scalar(right));
2193         }
2194     }
2195
2196     if (list_assignment(left)) {
2197         modcount = 0;
2198         eval_start = right;     /* Grandfathering $[ assignment here.  Bletch.*/
2199         left = mod(left, OP_AASSIGN);
2200         if (eval_start)
2201             eval_start = 0;
2202         else {
2203             op_free(left);
2204             op_free(right);
2205             return Nullop;
2206         }
2207         o = newBINOP(OP_AASSIGN, flags,
2208                 list(force_list(right)),
2209                 list(force_list(left)) );
2210         o->op_private = 0 | (flags >> 8);
2211         if (!(left->op_private & OPpLVAL_INTRO)) {
2212             static int generation = 100;
2213             OP *curop;
2214             OP *lastop = o;
2215             generation++;
2216             for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
2217                 if (opargs[curop->op_type] & OA_DANGEROUS) {
2218                     if (curop->op_type == OP_GV) {
2219                         GV *gv = ((GVOP*)curop)->op_gv;
2220                         if (gv == defgv || SvCUR(gv) == generation)
2221                             break;
2222                         SvCUR(gv) = generation;
2223                     }
2224                     else if (curop->op_type == OP_PADSV ||
2225                              curop->op_type == OP_PADAV ||
2226                              curop->op_type == OP_PADHV ||
2227                              curop->op_type == OP_PADANY) {
2228                         SV **svp = AvARRAY(comppad_name);
2229                         SV *sv = svp[curop->op_targ];
2230                         if (SvCUR(sv) == generation)
2231                             break;
2232                         SvCUR(sv) = generation; /* (SvCUR not used any more) */
2233                     }
2234                     else if (curop->op_type == OP_RV2CV)
2235                         break;
2236                     else if (curop->op_type == OP_RV2SV ||
2237                              curop->op_type == OP_RV2AV ||
2238                              curop->op_type == OP_RV2HV ||
2239                              curop->op_type == OP_RV2GV) {
2240                         if (lastop->op_type != OP_GV)   /* funny deref? */
2241                             break;
2242                     }
2243                     else
2244                         break;
2245                 }
2246                 lastop = curop;
2247             }
2248             if (curop != o)
2249                 o->op_private = OPpASSIGN_COMMON;
2250         }
2251         if (right && right->op_type == OP_SPLIT) {
2252             OP* tmpop;
2253             if ((tmpop = ((LISTOP*)right)->op_first) &&
2254                 tmpop->op_type == OP_PUSHRE)
2255             {
2256                 PMOP *pm = (PMOP*)tmpop;
2257                 if (left->op_type == OP_RV2AV &&
2258                     !(left->op_private & OPpLVAL_INTRO) &&
2259                     !(o->op_private & OPpASSIGN_COMMON) )
2260                 {
2261                     tmpop = ((UNOP*)left)->op_first;
2262                     if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
2263                         pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv;
2264                         pm->op_pmflags |= PMf_ONCE;
2265                         tmpop = cUNOPo->op_first;       /* to list (nulled) */
2266                         tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
2267                         tmpop->op_sibling = Nullop;     /* don't free split */
2268                         right->op_next = tmpop->op_next;  /* fix starting loc */
2269                         op_free(o);                     /* blow off assign */
2270                         right->op_flags &= ~(OPf_KNOW|OPf_LIST);
2271                                 /* "I don't know and I don't care." */
2272                         return right;
2273                     }
2274                 }
2275                 else {
2276                     if (modcount < 10000 &&
2277                       ((LISTOP*)right)->op_last->op_type == OP_CONST)
2278                     {
2279                         SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
2280                         if (SvIVX(sv) == 0)
2281                             sv_setiv(sv, modcount+1);
2282                     }
2283                 }
2284             }
2285         }
2286         return o;
2287     }
2288     if (!right)
2289         right = newOP(OP_UNDEF, 0);
2290     if (right->op_type == OP_READLINE) {
2291         right->op_flags |= OPf_STACKED;
2292         return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right));
2293     }
2294     else {
2295         eval_start = right;     /* Grandfathering $[ assignment here.  Bletch.*/
2296         o = newBINOP(OP_SASSIGN, flags,
2297             scalar(right), mod(scalar(left), OP_SASSIGN) );
2298         if (eval_start)
2299             eval_start = 0;
2300         else {
2301             op_free(o);
2302             return Nullop;
2303         }
2304     }
2305     return o;
2306 }
2307
2308 OP *
2309 newSTATEOP(flags, label, o)
2310 I32 flags;
2311 char *label;
2312 OP *o;
2313 {
2314     dTHR;
2315     register COP *cop;
2316
2317     /* Introduce my variables. */
2318     if (min_intro_pending) {
2319         SV **svp = AvARRAY(comppad_name);
2320         I32 i;
2321         SV *sv;
2322         for (i = min_intro_pending; i <= max_intro_pending; i++) {
2323             if ((sv = svp[i]) && sv != &sv_undef && !SvIVX(sv)) {
2324                 SvIVX(sv) = 999999999;  /* Don't know scope end yet. */
2325                 SvNVX(sv) = (double)cop_seqmax;
2326             }
2327         }
2328         min_intro_pending = 0;
2329         comppad_name_fill = max_intro_pending;  /* Needn't search higher */
2330     }
2331
2332     Newz(1101, cop, 1, COP);
2333     if (perldb && curcop->cop_line && curstash != debstash) {
2334         cop->op_type = OP_DBSTATE;
2335         cop->op_ppaddr = ppaddr[ OP_DBSTATE ];
2336     }
2337     else {
2338         cop->op_type = OP_NEXTSTATE;
2339         cop->op_ppaddr = ppaddr[ OP_NEXTSTATE ];
2340     }
2341     cop->op_flags = flags;
2342     cop->op_private = 0 | (flags >> 8);
2343     cop->op_next = (OP*)cop;
2344
2345     if (label) {
2346         cop->cop_label = label;
2347         hints |= HINT_BLOCK_SCOPE;
2348     }
2349     cop->cop_seq = cop_seqmax++;
2350     cop->cop_arybase = curcop->cop_arybase;
2351
2352     if (copline == NOLINE)
2353         cop->cop_line = curcop->cop_line;
2354     else {
2355         cop->cop_line = copline;
2356         copline = NOLINE;
2357     }
2358     cop->cop_filegv = SvREFCNT_inc(curcop->cop_filegv);
2359     cop->cop_stash = curstash;
2360
2361     if (perldb && curstash != debstash) {
2362         SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE);
2363         if (svp && *svp != &sv_undef && !SvIOK(*svp)) {
2364             (void)SvIOK_on(*svp);
2365             SvIVX(*svp) = 1;
2366             SvSTASH(*svp) = (HV*)cop;
2367         }
2368     }
2369
2370     return prepend_elem(OP_LINESEQ, (OP*)cop, o);
2371 }
2372
2373 OP *
2374 newLOGOP(type, flags, first, other)
2375 I32 type;
2376 I32 flags;
2377 OP* first;
2378 OP* other;
2379 {
2380     dTHR;
2381     LOGOP *logop;
2382     OP *o;
2383
2384     if (type == OP_XOR)         /* Not short circuit, but here by precedence. */
2385         return newBINOP(type, flags, scalar(first), scalar(other));
2386
2387     scalarboolean(first);
2388     /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
2389     if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) {
2390         if (type == OP_AND || type == OP_OR) {
2391             if (type == OP_AND)
2392                 type = OP_OR;
2393             else
2394                 type = OP_AND;
2395             o = first;
2396             first = cUNOPo->op_first;
2397             if (o->op_next)
2398                 first->op_next = o->op_next;
2399             cUNOPo->op_first = Nullop;
2400             op_free(o);
2401         }
2402     }
2403     if (first->op_type == OP_CONST) {
2404         if (dowarn && (first->op_private & OPpCONST_BARE))
2405             warn("Probable precedence problem on %s", op_desc[type]);
2406         if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
2407             op_free(first);
2408             return other;
2409         }
2410         else {
2411             op_free(other);
2412             return first;
2413         }
2414     }
2415     else if (first->op_type == OP_WANTARRAY) {
2416         if (type == OP_AND)
2417             list(other);
2418         else
2419             scalar(other);
2420     }
2421
2422     if (!other)
2423         return first;
2424
2425     if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
2426         other->op_private |= OPpASSIGN_BACKWARDS;  /* other is an OP_SASSIGN */
2427
2428     Newz(1101, logop, 1, LOGOP);
2429
2430     logop->op_type = type;
2431     logop->op_ppaddr = ppaddr[type];
2432     logop->op_first = first;
2433     logop->op_flags = flags | OPf_KIDS;
2434     logop->op_other = LINKLIST(other);
2435     logop->op_private = 1 | (flags >> 8);
2436
2437     /* establish postfix order */
2438     logop->op_next = LINKLIST(first);
2439     first->op_next = (OP*)logop;
2440     first->op_sibling = other;
2441
2442     o = newUNOP(OP_NULL, 0, (OP*)logop);
2443     other->op_next = o;
2444
2445     return o;
2446 }
2447
2448 OP *
2449 newCONDOP(flags, first, true, false)
2450 I32 flags;
2451 OP* first;
2452 OP* true;
2453 OP* false;
2454 {
2455     dTHR;
2456     CONDOP *condop;
2457     OP *o;
2458
2459     if (!false)
2460         return newLOGOP(OP_AND, 0, first, true);
2461     if (!true)
2462         return newLOGOP(OP_OR, 0, first, false);
2463
2464     scalarboolean(first);
2465     if (first->op_type == OP_CONST) {
2466         if (SvTRUE(((SVOP*)first)->op_sv)) {
2467             op_free(first);
2468             op_free(false);
2469             return true;
2470         }
2471         else {
2472             op_free(first);
2473             op_free(true);
2474             return false;
2475         }
2476     }
2477     else if (first->op_type == OP_WANTARRAY) {
2478         list(true);
2479         scalar(false);
2480     }
2481     Newz(1101, condop, 1, CONDOP);
2482
2483     condop->op_type = OP_COND_EXPR;
2484     condop->op_ppaddr = ppaddr[OP_COND_EXPR];
2485     condop->op_first = first;
2486     condop->op_flags = flags | OPf_KIDS;
2487     condop->op_true = LINKLIST(true);
2488     condop->op_false = LINKLIST(false);
2489     condop->op_private = 1 | (flags >> 8);
2490
2491     /* establish postfix order */
2492     condop->op_next = LINKLIST(first);
2493     first->op_next = (OP*)condop;
2494
2495     first->op_sibling = true;
2496     true->op_sibling = false;
2497     o = newUNOP(OP_NULL, 0, (OP*)condop);
2498
2499     true->op_next = o;
2500     false->op_next = o;
2501
2502     return o;
2503 }
2504
2505 OP *
2506 newRANGE(flags, left, right)
2507 I32 flags;
2508 OP *left;
2509 OP *right;
2510 {
2511     CONDOP *condop;
2512     OP *flip;
2513     OP *flop;
2514     OP *o;
2515
2516     Newz(1101, condop, 1, CONDOP);
2517
2518     condop->op_type = OP_RANGE;
2519     condop->op_ppaddr = ppaddr[OP_RANGE];
2520     condop->op_first = left;
2521     condop->op_flags = OPf_KIDS;
2522     condop->op_true = LINKLIST(left);
2523     condop->op_false = LINKLIST(right);
2524     condop->op_private = 1 | (flags >> 8);
2525
2526     left->op_sibling = right;
2527
2528     condop->op_next = (OP*)condop;
2529     flip = newUNOP(OP_FLIP, flags, (OP*)condop);
2530     flop = newUNOP(OP_FLOP, 0, flip);
2531     o = newUNOP(OP_NULL, 0, flop);
2532     linklist(flop);
2533
2534     left->op_next = flip;
2535     right->op_next = flop;
2536
2537     condop->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
2538     sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV);
2539     flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
2540     sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
2541
2542     flip->op_private =  left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
2543     flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
2544
2545     flip->op_next = o;
2546     if (!flip->op_private || !flop->op_private)
2547         linklist(o);            /* blow off optimizer unless constant */
2548
2549     return o;
2550 }
2551
2552 OP *
2553 newLOOPOP(flags, debuggable, expr, block)
2554 I32 flags;
2555 I32 debuggable;
2556 OP *expr;
2557 OP *block;
2558 {
2559     dTHR;
2560     OP* listop;
2561     OP* o;
2562     int once = block && block->op_flags & OPf_SPECIAL &&
2563       (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
2564
2565     if (expr) {
2566         if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
2567             return block;       /* do {} while 0 does once */
2568         else if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)
2569             expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr);
2570     }
2571
2572     listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
2573     o = newLOGOP(OP_AND, 0, expr, listop);
2574
2575     ((LISTOP*)listop)->op_last->op_next = LINKLIST(o);
2576
2577     if (once && o != listop)
2578         o->op_next = ((LOGOP*)cUNOPo->op_first)->op_other;
2579
2580     if (o == listop)
2581         o = newUNOP(OP_NULL, 0, o);     /* or do {} while 1 loses outer block */
2582
2583     o->op_flags |= flags;
2584     o = scope(o);
2585     o->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/
2586     return o;
2587 }
2588
2589 OP *
2590 newWHILEOP(flags, debuggable, loop, expr, block, cont)
2591 I32 flags;
2592 I32 debuggable;
2593 LOOP *loop;
2594 OP *expr;
2595 OP *block;
2596 OP *cont;
2597 {
2598     dTHR;
2599     OP *redo;
2600     OP *next = 0;
2601     OP *listop;
2602     OP *o;
2603     OP *condop;
2604
2605     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) {
2606         expr = newUNOP(OP_DEFINED, 0,
2607             newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
2608     }
2609
2610     if (!block)
2611         block = newOP(OP_NULL, 0);
2612
2613     if (cont)
2614         next = LINKLIST(cont);
2615     if (expr)
2616         cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
2617
2618     listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
2619     redo = LINKLIST(listop);
2620
2621     if (expr) {
2622         o = newLOGOP(OP_AND, 0, expr, scalar(listop));
2623         if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) {
2624             op_free(expr);              /* oops, it's a while (0) */
2625             op_free((OP*)loop);
2626             return Nullop;              /* (listop already freed by newLOGOP) */
2627         }
2628         ((LISTOP*)listop)->op_last->op_next = condop =
2629             (o == listop ? redo : LINKLIST(o));
2630         if (!next)
2631             next = condop;
2632     }
2633     else
2634         o = listop;
2635
2636     if (!loop) {
2637         Newz(1101,loop,1,LOOP);
2638         loop->op_type = OP_ENTERLOOP;
2639         loop->op_ppaddr = ppaddr[OP_ENTERLOOP];
2640         loop->op_private = 0;
2641         loop->op_next = (OP*)loop;
2642     }
2643
2644     o = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, o);
2645
2646     loop->op_redoop = redo;
2647     loop->op_lastop = o;
2648
2649     if (next)
2650         loop->op_nextop = next;
2651     else
2652         loop->op_nextop = o;
2653
2654     o->op_flags |= flags;
2655     o->op_private |= (flags >> 8);
2656     return o;
2657 }
2658
2659 OP *
2660 #ifndef CAN_PROTOTYPE
2661 newFOROP(flags,label,forline,sv,expr,block,cont)
2662 I32 flags;
2663 char *label;
2664 line_t forline;
2665 OP* sv;
2666 OP* expr;
2667 OP*block;
2668 OP*cont;
2669 #else
2670 newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
2671 #endif /* CAN_PROTOTYPE */
2672 {
2673     LOOP *loop;
2674     int padoff = 0;
2675     I32 iterflags = 0;
2676
2677     copline = forline;
2678     if (sv) {
2679         if (sv->op_type == OP_RV2SV) {  /* symbol table variable */
2680             sv->op_type = OP_RV2GV;
2681             sv->op_ppaddr = ppaddr[OP_RV2GV];
2682         }
2683         else if (sv->op_type == OP_PADSV) { /* private variable */
2684             padoff = sv->op_targ;
2685             op_free(sv);
2686             sv = Nullop;
2687         }
2688         else
2689             croak("Can't use %s for loop variable", op_desc[sv->op_type]);
2690     }
2691     else {
2692         sv = newGVOP(OP_GV, 0, defgv);
2693     }
2694     if (expr->op_type == OP_RV2AV) {
2695         expr = scalar(ref(expr, OP_ITER));
2696         iterflags |= OPf_STACKED;
2697     }
2698     loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
2699         append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART),
2700                     scalar(sv))));
2701     assert(!loop->op_next);
2702     Renew(loop, 1, LOOP);
2703     loop->op_targ = padoff;
2704     return newSTATEOP(0, label, newWHILEOP(flags, 1, loop,
2705         newOP(OP_ITER, 0), block, cont));
2706 }
2707
2708 OP*
2709 newLOOPEX(type, label)
2710 I32 type;
2711 OP* label;
2712 {
2713     dTHR;
2714     OP *o;
2715     if (type != OP_GOTO || label->op_type == OP_CONST) {
2716         o = newPVOP(type, 0, savepv(
2717                 label->op_type == OP_CONST
2718                     ? SvPVx(((SVOP*)label)->op_sv, na)
2719                     : "" ));
2720         op_free(label);
2721     }
2722     else {
2723         if (label->op_type == OP_ENTERSUB)
2724             label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
2725         o = newUNOP(type, OPf_STACKED, label);
2726     }
2727     hints |= HINT_BLOCK_SCOPE;
2728     return o;
2729 }
2730
2731 void
2732 cv_undef(cv)
2733 CV *cv;
2734 {
2735     dTHR;
2736 #ifdef USE_THREADS
2737     MUTEX_DESTROY(CvMUTEXP(cv));
2738     Safefree(CvMUTEXP(cv));
2739     if (CvCONDP(cv)) {
2740         COND_DESTROY(CvCONDP(cv));
2741         Safefree(CvCONDP(cv));
2742     }
2743 #endif /* USE_THREADS */
2744
2745     if (!CvXSUB(cv) && CvROOT(cv)) {
2746 #ifdef USE_THREADS
2747         if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr))
2748             croak("Can't undef active subroutine");
2749 #else
2750         if (CvDEPTH(cv))
2751             croak("Can't undef active subroutine");
2752 #endif /* USE_THREADS */
2753         ENTER;
2754
2755         SAVESPTR(curpad);
2756         curpad = 0;
2757
2758         if (!CvCLONED(cv))
2759             op_free(CvROOT(cv));
2760         CvROOT(cv) = Nullop;
2761         LEAVE;
2762     }
2763     SvREFCNT_dec(CvGV(cv));
2764     CvGV(cv) = Nullgv;
2765     SvREFCNT_dec(CvOUTSIDE(cv));
2766     CvOUTSIDE(cv) = Nullcv;
2767     if (CvPADLIST(cv)) {
2768         I32 i = AvFILL(CvPADLIST(cv));
2769         while (i >= 0) {
2770             SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
2771             if (svp)
2772                 SvREFCNT_dec(*svp);
2773         }
2774         SvREFCNT_dec((SV*)CvPADLIST(cv));
2775         CvPADLIST(cv) = Nullav;
2776     }
2777 }
2778
2779 CV *
2780 cv_clone(proto)
2781 CV* proto;
2782 {
2783     dTHR;
2784     AV* av;
2785     I32 ix;
2786     AV* protopadlist = CvPADLIST(proto);
2787     AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
2788     AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
2789     SV** svp = AvARRAY(protopad);
2790     AV* comppadlist;
2791     CV* cv;
2792
2793     ENTER;
2794     SAVESPTR(curpad);
2795     SAVESPTR(comppad);
2796     SAVESPTR(compcv);
2797
2798     cv = compcv = (CV*)NEWSV(1104,0);
2799     sv_upgrade((SV *)cv, SVt_PVCV);
2800     CvCLONED_on(cv);
2801
2802 #ifdef USE_THREADS
2803     New(666, CvMUTEXP(cv), 1, pthread_mutex_t);
2804     MUTEX_INIT(CvMUTEXP(cv));
2805     New(666, CvCONDP(cv), 1, pthread_cond_t);
2806     COND_INIT(CvCONDP(cv));
2807     CvOWNER(cv)         = 0;
2808 #endif /* USE_THREADS */
2809     CvFILEGV(cv)        = CvFILEGV(proto);
2810     CvGV(cv)            = SvREFCNT_inc(CvGV(proto));
2811     CvSTASH(cv)         = CvSTASH(proto);
2812     CvROOT(cv)          = CvROOT(proto);
2813     CvSTART(cv)         = CvSTART(proto);
2814     if (CvOUTSIDE(proto))
2815         CvOUTSIDE(cv)   = (CV*)SvREFCNT_inc((SV*)CvOUTSIDE(proto));
2816
2817     comppad = newAV();
2818
2819     comppadlist = newAV();
2820     AvREAL_off(comppadlist);
2821     av_store(comppadlist, 0, SvREFCNT_inc((SV*)protopad_name));
2822     av_store(comppadlist, 1, (SV*)comppad);
2823     CvPADLIST(cv) = comppadlist;
2824     av_extend(comppad, AvFILL(protopad));
2825     curpad = AvARRAY(comppad);
2826
2827     av = newAV();           /* will be @_ */
2828     av_extend(av, 0);
2829     av_store(comppad, 0, (SV*)av);
2830     AvFLAGS(av) = AVf_REIFY;
2831
2832     svp = AvARRAY(protopad_name);
2833     for ( ix = AvFILL(protopad); ix > 0; ix--) {
2834         SV *sv;
2835         if (svp[ix] != &sv_undef) {
2836             char *name = SvPVX(svp[ix]);    /* XXX */
2837             if (SvFLAGS(svp[ix]) & SVf_FAKE) {  /* lexical from outside? */
2838                 I32 off = pad_findlex(name,ix,curcop->cop_seq, CvOUTSIDE(proto),
2839                                         cxstack_ix);
2840                 if (off != ix)
2841                     croak("panic: cv_clone: %s", name);
2842             }
2843             else {                              /* our own lexical */
2844                 if (*name == '@')
2845                     av_store(comppad, ix, sv = (SV*)newAV());
2846                 else if (*name == '%')
2847                     av_store(comppad, ix, sv = (SV*)newHV());
2848                 else
2849                     av_store(comppad, ix, sv = NEWSV(0,0));
2850                 SvPADMY_on(sv);
2851             }
2852         }
2853         else {
2854             av_store(comppad, ix, sv = NEWSV(0,0));
2855             SvPADTMP_on(sv);
2856         }
2857     }
2858
2859     LEAVE;
2860     return cv;
2861 }
2862
2863 CV *
2864 newSUB(floor,o,proto,block)
2865 I32 floor;
2866 OP *o;
2867 OP *proto;
2868 OP *block;
2869 {
2870     dTHR;
2871     register CV *cv;
2872     char *name = o ? SvPVx(cSVOPo->op_sv, na) : "__ANON__";
2873     GV* gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV);
2874     AV* av;
2875     char *s;
2876     I32 ix;
2877
2878     if (o)
2879         sub_generation++;
2880     if (cv = GvCV(gv)) {
2881         if (GvCVGEN(gv))
2882             cv = 0;                     /* just a cached method */
2883         else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
2884             if (dowarn) {               /* already defined (or promised)? */
2885                 line_t oldline = curcop->cop_line;
2886
2887                 curcop->cop_line = copline;
2888                 warn("Subroutine %s redefined",name);
2889                 curcop->cop_line = oldline;
2890             }
2891             SvREFCNT_dec(cv);
2892             cv = 0;
2893         }
2894     }
2895     if (cv) {                           /* must reuse cv if autoloaded */
2896         cv_undef(cv);
2897         CvOUTSIDE(cv) = CvOUTSIDE(compcv);
2898         CvOUTSIDE(compcv) = 0;
2899         CvPADLIST(cv) = CvPADLIST(compcv);
2900         CvPADLIST(compcv) = 0;
2901         if (SvREFCNT(compcv) > 1) /* XXX Make closures transit through stub. */
2902             CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)cv);
2903         SvREFCNT_dec(compcv);
2904     }
2905     else {
2906         cv = compcv;
2907     }
2908     GvCV(gv) = cv;
2909     GvCVGEN(gv) = 0;
2910     CvFILEGV(cv) = curcop->cop_filegv;
2911     CvGV(cv) = SvREFCNT_inc(gv);
2912     CvSTASH(cv) = curstash;
2913 #ifdef USE_THREADS
2914     CvOWNER(cv) = 0;
2915     New(666, CvMUTEXP(cv), 1, pthread_mutex_t);
2916     MUTEX_INIT(CvMUTEXP(cv));
2917     New(666, CvCONDP(cv), 1, pthread_cond_t);
2918     COND_INIT(CvCONDP(cv));
2919 #endif /* USE_THREADS */
2920
2921     if (proto) {
2922         char *p = SvPVx(((SVOP*)proto)->op_sv, na);
2923         if (SvPOK(cv) && strNE(SvPV((SV*)cv,na), p))
2924             warn("Prototype mismatch: (%s) vs (%s)", SvPV((SV*)cv, na), p);
2925         sv_setpv((SV*)cv, p);
2926         op_free(proto);
2927     }
2928
2929     if (error_count) {
2930         op_free(block);
2931         block = Nullop;
2932     }
2933     if (!block) {
2934         CvROOT(cv) = 0;
2935         op_free(o);
2936         copline = NOLINE;
2937         LEAVE_SCOPE(floor);
2938         return cv;
2939     }
2940
2941     av = newAV();                       /* Will be @_ */
2942     av_extend(av, 0);
2943     av_store(comppad, 0, (SV*)av);
2944     AvFLAGS(av) = AVf_REIFY;
2945
2946     for (ix = AvFILL(comppad); ix > 0; ix--) {
2947         if (!SvPADMY(curpad[ix]))
2948             SvPADTMP_on(curpad[ix]);
2949     }
2950
2951     if (AvFILL(comppad_name) < AvFILL(comppad))
2952         av_store(comppad_name, AvFILL(comppad), Nullsv);
2953
2954     CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
2955     CvSTART(cv) = LINKLIST(CvROOT(cv));
2956     CvROOT(cv)->op_next = 0;
2957     peep(CvSTART(cv));
2958     if (s = strrchr(name,':'))
2959         s++;
2960     else
2961         s = name;
2962     if (strEQ(s, "BEGIN") && !error_count) {
2963         line_t oldline = compiling.cop_line;
2964         SV *oldrs = rs;
2965
2966         ENTER;
2967         SAVESPTR(compiling.cop_filegv);
2968         SAVEI32(perldb);
2969         if (!beginav)
2970             beginav = newAV();
2971         av_push(beginav, (SV *)cv);
2972         DEBUG_x( dump_sub(gv) );
2973         rs = SvREFCNT_inc(nrs);
2974         GvCV(gv) = 0;
2975         calllist(beginav);
2976         SvREFCNT_dec(rs);
2977         rs = oldrs;
2978         curcop = &compiling;
2979         curcop->cop_line = oldline;     /* might have recursed to yylex */
2980         LEAVE;
2981     }
2982     else if (strEQ(s, "END") && !error_count) {
2983         if (!endav)
2984             endav = newAV();
2985         av_unshift(endav, 1);
2986         av_store(endav, 0, SvREFCNT_inc(cv));
2987     }
2988     if (perldb && curstash != debstash) {
2989         SV *sv;
2990         SV *tmpstr = sv_newmortal();
2991
2992         sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
2993         sv = newSVpv(buf,0);
2994         sv_catpv(sv,"-");
2995         sprintf(buf,"%ld",(long)curcop->cop_line);
2996         sv_catpv(sv,buf);
2997         gv_efullname(tmpstr,gv);
2998         hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
2999     }
3000     op_free(o);
3001     copline = NOLINE;
3002     LEAVE_SCOPE(floor);
3003     if (!o) {
3004         GvCV(gv) = 0;   /* Will remember in SVOP instead. */
3005         CvANON_on(cv);
3006     }
3007     return cv;
3008 }
3009
3010 #ifdef DEPRECATED
3011 CV *
3012 newXSUB(name, ix, subaddr, filename)
3013 char *name;
3014 I32 ix;
3015 I32 (*subaddr)();
3016 char *filename;
3017 {
3018     CV* cv = newXS(name, (void(*)())subaddr, filename);
3019     CvOLDSTYLE_on(cv);
3020     CvXSUBANY(cv).any_i32 = ix;
3021     return cv;
3022 }
3023 #endif
3024
3025 CV *
3026 newXS(name, subaddr, filename)
3027 char *name;
3028 void (*subaddr) _((CV*));
3029 char *filename;
3030 {
3031     dTHR;
3032     register CV *cv;
3033     GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV);
3034     char *s;
3035
3036     if (name)
3037         sub_generation++;
3038     if (cv = GvCV(gv)) {
3039         if (GvCVGEN(gv))
3040             cv = 0;                     /* just a cached method */
3041         else if (CvROOT(cv) || CvXSUB(cv)) {    /* already defined? */
3042             if (dowarn) {
3043                 line_t oldline = curcop->cop_line;
3044
3045                 curcop->cop_line = copline;
3046                 warn("Subroutine %s redefined",name);
3047                 curcop->cop_line = oldline;
3048             }
3049             SvREFCNT_dec(cv);
3050             cv = 0;
3051         }
3052     }
3053     if (cv) {                           /* must reuse cv if autoloaded */
3054         assert(SvREFCNT(CvGV(cv)) > 1);
3055         SvREFCNT_dec(CvGV(cv));
3056     }
3057     else {
3058         cv = (CV*)NEWSV(1105,0);
3059         sv_upgrade((SV *)cv, SVt_PVCV);
3060     }
3061     GvCV(gv) = cv;
3062     CvGV(cv) = SvREFCNT_inc(gv);
3063     GvCVGEN(gv) = 0;
3064 #ifdef USE_THREADS
3065     New(666, CvMUTEXP(cv), 1, pthread_mutex_t);
3066     MUTEX_INIT(CvMUTEXP(cv));
3067     New(666, CvCONDP(cv), 1, pthread_cond_t);
3068     COND_INIT(CvCONDP(cv));
3069     CvOWNER(cv) = 0;
3070 #endif /* USE_THREADS */
3071     CvFILEGV(cv) = gv_fetchfile(filename);
3072     CvXSUB(cv) = subaddr;
3073     if (!name)
3074         s = "__ANON__";
3075     else if (s = strrchr(name,':'))
3076         s++;
3077     else
3078         s = name;
3079     if (strEQ(s, "BEGIN")) {
3080         if (!beginav)
3081             beginav = newAV();
3082         av_push(beginav, SvREFCNT_inc(gv));
3083     }
3084     else if (strEQ(s, "END")) {
3085         if (!endav)
3086             endav = newAV();
3087         av_unshift(endav, 1);
3088         av_store(endav, 0, SvREFCNT_inc(gv));
3089     }
3090     if (!name) {
3091         GvCV(gv) = 0;   /* Will remember elsewhere instead. */
3092         CvANON_on(cv);
3093     }
3094     return cv;
3095 }
3096
3097 void
3098 newFORM(floor,o,block)
3099 I32 floor;
3100 OP *o;
3101 OP *block;
3102 {
3103     dTHR;
3104     register CV *cv;
3105     char *name;
3106     GV *gv;
3107     I32 ix;
3108
3109     if (o)
3110         name = SvPVx(cSVOPo->op_sv, na);
3111     else
3112         name = "STDOUT";
3113     gv = gv_fetchpv(name,TRUE, SVt_PVFM);
3114     GvMULTI_on(gv);
3115     if (cv = GvFORM(gv)) {
3116         if (dowarn) {
3117             line_t oldline = curcop->cop_line;
3118
3119             curcop->cop_line = copline;
3120             warn("Format %s redefined",name);
3121             curcop->cop_line = oldline;
3122         }
3123         SvREFCNT_dec(cv);
3124     }
3125     cv = compcv;
3126     GvFORM(gv) = cv;
3127     CvGV(cv) = SvREFCNT_inc(gv);
3128     CvFILEGV(cv) = curcop->cop_filegv;
3129
3130     for (ix = AvFILL(comppad); ix > 0; ix--) {
3131         if (!SvPADMY(curpad[ix]))
3132             SvPADTMP_on(curpad[ix]);
3133     }
3134
3135     CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
3136     CvSTART(cv) = LINKLIST(CvROOT(cv));
3137     CvROOT(cv)->op_next = 0;
3138     peep(CvSTART(cv));
3139     FmLINES(cv) = 0;
3140     op_free(o);
3141     copline = NOLINE;
3142     LEAVE_SCOPE(floor);
3143 }
3144
3145 OP *
3146 newANONLIST(o)
3147 OP* o;
3148 {
3149     return newUNOP(OP_REFGEN, 0,
3150         mod(list(convert(OP_ANONLIST, 0, o)), OP_REFGEN));
3151 }
3152
3153 OP *
3154 newANONHASH(o)
3155 OP* o;
3156 {
3157     return newUNOP(OP_REFGEN, 0,
3158         mod(list(convert(OP_ANONHASH, 0, o)), OP_REFGEN));
3159 }
3160
3161 OP *
3162 newANONSUB(floor, proto, block)
3163 I32 floor;
3164 OP *proto;
3165 OP *block;
3166 {
3167     return newUNOP(OP_REFGEN, 0,
3168         newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, proto, block)));
3169 }
3170
3171 OP *
3172 oopsAV(o)
3173 OP *o;
3174 {
3175     switch (o->op_type) {
3176     case OP_PADSV:
3177         o->op_type = OP_PADAV;
3178         o->op_ppaddr = ppaddr[OP_PADAV];
3179         return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV);
3180
3181     case OP_RV2SV:
3182         o->op_type = OP_RV2AV;
3183         o->op_ppaddr = ppaddr[OP_RV2AV];
3184         ref(o, OP_RV2AV);
3185         break;
3186
3187     default:
3188         warn("oops: oopsAV");
3189         break;
3190     }
3191     return o;
3192 }
3193
3194 OP *
3195 oopsHV(o)
3196 OP *o;
3197 {
3198     switch (o->op_type) {
3199     case OP_PADSV:
3200     case OP_PADAV:
3201         o->op_type = OP_PADHV;
3202         o->op_ppaddr = ppaddr[OP_PADHV];
3203         return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV);
3204
3205     case OP_RV2SV:
3206     case OP_RV2AV:
3207         o->op_type = OP_RV2HV;
3208         o->op_ppaddr = ppaddr[OP_RV2HV];
3209         ref(o, OP_RV2HV);
3210         break;
3211
3212     default:
3213         warn("oops: oopsHV");
3214         break;
3215     }
3216     return o;
3217 }
3218
3219 OP *
3220 newAVREF(o)
3221 OP *o;
3222 {
3223     if (o->op_type == OP_PADANY) {
3224         o->op_type = OP_PADAV;
3225         o->op_ppaddr = ppaddr[OP_PADAV];
3226         return o;
3227     }
3228     return newUNOP(OP_RV2AV, 0, scalar(o));
3229 }
3230
3231 OP *
3232 newGVREF(type,o)
3233 I32 type;
3234 OP *o;
3235 {
3236     if (type == OP_MAPSTART)
3237         return newUNOP(OP_NULL, 0, o);
3238     return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
3239 }
3240
3241 OP *
3242 newHVREF(o)
3243 OP *o;
3244 {
3245     if (o->op_type == OP_PADANY) {
3246         o->op_type = OP_PADHV;
3247         o->op_ppaddr = ppaddr[OP_PADHV];
3248         return o;
3249     }
3250     return newUNOP(OP_RV2HV, 0, scalar(o));
3251 }
3252
3253 OP *
3254 oopsCV(o)
3255 OP *o;
3256 {
3257     croak("NOT IMPL LINE %d",__LINE__);
3258     /* STUB */
3259     return o;
3260 }
3261
3262 OP *
3263 newCVREF(flags, o)
3264 I32 flags;
3265 OP *o;
3266 {
3267     return newUNOP(OP_RV2CV, flags, scalar(o));
3268 }
3269
3270 OP *
3271 newSVREF(o)
3272 OP *o;
3273 {
3274     if (o->op_type == OP_PADANY) {
3275         o->op_type = OP_PADSV;
3276         o->op_ppaddr = ppaddr[OP_PADSV];
3277         return o;
3278     }
3279     return newUNOP(OP_RV2SV, 0, scalar(o));
3280 }
3281
3282 /* Check routines. */
3283
3284 OP *
3285 ck_concat(o)
3286 OP *o;
3287 {
3288     if (cUNOPo->op_first->op_type == OP_CONCAT)
3289         o->op_flags |= OPf_STACKED;
3290     return o;
3291 }
3292
3293 OP *
3294 ck_spair(o)
3295 OP *o;
3296 {
3297     if (o->op_flags & OPf_KIDS) {
3298         OP* newop;
3299         OP* kid;
3300         o = modkids(ck_fun(o), o->op_type);
3301         kid = cUNOPo->op_first;
3302         newop = kUNOP->op_first->op_sibling;
3303         if (newop &&
3304             (newop->op_sibling ||
3305              !(opargs[newop->op_type] & OA_RETSCALAR) ||
3306              newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
3307              newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
3308
3309             return o;
3310         }
3311         op_free(kUNOP->op_first);
3312         kUNOP->op_first = newop;
3313     }
3314     o->op_ppaddr = ppaddr[++o->op_type];
3315     return ck_fun(o);
3316 }
3317
3318 OP *
3319 ck_delete(o)
3320 OP *o;
3321 {
3322     o = ck_fun(o);
3323     if (o->op_flags & OPf_KIDS) {
3324         OP *kid = cUNOPo->op_first;
3325         if (kid->op_type != OP_HELEM)
3326             croak("%s argument is not a HASH element", op_desc[o->op_type]);
3327         null(kid);
3328     }
3329     return o;
3330 }
3331
3332 OP *
3333 ck_eof(o)
3334 OP *o;
3335 {
3336     I32 type = o->op_type;
3337
3338     if (o->op_flags & OPf_KIDS) {
3339         if (cLISTOPo->op_first->op_type == OP_STUB) {
3340             op_free(o);
3341             o = newUNOP(type, OPf_SPECIAL,
3342                 newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV)));
3343         }
3344         return ck_fun(o);
3345     }
3346     return o;
3347 }
3348
3349 OP *
3350 ck_eval(o)
3351 OP *o;
3352 {
3353     hints |= HINT_BLOCK_SCOPE;
3354     if (o->op_flags & OPf_KIDS) {
3355         SVOP *kid = (SVOP*)cUNOPo->op_first;
3356
3357         if (!kid) {
3358             o->op_flags &= ~OPf_KIDS;
3359             null(o);
3360         }
3361         else if (kid->op_type == OP_LINESEQ) {
3362             LOGOP *enter;
3363
3364             kid->op_next = o->op_next;
3365             cUNOPo->op_first = 0;
3366             op_free(o);
3367
3368             Newz(1101, enter, 1, LOGOP);
3369             enter->op_type = OP_ENTERTRY;
3370             enter->op_ppaddr = ppaddr[OP_ENTERTRY];
3371             enter->op_private = 0;
3372
3373             /* establish postfix order */
3374             enter->op_next = (OP*)enter;
3375
3376             o = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
3377             o->op_type = OP_LEAVETRY;
3378             o->op_ppaddr = ppaddr[OP_LEAVETRY];
3379             enter->op_other = o;
3380             return o;
3381         }
3382     }
3383     else {
3384         op_free(o);
3385         o = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3386     }
3387     o->op_targ = (PADOFFSET)hints;
3388     return o;
3389 }
3390
3391 OP *
3392 ck_exec(o)
3393 OP *o;
3394 {
3395     OP *kid;
3396     if (o->op_flags & OPf_STACKED) {
3397         o = ck_fun(o);
3398         kid = cUNOPo->op_first->op_sibling;
3399         if (kid->op_type == OP_RV2GV)
3400             null(kid);
3401     }
3402     else
3403         o = listkids(o);
3404     return o;
3405 }
3406
3407 OP *
3408 ck_gvconst(o)
3409 register OP *o;
3410 {
3411     o = fold_constants(o);
3412     if (o->op_type == OP_CONST)
3413         o->op_type = OP_GV;
3414     return o;
3415 }
3416
3417 OP *
3418 ck_rvconst(o)
3419 register OP *o;
3420 {
3421     dTHR;
3422     SVOP *kid = (SVOP*)cUNOPo->op_first;
3423
3424     o->op_private |= (hints & HINT_STRICT_REFS);
3425     if (kid->op_type == OP_CONST) {
3426         int iscv = (o->op_type==OP_RV2CV)*2;
3427         GV *gv = 0;
3428         kid->op_type = OP_GV;
3429         for (gv = 0; !gv; iscv++) {
3430             /*
3431              * This is a little tricky.  We only want to add the symbol if we
3432              * didn't add it in the lexer.  Otherwise we get duplicate strict
3433              * warnings.  But if we didn't add it in the lexer, we must at
3434              * least pretend like we wanted to add it even if it existed before,
3435              * or we get possible typo warnings.  OPpCONST_ENTERED says
3436              * whether the lexer already added THIS instance of this symbol.
3437              */
3438             gv = gv_fetchpv(SvPVx(kid->op_sv, na),
3439                 iscv | !(kid->op_private & OPpCONST_ENTERED),
3440                 iscv
3441                     ? SVt_PVCV
3442                     : o->op_type == OP_RV2SV
3443                         ? SVt_PV
3444                         : o->op_type == OP_RV2AV
3445                             ? SVt_PVAV
3446                             : o->op_type == OP_RV2HV
3447                                 ? SVt_PVHV
3448                                 : SVt_PVGV);
3449         }
3450         SvREFCNT_dec(kid->op_sv);
3451         kid->op_sv = SvREFCNT_inc(gv);
3452     }
3453     return o;
3454 }
3455
3456 OP *
3457 ck_formline(o)
3458 OP *o;
3459 {
3460     return ck_fun(o);
3461 }
3462
3463 OP *
3464 ck_ftst(o)
3465 OP *o;
3466 {
3467     dTHR;
3468     I32 type = o->op_type;
3469
3470     if (o->op_flags & OPf_REF)
3471         return o;
3472
3473     if (o->op_flags & OPf_KIDS) {
3474         SVOP *kid = (SVOP*)cUNOPo->op_first;
3475
3476         if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
3477             OP *newop = newGVOP(type, OPf_REF,
3478                 gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
3479             op_free(o);
3480             return newop;
3481         }
3482     }
3483     else {
3484         op_free(o);
3485         if (type == OP_FTTTY)
3486             return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
3487                                 SVt_PVIO));
3488         else
3489             return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3490     }
3491     return o;
3492 }
3493
3494 OP *
3495 ck_fun(o)
3496 OP *o;
3497 {
3498     dTHR;
3499     register OP *kid;
3500     OP **tokid;
3501     OP *sibl;
3502     I32 numargs = 0;
3503     int type = o->op_type;
3504     register I32 oa = opargs[type] >> OASHIFT;
3505
3506     if (o->op_flags & OPf_STACKED) {
3507         if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
3508             oa &= ~OA_OPTIONAL;
3509         else
3510             return no_fh_allowed(o);
3511     }
3512
3513     if (o->op_flags & OPf_KIDS) {
3514         tokid = &cLISTOPo->op_first;
3515         kid = cLISTOPo->op_first;
3516         if (kid->op_type == OP_PUSHMARK ||
3517             kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
3518         {
3519             tokid = &kid->op_sibling;
3520             kid = kid->op_sibling;
3521         }
3522         if (!kid && opargs[type] & OA_DEFGV)
3523             *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
3524
3525         while (oa && kid) {
3526             numargs++;
3527             sibl = kid->op_sibling;
3528             switch (oa & 7) {
3529             case OA_SCALAR:
3530                 scalar(kid);
3531                 break;
3532             case OA_LIST:
3533                 if (oa < 16) {
3534                     kid = 0;
3535                     continue;
3536                 }
3537                 else
3538                     list(kid);
3539                 break;
3540             case OA_AVREF:
3541                 if (kid->op_type == OP_CONST &&
3542                   (kid->op_private & OPpCONST_BARE)) {
3543                     char *name = SvPVx(((SVOP*)kid)->op_sv, na);
3544                     OP *newop = newAVREF(newGVOP(OP_GV, 0,
3545                         gv_fetchpv(name, TRUE, SVt_PVAV) ));
3546                     if (dowarn)
3547                         warn("Array @%s missing the @ in argument %d of %s()",
3548                             name, numargs, op_desc[type]);
3549                     op_free(kid);
3550                     kid = newop;
3551                     kid->op_sibling = sibl;
3552                     *tokid = kid;
3553                 }
3554                 else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
3555                     bad_type(numargs, "array", op_desc[o->op_type], kid);
3556                 mod(kid, type);
3557                 break;
3558             case OA_HVREF:
3559                 if (kid->op_type == OP_CONST &&
3560                   (kid->op_private & OPpCONST_BARE)) {
3561                     char *name = SvPVx(((SVOP*)kid)->op_sv, na);
3562                     OP *newop = newHVREF(newGVOP(OP_GV, 0,
3563                         gv_fetchpv(name, TRUE, SVt_PVHV) ));
3564                     if (dowarn)
3565                         warn("Hash %%%s missing the %% in argument %d of %s()",
3566                             name, numargs, op_desc[type]);
3567                     op_free(kid);
3568                     kid = newop;
3569                     kid->op_sibling = sibl;
3570                     *tokid = kid;
3571                 }
3572                 else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
3573                     bad_type(numargs, "hash", op_desc[o->op_type], kid);
3574                 mod(kid, type);
3575                 break;
3576             case OA_CVREF:
3577                 {
3578                     OP *newop = newUNOP(OP_NULL, 0, kid);
3579                     kid->op_sibling = 0;
3580                     linklist(kid);
3581                     newop->op_next = newop;
3582                     kid = newop;
3583                     kid->op_sibling = sibl;
3584                     *tokid = kid;
3585                 }
3586                 break;
3587             case OA_FILEREF:
3588                 if (kid->op_type != OP_GV) {
3589                     if (kid->op_type == OP_CONST &&
3590                       (kid->op_private & OPpCONST_BARE)) {
3591                         OP *newop = newGVOP(OP_GV, 0,
3592                             gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE,
3593                                         SVt_PVIO) );
3594                         op_free(kid);
3595                         kid = newop;
3596                     }
3597                     else {
3598                         kid->op_sibling = 0;
3599                         kid = newUNOP(OP_RV2GV, 0, scalar(kid));
3600                     }
3601                     kid->op_sibling = sibl;
3602                     *tokid = kid;
3603                 }
3604                 scalar(kid);
3605                 break;
3606             case OA_SCALARREF:
3607                 mod(scalar(kid), type);
3608                 break;
3609             }
3610             oa >>= 4;
3611             tokid = &kid->op_sibling;
3612             kid = kid->op_sibling;
3613         }
3614         o->op_private |= numargs;
3615         if (kid)
3616             return too_many_arguments(o,op_desc[o->op_type]);
3617         listkids(o);
3618     }
3619     else if (opargs[type] & OA_DEFGV) {
3620         op_free(o);
3621         return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3622     }
3623
3624     if (oa) {
3625         while (oa & OA_OPTIONAL)
3626             oa >>= 4;
3627         if (oa && oa != OA_LIST)
3628             return too_few_arguments(o,op_desc[o->op_type]);
3629     }
3630     return o;
3631 }
3632
3633 OP *
3634 ck_glob(o)
3635 OP *o;
3636 {
3637     GV *gv = newGVgen("main");
3638     gv_IOadd(gv);
3639     append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
3640     scalarkids(o);
3641     return ck_fun(o);
3642 }
3643
3644 OP *
3645 ck_grep(o)
3646 OP *o;
3647 {
3648     LOGOP *gwop;
3649     OP *kid;
3650     OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
3651
3652     o->op_ppaddr = ppaddr[OP_GREPSTART];
3653     Newz(1101, gwop, 1, LOGOP);
3654
3655     if (o->op_flags & OPf_STACKED) {
3656         OP* k;
3657         o = ck_sort(o);
3658         kid = cLISTOPo->op_first->op_sibling;
3659         for (k = cLISTOPo->op_first->op_sibling->op_next; k; k = k->op_next) {
3660             kid = k;
3661         }
3662         kid->op_next = (OP*)gwop;
3663         o->op_flags &= ~OPf_STACKED;
3664     }
3665     kid = cLISTOPo->op_first->op_sibling;
3666     if (type == OP_MAPWHILE)
3667         list(kid);
3668     else
3669         scalar(kid);
3670     o = ck_fun(o);
3671     if (error_count)
3672         return o;
3673     kid = cLISTOPo->op_first->op_sibling;
3674     if (kid->op_type != OP_NULL)
3675         croak("panic: ck_grep");
3676     kid = kUNOP->op_first;
3677
3678     gwop->op_type = type;
3679     gwop->op_ppaddr = ppaddr[type];
3680     gwop->op_first = listkids(o);
3681     gwop->op_flags |= OPf_KIDS;
3682     gwop->op_private = 1;
3683     gwop->op_other = LINKLIST(kid);
3684     gwop->op_targ = pad_alloc(type, SVs_PADTMP);
3685     kid->op_next = (OP*)gwop;
3686
3687     kid = cLISTOPo->op_first->op_sibling;
3688     if (!kid || !kid->op_sibling)
3689         return too_few_arguments(o,op_desc[o->op_type]);
3690     for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
3691         mod(kid, OP_GREPSTART);
3692
3693     return (OP*)gwop;
3694 }
3695
3696 OP *
3697 ck_index(o)
3698 OP *o;
3699 {
3700     if (o->op_flags & OPf_KIDS) {
3701         OP *kid = cLISTOPo->op_first->op_sibling;       /* get past pushmark */
3702         if (kid && kid->op_type == OP_CONST)
3703             fbm_compile(((SVOP*)kid)->op_sv, 0);
3704     }
3705     return ck_fun(o);
3706 }
3707
3708 OP *
3709 ck_lengthconst(o)
3710 OP *o;
3711 {
3712     /* XXX length optimization goes here */
3713     return ck_fun(o);
3714 }
3715
3716 OP *
3717 ck_lfun(o)
3718 OP *o;
3719 {
3720     return modkids(ck_fun(o), o->op_type);
3721 }
3722
3723 OP *
3724 ck_rfun(o)
3725 OP *o;
3726 {
3727     return refkids(ck_fun(o), o->op_type);
3728 }
3729
3730 OP *
3731 ck_listiob(o)
3732 OP *o;
3733 {
3734     register OP *kid;
3735
3736     kid = cLISTOPo->op_first;
3737     if (!kid) {
3738         o = force_list(o);
3739         kid = cLISTOPo->op_first;
3740     }
3741     if (kid->op_type == OP_PUSHMARK)
3742         kid = kid->op_sibling;
3743     if (kid && o->op_flags & OPf_STACKED)
3744         kid = kid->op_sibling;
3745     else if (kid && !kid->op_sibling) {         /* print HANDLE; */
3746         if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
3747             o->op_flags |= OPf_STACKED; /* make it a filehandle */
3748             kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
3749             cLISTOPo->op_first->op_sibling = kid;
3750             cLISTOPo->op_last = kid;
3751             kid = kid->op_sibling;
3752         }
3753     }
3754
3755     if (!kid)
3756         append_elem(o->op_type, o, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3757
3758     return listkids(o);
3759 }
3760
3761 OP *
3762 ck_match(o)
3763 OP *o;
3764 {
3765     cPMOPo->op_pmflags |= PMf_RUNTIME;
3766     cPMOPo->op_pmpermflags |= PMf_RUNTIME;
3767     return o;
3768 }
3769
3770 OP *
3771 ck_null(o)
3772 OP *o;
3773 {
3774     return o;
3775 }
3776
3777 OP *
3778 ck_repeat(o)
3779 OP *o;
3780 {
3781     if (cBINOPo->op_first->op_flags & OPf_PARENS) {
3782         o->op_private |= OPpREPEAT_DOLIST;
3783         cBINOPo->op_first = force_list(cBINOPo->op_first);
3784     }
3785     else
3786         scalar(o);
3787     return o;
3788 }
3789
3790 OP *
3791 ck_require(o)
3792 OP *o;
3793 {
3794     if (o->op_flags & OPf_KIDS) {       /* Shall we supply missing .pm? */
3795         SVOP *kid = (SVOP*)cUNOPo->op_first;
3796
3797         if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
3798             char *s;
3799             for (s = SvPVX(kid->op_sv); *s; s++) {
3800                 if (*s == ':' && s[1] == ':') {
3801                     *s = '/';
3802                     Move(s+2, s+1, strlen(s+2)+1, char);
3803                     --SvCUR(kid->op_sv);
3804                 }
3805             }
3806             sv_catpvn(kid->op_sv, ".pm", 3);
3807         }
3808     }
3809     return ck_fun(o);
3810 }
3811
3812 OP *
3813 ck_retarget(o)
3814 OP *o;
3815 {
3816     croak("NOT IMPL LINE %d",__LINE__);
3817     /* STUB */
3818     return o;
3819 }
3820
3821 OP *
3822 ck_select(o)
3823 OP *o;
3824 {
3825     OP* kid;
3826     if (o->op_flags & OPf_KIDS) {
3827         kid = cLISTOPo->op_first->op_sibling;   /* get past pushmark */
3828         if (kid && kid->op_sibling) {
3829             o->op_type = OP_SSELECT;
3830             o->op_ppaddr = ppaddr[OP_SSELECT];
3831             o = ck_fun(o);
3832             return fold_constants(o);
3833         }
3834     }
3835     o = ck_fun(o);
3836     kid = cLISTOPo->op_first->op_sibling;    /* get past pushmark */
3837     if (kid && kid->op_type == OP_RV2GV)
3838         kid->op_private &= ~HINT_STRICT_REFS;
3839     return o;
3840 }
3841
3842 OP *
3843 ck_shift(o)
3844 OP *o;
3845 {
3846     I32 type = o->op_type;
3847
3848     if (!(o->op_flags & OPf_KIDS)) {
3849         op_free(o);
3850         return newUNOP(type, 0,
3851             scalar(newUNOP(OP_RV2AV, 0,
3852                 scalar(newGVOP(OP_GV, 0,
3853                     gv_fetchpv((subline ? "_" : "ARGV"), TRUE, SVt_PVAV) )))));
3854     }
3855     return scalar(modkids(ck_fun(o), type));
3856 }
3857
3858 OP *
3859 ck_sort(o)
3860 OP *o;
3861 {
3862     if (o->op_flags & OPf_STACKED) {
3863         OP *kid = cLISTOPo->op_first->op_sibling;       /* get past pushmark */
3864         OP *k;
3865         kid = kUNOP->op_first;                          /* get past rv2gv */
3866
3867         if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
3868             linklist(kid);
3869             if (kid->op_type == OP_SCOPE) {
3870                 k = kid->op_next;
3871                 kid->op_next = 0;
3872             }
3873             else if (kid->op_type == OP_LEAVE) {
3874                 if (o->op_type == OP_SORT) {
3875                     null(kid);                  /* wipe out leave */
3876                     kid->op_next = kid;
3877
3878                     for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
3879                         if (k->op_next == kid)
3880                             k->op_next = 0;
3881                     }
3882                 }
3883                 else
3884                     kid->op_next = 0;           /* just disconnect the leave */
3885                 k = kLISTOP->op_first;
3886             }
3887             peep(k);
3888
3889             kid = cLISTOPo->op_first->op_sibling;       /* get past pushmark */
3890             null(kid);                                  /* wipe out rv2gv */
3891             if (o->op_type == OP_SORT)
3892                 kid->op_next = kid;
3893             else
3894                 kid->op_next = k;
3895             o->op_flags |= OPf_SPECIAL;
3896         }
3897     }
3898     return o;
3899 }
3900
3901 OP *
3902 ck_split(o)
3903 OP *o;
3904 {
3905     register OP *kid;
3906     PMOP* pm;
3907
3908     if (o->op_flags & OPf_STACKED)
3909         return no_fh_allowed(o);
3910
3911     kid = cLISTOPo->op_first;
3912     if (kid->op_type != OP_NULL)
3913         croak("panic: ck_split");
3914     kid = kid->op_sibling;
3915     op_free(cLISTOPo->op_first);
3916     cLISTOPo->op_first = kid;
3917     if (!kid) {
3918         cLISTOPo->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
3919         cLISTOPo->op_last = kid; /* There was only one element previously */
3920     }
3921
3922     if (kid->op_type != OP_MATCH) {
3923         OP *sibl = kid->op_sibling;
3924         kid->op_sibling = 0;
3925         kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
3926         if (cLISTOPo->op_first == cLISTOPo->op_last)
3927             cLISTOPo->op_last = kid;
3928         cLISTOPo->op_first = kid;
3929         kid->op_sibling = sibl;
3930     }
3931     pm = (PMOP*)kid;
3932     if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
3933         SvREFCNT_dec(pm->op_pmshort);   /* can't use substring to optimize */
3934         pm->op_pmshort = 0;
3935     }
3936
3937     kid->op_type = OP_PUSHRE;
3938     kid->op_ppaddr = ppaddr[OP_PUSHRE];
3939     scalar(kid);
3940
3941     if (!kid->op_sibling)
3942         append_elem(OP_SPLIT, o, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3943
3944     kid = kid->op_sibling;
3945     scalar(kid);
3946
3947     if (!kid->op_sibling)
3948         append_elem(OP_SPLIT, o, newSVOP(OP_CONST, 0, newSViv(0)));
3949
3950     kid = kid->op_sibling;
3951     scalar(kid);
3952
3953     if (kid->op_sibling)
3954         return too_many_arguments(o,op_desc[o->op_type]);
3955
3956     return o;
3957 }
3958
3959 OP *
3960 ck_subr(o)
3961 OP *o;
3962 {
3963     dTHR;
3964     OP *prev = ((cUNOPo->op_first->op_sibling)
3965              ? cUNOPo : ((UNOP*)cUNOPo->op_first))->op_first;
3966     OP *o2 = prev->op_sibling;
3967     OP *cvop;
3968     char *proto = 0;
3969     CV *cv = 0;
3970     int optional = 0;
3971     I32 arg = 0;
3972
3973     for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
3974     if (cvop->op_type == OP_RV2CV) {
3975         SVOP* tmpop;
3976         o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
3977         null(cvop);             /* disable rv2cv */
3978         tmpop = (SVOP*)((UNOP*)cvop)->op_first;
3979         if (tmpop->op_type == OP_GV) {
3980             cv = GvCV(tmpop->op_sv);
3981             if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER))
3982                 proto = SvPV((SV*)cv,na);
3983         }
3984     }
3985     o->op_private |= (hints & HINT_STRICT_REFS);
3986     if (perldb && curstash != debstash)
3987         o->op_private |= OPpENTERSUB_DB;
3988     while (o2 != cvop) {
3989         if (proto) {
3990             switch (*proto) {
3991             case '\0':
3992                 return too_many_arguments(o, CvNAME(cv));
3993             case ';':
3994                 optional = 1;
3995                 proto++;
3996                 continue;
3997             case '$':
3998                 proto++;
3999                 arg++;
4000                 scalar(o2);
4001                 break;
4002             case '%':
4003             case '@':
4004                 list(o2);
4005                 arg++;
4006                 break;
4007             case '&':
4008                 proto++;
4009                 arg++;
4010                 if (o2->op_type != OP_REFGEN && o2->op_type != OP_UNDEF)
4011                     bad_type(arg, "block", CvNAME(cv), o2);
4012                 break;
4013             case '*':
4014                 proto++;
4015                 arg++;
4016                 if (o2->op_type == OP_RV2GV)
4017                     goto wrapref;
4018                 {
4019                     OP* kid = o2;
4020                     o2 = newUNOP(OP_RV2GV, 0, kid);
4021                     o2->op_sibling = kid->op_sibling;
4022                     kid->op_sibling = 0;
4023                     prev->op_sibling = o;
4024                 }
4025                 goto wrapref;
4026             case '\\':
4027                 proto++;
4028                 arg++;
4029                 switch (*proto++) {
4030                 case '*':
4031                     if (o2->op_type != OP_RV2GV)
4032                         bad_type(arg, "symbol", CvNAME(cv), o2);
4033                     goto wrapref;
4034                 case '&':
4035                     if (o2->op_type != OP_RV2CV)
4036                         bad_type(arg, "sub", CvNAME(cv), o2);
4037                     goto wrapref;
4038                 case '$':
4039                     if (o2->op_type != OP_RV2SV && o2->op_type != OP_PADSV)
4040                         bad_type(arg, "scalar", CvNAME(cv), o2);
4041                     goto wrapref;
4042                 case '@':
4043                     if (o2->op_type != OP_RV2AV && o2->op_type != OP_PADAV)
4044                         bad_type(arg, "array", CvNAME(cv), o2);
4045                     goto wrapref;
4046                 case '%':
4047                     if (o2->op_type != OP_RV2HV && o2->op_type != OP_PADHV)
4048                         bad_type(arg, "hash", CvNAME(cv), o2);
4049                   wrapref:
4050                     {
4051                         OP* kid = o2;
4052                         o2 = newUNOP(OP_REFGEN, 0, kid);
4053                         o2->op_sibling = kid->op_sibling;
4054                         kid->op_sibling = 0;
4055                         prev->op_sibling = o;
4056                     }
4057                     break;
4058                 default: goto oops;
4059                 }
4060                 break;
4061             default:
4062               oops:
4063                 croak("Malformed prototype for %s: %s",
4064                         CvNAME(cv),SvPV((SV*)cv,na));
4065             }
4066         }
4067         else
4068             list(o2);
4069         mod(o2, OP_ENTERSUB);
4070         prev = o2;
4071         o2 = o2->op_sibling;
4072     }
4073     if (proto && !optional && *proto == '$')
4074         return too_few_arguments(o, CvNAME(cv));
4075     return o;
4076 }
4077
4078 OP *
4079 ck_svconst(o)
4080 OP *o;
4081 {
4082     SvREADONLY_on(cSVOPo->op_sv);
4083     return o;
4084 }
4085
4086 OP *
4087 ck_trunc(o)
4088 OP *o;
4089 {
4090     if (o->op_flags & OPf_KIDS) {
4091         SVOP *kid = (SVOP*)cUNOPo->op_first;
4092
4093         if (kid->op_type == OP_NULL)
4094             kid = (SVOP*)kid->op_sibling;
4095         if (kid &&
4096           kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
4097             o->op_flags |= OPf_SPECIAL;
4098     }
4099     return ck_fun(o);
4100 }
4101
4102 /* A peephole optimizer.  We visit the ops in the order they're to execute. */
4103
4104 void
4105 peep(o)
4106 register OP* o;
4107 {
4108     dTHR;
4109     register OP* oldop = 0;
4110     if (!o || o->op_seq)
4111         return;
4112     ENTER;
4113     SAVESPTR(op);
4114     SAVESPTR(curcop);
4115     for (; o; o = o->op_next) {
4116         if (o->op_seq)
4117             break;
4118         if (!op_seqmax)
4119             op_seqmax++;
4120         op = o;
4121         switch (o->op_type) {
4122         case OP_NEXTSTATE:
4123         case OP_DBSTATE:
4124             curcop = ((COP*)o);         /* for warnings */
4125             o->op_seq = op_seqmax++;
4126             break;
4127
4128         case OP_CONCAT:
4129         case OP_CONST:
4130         case OP_JOIN:
4131         case OP_UC:
4132         case OP_UCFIRST:
4133         case OP_LC:
4134         case OP_LCFIRST:
4135         case OP_QUOTEMETA:
4136             if (o->op_next->op_type == OP_STRINGIFY)
4137                 null(o->op_next);
4138             o->op_seq = op_seqmax++;
4139             break;
4140         case OP_STUB:
4141             if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) {
4142                 o->op_seq = op_seqmax++;
4143                 break;  /* Scalar stub must produce undef.  List stub is noop */
4144             }
4145             goto nothin;
4146         case OP_NULL:
4147             if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
4148                 curcop = ((COP*)op);
4149             goto nothin;
4150         case OP_SCALAR:
4151         case OP_LINESEQ:
4152         case OP_SCOPE:
4153           nothin:
4154             if (oldop && o->op_next) {
4155                 oldop->op_next = o->op_next;
4156                 continue;
4157             }
4158             o->op_seq = op_seqmax++;
4159             break;
4160
4161         case OP_GV:
4162             if (o->op_next->op_type == OP_RV2SV) {
4163                 if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) {
4164                     null(o->op_next);
4165                     o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
4166                     o->op_next = o->op_next->op_next;
4167                     o->op_type = OP_GVSV;
4168                     o->op_ppaddr = ppaddr[OP_GVSV];
4169                 }
4170             }
4171             else if (o->op_next->op_type == OP_RV2AV) {
4172                 OP* pop = o->op_next->op_next;
4173                 IV i;
4174                 if (pop->op_type == OP_CONST &&
4175                     (op = pop->op_next) &&
4176                     pop->op_next->op_type == OP_AELEM &&
4177                     !(pop->op_next->op_private &
4178                         (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) &&
4179                     (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
4180                                 <= 255 &&
4181                     i >= 0)
4182                 {
4183                     SvREFCNT_dec(((SVOP*)pop)->op_sv);
4184                     null(o->op_next);
4185                     null(pop->op_next);
4186                     null(pop);
4187                     o->op_flags |= pop->op_next->op_flags & OPf_MOD;
4188                     o->op_next = pop->op_next->op_next;
4189                     o->op_type = OP_AELEMFAST;
4190                     o->op_ppaddr = ppaddr[OP_AELEMFAST];
4191                     o->op_private = (U8)i;
4192                     GvAVn((GV*)(((SVOP*)o)->op_sv));
4193                 }
4194             }
4195             o->op_seq = op_seqmax++;
4196             break;
4197
4198         case OP_MAPWHILE:
4199         case OP_GREPWHILE:
4200         case OP_AND:
4201         case OP_OR:
4202             o->op_seq = op_seqmax++;
4203             peep(cLOGOP->op_other);
4204             break;
4205
4206         case OP_COND_EXPR:
4207             o->op_seq = op_seqmax++;
4208             peep(cCONDOP->op_true);
4209             peep(cCONDOP->op_false);
4210             break;
4211
4212         case OP_ENTERLOOP:
4213             o->op_seq = op_seqmax++;
4214             peep(cLOOP->op_redoop);
4215             peep(cLOOP->op_nextop);
4216             peep(cLOOP->op_lastop);
4217             break;
4218
4219         case OP_MATCH:
4220         case OP_SUBST:
4221             o->op_seq = op_seqmax++;
4222             peep(cPMOP->op_pmreplstart);
4223             break;
4224
4225         case OP_EXEC:
4226             o->op_seq = op_seqmax++;
4227             if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
4228                 if (o->op_next->op_sibling &&
4229                         o->op_next->op_sibling->op_type != OP_DIE) {
4230                     line_t oldline = curcop->cop_line;
4231
4232                     curcop->cop_line = ((COP*)o->op_next)->cop_line;
4233                     warn("Statement unlikely to be reached");
4234                     warn("(Maybe you meant system() when you said exec()?)\n");
4235                     curcop->cop_line = oldline;
4236                 }
4237             }
4238             break;
4239         default:
4240             o->op_seq = op_seqmax++;
4241             break;
4242         }
4243         oldop = o;
4244     }
4245     LEAVE;
4246 }