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     dTHR;
2512     CONDOP *condop;
2513     OP *flip;
2514     OP *flop;
2515     OP *o;
2516
2517     Newz(1101, condop, 1, CONDOP);
2518
2519     condop->op_type = OP_RANGE;
2520     condop->op_ppaddr = ppaddr[OP_RANGE];
2521     condop->op_first = left;
2522     condop->op_flags = OPf_KIDS;
2523     condop->op_true = LINKLIST(left);
2524     condop->op_false = LINKLIST(right);
2525     condop->op_private = 1 | (flags >> 8);
2526
2527     left->op_sibling = right;
2528
2529     condop->op_next = (OP*)condop;
2530     flip = newUNOP(OP_FLIP, flags, (OP*)condop);
2531     flop = newUNOP(OP_FLOP, 0, flip);
2532     o = newUNOP(OP_NULL, 0, flop);
2533     linklist(flop);
2534
2535     left->op_next = flip;
2536     right->op_next = flop;
2537
2538     condop->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
2539     sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV);
2540     flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
2541     sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
2542
2543     flip->op_private =  left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
2544     flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
2545
2546     flip->op_next = o;
2547     if (!flip->op_private || !flop->op_private)
2548         linklist(o);            /* blow off optimizer unless constant */
2549
2550     return o;
2551 }
2552
2553 OP *
2554 newLOOPOP(flags, debuggable, expr, block)
2555 I32 flags;
2556 I32 debuggable;
2557 OP *expr;
2558 OP *block;
2559 {
2560     dTHR;
2561     OP* listop;
2562     OP* o;
2563     int once = block && block->op_flags & OPf_SPECIAL &&
2564       (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
2565
2566     if (expr) {
2567         if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
2568             return block;       /* do {} while 0 does once */
2569         else if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)
2570             expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr);
2571     }
2572
2573     listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
2574     o = newLOGOP(OP_AND, 0, expr, listop);
2575
2576     ((LISTOP*)listop)->op_last->op_next = LINKLIST(o);
2577
2578     if (once && o != listop)
2579         o->op_next = ((LOGOP*)cUNOPo->op_first)->op_other;
2580
2581     if (o == listop)
2582         o = newUNOP(OP_NULL, 0, o);     /* or do {} while 1 loses outer block */
2583
2584     o->op_flags |= flags;
2585     o = scope(o);
2586     o->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/
2587     return o;
2588 }
2589
2590 OP *
2591 newWHILEOP(flags, debuggable, loop, expr, block, cont)
2592 I32 flags;
2593 I32 debuggable;
2594 LOOP *loop;
2595 OP *expr;
2596 OP *block;
2597 OP *cont;
2598 {
2599     dTHR;
2600     OP *redo;
2601     OP *next = 0;
2602     OP *listop;
2603     OP *o;
2604     OP *condop;
2605
2606     if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) {
2607         expr = newUNOP(OP_DEFINED, 0,
2608             newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
2609     }
2610
2611     if (!block)
2612         block = newOP(OP_NULL, 0);
2613
2614     if (cont)
2615         next = LINKLIST(cont);
2616     if (expr)
2617         cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
2618
2619     listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
2620     redo = LINKLIST(listop);
2621
2622     if (expr) {
2623         o = newLOGOP(OP_AND, 0, expr, scalar(listop));
2624         if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) {
2625             op_free(expr);              /* oops, it's a while (0) */
2626             op_free((OP*)loop);
2627             return Nullop;              /* (listop already freed by newLOGOP) */
2628         }
2629         ((LISTOP*)listop)->op_last->op_next = condop =
2630             (o == listop ? redo : LINKLIST(o));
2631         if (!next)
2632             next = condop;
2633     }
2634     else
2635         o = listop;
2636
2637     if (!loop) {
2638         Newz(1101,loop,1,LOOP);
2639         loop->op_type = OP_ENTERLOOP;
2640         loop->op_ppaddr = ppaddr[OP_ENTERLOOP];
2641         loop->op_private = 0;
2642         loop->op_next = (OP*)loop;
2643     }
2644
2645     o = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, o);
2646
2647     loop->op_redoop = redo;
2648     loop->op_lastop = o;
2649
2650     if (next)
2651         loop->op_nextop = next;
2652     else
2653         loop->op_nextop = o;
2654
2655     o->op_flags |= flags;
2656     o->op_private |= (flags >> 8);
2657     return o;
2658 }
2659
2660 OP *
2661 #ifndef CAN_PROTOTYPE
2662 newFOROP(flags,label,forline,sv,expr,block,cont)
2663 I32 flags;
2664 char *label;
2665 line_t forline;
2666 OP* sv;
2667 OP* expr;
2668 OP*block;
2669 OP*cont;
2670 #else
2671 newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
2672 #endif /* CAN_PROTOTYPE */
2673 {
2674     LOOP *loop;
2675     int padoff = 0;
2676     I32 iterflags = 0;
2677
2678     copline = forline;
2679     if (sv) {
2680         if (sv->op_type == OP_RV2SV) {  /* symbol table variable */
2681             sv->op_type = OP_RV2GV;
2682             sv->op_ppaddr = ppaddr[OP_RV2GV];
2683         }
2684         else if (sv->op_type == OP_PADSV) { /* private variable */
2685             padoff = sv->op_targ;
2686             op_free(sv);
2687             sv = Nullop;
2688         }
2689         else
2690             croak("Can't use %s for loop variable", op_desc[sv->op_type]);
2691     }
2692     else {
2693         sv = newGVOP(OP_GV, 0, defgv);
2694     }
2695     if (expr->op_type == OP_RV2AV) {
2696         expr = scalar(ref(expr, OP_ITER));
2697         iterflags |= OPf_STACKED;
2698     }
2699     loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
2700         append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART),
2701                     scalar(sv))));
2702     assert(!loop->op_next);
2703     Renew(loop, 1, LOOP);
2704     loop->op_targ = padoff;
2705     return newSTATEOP(0, label, newWHILEOP(flags, 1, loop,
2706         newOP(OP_ITER, 0), block, cont));
2707 }
2708
2709 OP*
2710 newLOOPEX(type, label)
2711 I32 type;
2712 OP* label;
2713 {
2714     dTHR;
2715     OP *o;
2716     if (type != OP_GOTO || label->op_type == OP_CONST) {
2717         o = newPVOP(type, 0, savepv(
2718                 label->op_type == OP_CONST
2719                     ? SvPVx(((SVOP*)label)->op_sv, na)
2720                     : "" ));
2721         op_free(label);
2722     }
2723     else {
2724         if (label->op_type == OP_ENTERSUB)
2725             label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
2726         o = newUNOP(type, OPf_STACKED, label);
2727     }
2728     hints |= HINT_BLOCK_SCOPE;
2729     return o;
2730 }
2731
2732 void
2733 cv_undef(cv)
2734 CV *cv;
2735 {
2736     dTHR;
2737 #ifdef USE_THREADS
2738     MUTEX_DESTROY(CvMUTEXP(cv));
2739     Safefree(CvMUTEXP(cv));
2740     if (CvCONDP(cv)) {
2741         COND_DESTROY(CvCONDP(cv));
2742         Safefree(CvCONDP(cv));
2743     }
2744 #endif /* USE_THREADS */
2745
2746     if (!CvXSUB(cv) && CvROOT(cv)) {
2747 #ifdef USE_THREADS
2748         if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr))
2749             croak("Can't undef active subroutine");
2750 #else
2751         if (CvDEPTH(cv))
2752             croak("Can't undef active subroutine");
2753 #endif /* USE_THREADS */
2754         ENTER;
2755
2756         SAVESPTR(curpad);
2757         curpad = 0;
2758
2759         if (!CvCLONED(cv))
2760             op_free(CvROOT(cv));
2761         CvROOT(cv) = Nullop;
2762         LEAVE;
2763     }
2764     SvREFCNT_dec(CvGV(cv));
2765     CvGV(cv) = Nullgv;
2766     SvREFCNT_dec(CvOUTSIDE(cv));
2767     CvOUTSIDE(cv) = Nullcv;
2768     if (CvPADLIST(cv)) {
2769         I32 i = AvFILL(CvPADLIST(cv));
2770         while (i >= 0) {
2771             SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
2772             if (svp)
2773                 SvREFCNT_dec(*svp);
2774         }
2775         SvREFCNT_dec((SV*)CvPADLIST(cv));
2776         CvPADLIST(cv) = Nullav;
2777     }
2778 }
2779
2780 CV *
2781 cv_clone(proto)
2782 CV* proto;
2783 {
2784     dTHR;
2785     AV* av;
2786     I32 ix;
2787     AV* protopadlist = CvPADLIST(proto);
2788     AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
2789     AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
2790     SV** svp = AvARRAY(protopad);
2791     AV* comppadlist;
2792     CV* cv;
2793
2794     ENTER;
2795     SAVESPTR(curpad);
2796     SAVESPTR(comppad);
2797     SAVESPTR(compcv);
2798
2799     cv = compcv = (CV*)NEWSV(1104,0);
2800     sv_upgrade((SV *)cv, SVt_PVCV);
2801     CvCLONED_on(cv);
2802
2803 #ifdef USE_THREADS
2804     New(666, CvMUTEXP(cv), 1, pthread_mutex_t);
2805     MUTEX_INIT(CvMUTEXP(cv));
2806     New(666, CvCONDP(cv), 1, pthread_cond_t);
2807     COND_INIT(CvCONDP(cv));
2808     CvOWNER(cv)         = 0;
2809 #endif /* USE_THREADS */
2810     CvFILEGV(cv)        = CvFILEGV(proto);
2811     CvGV(cv)            = SvREFCNT_inc(CvGV(proto));
2812     CvSTASH(cv)         = CvSTASH(proto);
2813     CvROOT(cv)          = CvROOT(proto);
2814     CvSTART(cv)         = CvSTART(proto);
2815     if (CvOUTSIDE(proto))
2816         CvOUTSIDE(cv)   = (CV*)SvREFCNT_inc((SV*)CvOUTSIDE(proto));
2817
2818     comppad = newAV();
2819
2820     comppadlist = newAV();
2821     AvREAL_off(comppadlist);
2822     av_store(comppadlist, 0, SvREFCNT_inc((SV*)protopad_name));
2823     av_store(comppadlist, 1, (SV*)comppad);
2824     CvPADLIST(cv) = comppadlist;
2825     av_extend(comppad, AvFILL(protopad));
2826     curpad = AvARRAY(comppad);
2827
2828     av = newAV();           /* will be @_ */
2829     av_extend(av, 0);
2830     av_store(comppad, 0, (SV*)av);
2831     AvFLAGS(av) = AVf_REIFY;
2832
2833     svp = AvARRAY(protopad_name);
2834     for ( ix = AvFILL(protopad); ix > 0; ix--) {
2835         SV *sv;
2836         if (svp[ix] != &sv_undef) {
2837             char *name = SvPVX(svp[ix]);    /* XXX */
2838             if (SvFLAGS(svp[ix]) & SVf_FAKE) {  /* lexical from outside? */
2839                 I32 off = pad_findlex(name,ix,curcop->cop_seq, CvOUTSIDE(proto),
2840                                         cxstack_ix);
2841                 if (off != ix)
2842                     croak("panic: cv_clone: %s", name);
2843             }
2844             else {                              /* our own lexical */
2845                 if (*name == '@')
2846                     av_store(comppad, ix, sv = (SV*)newAV());
2847                 else if (*name == '%')
2848                     av_store(comppad, ix, sv = (SV*)newHV());
2849                 else
2850                     av_store(comppad, ix, sv = NEWSV(0,0));
2851                 SvPADMY_on(sv);
2852             }
2853         }
2854         else {
2855             av_store(comppad, ix, sv = NEWSV(0,0));
2856             SvPADTMP_on(sv);
2857         }
2858     }
2859
2860     LEAVE;
2861     return cv;
2862 }
2863
2864 CV *
2865 newSUB(floor,o,proto,block)
2866 I32 floor;
2867 OP *o;
2868 OP *proto;
2869 OP *block;
2870 {
2871     dTHR;
2872     register CV *cv;
2873     char *name = o ? SvPVx(cSVOPo->op_sv, na) : "__ANON__";
2874     GV* gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV);
2875     AV* av;
2876     char *s;
2877     I32 ix;
2878
2879     if (o)
2880         sub_generation++;
2881     if (cv = GvCV(gv)) {
2882         if (GvCVGEN(gv))
2883             cv = 0;                     /* just a cached method */
2884         else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
2885             if (dowarn) {               /* already defined (or promised)? */
2886                 line_t oldline = curcop->cop_line;
2887
2888                 curcop->cop_line = copline;
2889                 warn("Subroutine %s redefined",name);
2890                 curcop->cop_line = oldline;
2891             }
2892             SvREFCNT_dec(cv);
2893             cv = 0;
2894         }
2895     }
2896     if (cv) {                           /* must reuse cv if autoloaded */
2897         cv_undef(cv);
2898         CvOUTSIDE(cv) = CvOUTSIDE(compcv);
2899         CvOUTSIDE(compcv) = 0;
2900         CvPADLIST(cv) = CvPADLIST(compcv);
2901         CvPADLIST(compcv) = 0;
2902         if (SvREFCNT(compcv) > 1) /* XXX Make closures transit through stub. */
2903             CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)cv);
2904         SvREFCNT_dec(compcv);
2905     }
2906     else {
2907         cv = compcv;
2908     }
2909     GvCV(gv) = cv;
2910     GvCVGEN(gv) = 0;
2911     CvFILEGV(cv) = curcop->cop_filegv;
2912     CvGV(cv) = SvREFCNT_inc(gv);
2913     CvSTASH(cv) = curstash;
2914 #ifdef USE_THREADS
2915     CvOWNER(cv) = 0;
2916     New(666, CvMUTEXP(cv), 1, pthread_mutex_t);
2917     MUTEX_INIT(CvMUTEXP(cv));
2918     New(666, CvCONDP(cv), 1, pthread_cond_t);
2919     COND_INIT(CvCONDP(cv));
2920 #endif /* USE_THREADS */
2921
2922     if (proto) {
2923         char *p = SvPVx(((SVOP*)proto)->op_sv, na);
2924         if (SvPOK(cv) && strNE(SvPV((SV*)cv,na), p))
2925             warn("Prototype mismatch: (%s) vs (%s)", SvPV((SV*)cv, na), p);
2926         sv_setpv((SV*)cv, p);
2927         op_free(proto);
2928     }
2929
2930     if (error_count) {
2931         op_free(block);
2932         block = Nullop;
2933     }
2934     if (!block) {
2935         CvROOT(cv) = 0;
2936         op_free(o);
2937         copline = NOLINE;
2938         LEAVE_SCOPE(floor);
2939         return cv;
2940     }
2941
2942     av = newAV();                       /* Will be @_ */
2943     av_extend(av, 0);
2944     av_store(comppad, 0, (SV*)av);
2945     AvFLAGS(av) = AVf_REIFY;
2946
2947     for (ix = AvFILL(comppad); ix > 0; ix--) {
2948         if (!SvPADMY(curpad[ix]))
2949             SvPADTMP_on(curpad[ix]);
2950     }
2951
2952     if (AvFILL(comppad_name) < AvFILL(comppad))
2953         av_store(comppad_name, AvFILL(comppad), Nullsv);
2954
2955     CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
2956     CvSTART(cv) = LINKLIST(CvROOT(cv));
2957     CvROOT(cv)->op_next = 0;
2958     peep(CvSTART(cv));
2959     if (s = strrchr(name,':'))
2960         s++;
2961     else
2962         s = name;
2963     if (strEQ(s, "BEGIN") && !error_count) {
2964         line_t oldline = compiling.cop_line;
2965         SV *oldrs = rs;
2966
2967         ENTER;
2968         SAVESPTR(compiling.cop_filegv);
2969         SAVEI32(perldb);
2970         if (!beginav)
2971             beginav = newAV();
2972         av_push(beginav, (SV *)cv);
2973         DEBUG_x( dump_sub(gv) );
2974         rs = SvREFCNT_inc(nrs);
2975         GvCV(gv) = 0;
2976         calllist(beginav);
2977         SvREFCNT_dec(rs);
2978         rs = oldrs;
2979         curcop = &compiling;
2980         curcop->cop_line = oldline;     /* might have recursed to yylex */
2981         LEAVE;
2982     }
2983     else if (strEQ(s, "END") && !error_count) {
2984         if (!endav)
2985             endav = newAV();
2986         av_unshift(endav, 1);
2987         av_store(endav, 0, SvREFCNT_inc(cv));
2988     }
2989     if (perldb && curstash != debstash) {
2990         SV *sv;
2991         SV *tmpstr = sv_newmortal();
2992
2993         sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
2994         sv = newSVpv(buf,0);
2995         sv_catpv(sv,"-");
2996         sprintf(buf,"%ld",(long)curcop->cop_line);
2997         sv_catpv(sv,buf);
2998         gv_efullname(tmpstr,gv);
2999         hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
3000     }
3001     op_free(o);
3002     copline = NOLINE;
3003     LEAVE_SCOPE(floor);
3004     if (!o) {
3005         GvCV(gv) = 0;   /* Will remember in SVOP instead. */
3006         CvANON_on(cv);
3007     }
3008     return cv;
3009 }
3010
3011 #ifdef DEPRECATED
3012 CV *
3013 newXSUB(name, ix, subaddr, filename)
3014 char *name;
3015 I32 ix;
3016 I32 (*subaddr)();
3017 char *filename;
3018 {
3019     CV* cv = newXS(name, (void(*)())subaddr, filename);
3020     CvOLDSTYLE_on(cv);
3021     CvXSUBANY(cv).any_i32 = ix;
3022     return cv;
3023 }
3024 #endif
3025
3026 CV *
3027 newXS(name, subaddr, filename)
3028 char *name;
3029 void (*subaddr) _((CV*));
3030 char *filename;
3031 {
3032     dTHR;
3033     register CV *cv;
3034     GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV);
3035     char *s;
3036
3037     if (name)
3038         sub_generation++;
3039     if (cv = GvCV(gv)) {
3040         if (GvCVGEN(gv))
3041             cv = 0;                     /* just a cached method */
3042         else if (CvROOT(cv) || CvXSUB(cv)) {    /* already defined? */
3043             if (dowarn) {
3044                 line_t oldline = curcop->cop_line;
3045
3046                 curcop->cop_line = copline;
3047                 warn("Subroutine %s redefined",name);
3048                 curcop->cop_line = oldline;
3049             }
3050             SvREFCNT_dec(cv);
3051             cv = 0;
3052         }
3053     }
3054     if (cv) {                           /* must reuse cv if autoloaded */
3055         assert(SvREFCNT(CvGV(cv)) > 1);
3056         SvREFCNT_dec(CvGV(cv));
3057     }
3058     else {
3059         cv = (CV*)NEWSV(1105,0);
3060         sv_upgrade((SV *)cv, SVt_PVCV);
3061     }
3062     GvCV(gv) = cv;
3063     CvGV(cv) = SvREFCNT_inc(gv);
3064     GvCVGEN(gv) = 0;
3065 #ifdef USE_THREADS
3066     New(666, CvMUTEXP(cv), 1, pthread_mutex_t);
3067     MUTEX_INIT(CvMUTEXP(cv));
3068     New(666, CvCONDP(cv), 1, pthread_cond_t);
3069     COND_INIT(CvCONDP(cv));
3070     CvOWNER(cv) = 0;
3071 #endif /* USE_THREADS */
3072     CvFILEGV(cv) = gv_fetchfile(filename);
3073     CvXSUB(cv) = subaddr;
3074     if (!name)
3075         s = "__ANON__";
3076     else if (s = strrchr(name,':'))
3077         s++;
3078     else
3079         s = name;
3080     if (strEQ(s, "BEGIN")) {
3081         if (!beginav)
3082             beginav = newAV();
3083         av_push(beginav, SvREFCNT_inc(gv));
3084     }
3085     else if (strEQ(s, "END")) {
3086         if (!endav)
3087             endav = newAV();
3088         av_unshift(endav, 1);
3089         av_store(endav, 0, SvREFCNT_inc(gv));
3090     }
3091     if (!name) {
3092         GvCV(gv) = 0;   /* Will remember elsewhere instead. */
3093         CvANON_on(cv);
3094     }
3095     return cv;
3096 }
3097
3098 void
3099 newFORM(floor,o,block)
3100 I32 floor;
3101 OP *o;
3102 OP *block;
3103 {
3104     dTHR;
3105     register CV *cv;
3106     char *name;
3107     GV *gv;
3108     I32 ix;
3109
3110     if (o)
3111         name = SvPVx(cSVOPo->op_sv, na);
3112     else
3113         name = "STDOUT";
3114     gv = gv_fetchpv(name,TRUE, SVt_PVFM);
3115     GvMULTI_on(gv);
3116     if (cv = GvFORM(gv)) {
3117         if (dowarn) {
3118             line_t oldline = curcop->cop_line;
3119
3120             curcop->cop_line = copline;
3121             warn("Format %s redefined",name);
3122             curcop->cop_line = oldline;
3123         }
3124         SvREFCNT_dec(cv);
3125     }
3126     cv = compcv;
3127     GvFORM(gv) = cv;
3128     CvGV(cv) = SvREFCNT_inc(gv);
3129     CvFILEGV(cv) = curcop->cop_filegv;
3130
3131     for (ix = AvFILL(comppad); ix > 0; ix--) {
3132         if (!SvPADMY(curpad[ix]))
3133             SvPADTMP_on(curpad[ix]);
3134     }
3135
3136     CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
3137     CvSTART(cv) = LINKLIST(CvROOT(cv));
3138     CvROOT(cv)->op_next = 0;
3139     peep(CvSTART(cv));
3140     FmLINES(cv) = 0;
3141     op_free(o);
3142     copline = NOLINE;
3143     LEAVE_SCOPE(floor);
3144 }
3145
3146 OP *
3147 newANONLIST(o)
3148 OP* o;
3149 {
3150     return newUNOP(OP_REFGEN, 0,
3151         mod(list(convert(OP_ANONLIST, 0, o)), OP_REFGEN));
3152 }
3153
3154 OP *
3155 newANONHASH(o)
3156 OP* o;
3157 {
3158     return newUNOP(OP_REFGEN, 0,
3159         mod(list(convert(OP_ANONHASH, 0, o)), OP_REFGEN));
3160 }
3161
3162 OP *
3163 newANONSUB(floor, proto, block)
3164 I32 floor;
3165 OP *proto;
3166 OP *block;
3167 {
3168     return newUNOP(OP_REFGEN, 0,
3169         newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, proto, block)));
3170 }
3171
3172 OP *
3173 oopsAV(o)
3174 OP *o;
3175 {
3176     switch (o->op_type) {
3177     case OP_PADSV:
3178         o->op_type = OP_PADAV;
3179         o->op_ppaddr = ppaddr[OP_PADAV];
3180         return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV);
3181
3182     case OP_RV2SV:
3183         o->op_type = OP_RV2AV;
3184         o->op_ppaddr = ppaddr[OP_RV2AV];
3185         ref(o, OP_RV2AV);
3186         break;
3187
3188     default:
3189         warn("oops: oopsAV");
3190         break;
3191     }
3192     return o;
3193 }
3194
3195 OP *
3196 oopsHV(o)
3197 OP *o;
3198 {
3199     switch (o->op_type) {
3200     case OP_PADSV:
3201     case OP_PADAV:
3202         o->op_type = OP_PADHV;
3203         o->op_ppaddr = ppaddr[OP_PADHV];
3204         return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV);
3205
3206     case OP_RV2SV:
3207     case OP_RV2AV:
3208         o->op_type = OP_RV2HV;
3209         o->op_ppaddr = ppaddr[OP_RV2HV];
3210         ref(o, OP_RV2HV);
3211         break;
3212
3213     default:
3214         warn("oops: oopsHV");
3215         break;
3216     }
3217     return o;
3218 }
3219
3220 OP *
3221 newAVREF(o)
3222 OP *o;
3223 {
3224     if (o->op_type == OP_PADANY) {
3225         o->op_type = OP_PADAV;
3226         o->op_ppaddr = ppaddr[OP_PADAV];
3227         return o;
3228     }
3229     return newUNOP(OP_RV2AV, 0, scalar(o));
3230 }
3231
3232 OP *
3233 newGVREF(type,o)
3234 I32 type;
3235 OP *o;
3236 {
3237     if (type == OP_MAPSTART)
3238         return newUNOP(OP_NULL, 0, o);
3239     return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
3240 }
3241
3242 OP *
3243 newHVREF(o)
3244 OP *o;
3245 {
3246     if (o->op_type == OP_PADANY) {
3247         o->op_type = OP_PADHV;
3248         o->op_ppaddr = ppaddr[OP_PADHV];
3249         return o;
3250     }
3251     return newUNOP(OP_RV2HV, 0, scalar(o));
3252 }
3253
3254 OP *
3255 oopsCV(o)
3256 OP *o;
3257 {
3258     croak("NOT IMPL LINE %d",__LINE__);
3259     /* STUB */
3260     return o;
3261 }
3262
3263 OP *
3264 newCVREF(flags, o)
3265 I32 flags;
3266 OP *o;
3267 {
3268     return newUNOP(OP_RV2CV, flags, scalar(o));
3269 }
3270
3271 OP *
3272 newSVREF(o)
3273 OP *o;
3274 {
3275     if (o->op_type == OP_PADANY) {
3276         o->op_type = OP_PADSV;
3277         o->op_ppaddr = ppaddr[OP_PADSV];
3278         return o;
3279     }
3280     return newUNOP(OP_RV2SV, 0, scalar(o));
3281 }
3282
3283 /* Check routines. */
3284
3285 OP *
3286 ck_concat(o)
3287 OP *o;
3288 {
3289     if (cUNOPo->op_first->op_type == OP_CONCAT)
3290         o->op_flags |= OPf_STACKED;
3291     return o;
3292 }
3293
3294 OP *
3295 ck_spair(o)
3296 OP *o;
3297 {
3298     if (o->op_flags & OPf_KIDS) {
3299         OP* newop;
3300         OP* kid;
3301         o = modkids(ck_fun(o), o->op_type);
3302         kid = cUNOPo->op_first;
3303         newop = kUNOP->op_first->op_sibling;
3304         if (newop &&
3305             (newop->op_sibling ||
3306              !(opargs[newop->op_type] & OA_RETSCALAR) ||
3307              newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
3308              newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
3309
3310             return o;
3311         }
3312         op_free(kUNOP->op_first);
3313         kUNOP->op_first = newop;
3314     }
3315     o->op_ppaddr = ppaddr[++o->op_type];
3316     return ck_fun(o);
3317 }
3318
3319 OP *
3320 ck_delete(o)
3321 OP *o;
3322 {
3323     o = ck_fun(o);
3324     if (o->op_flags & OPf_KIDS) {
3325         OP *kid = cUNOPo->op_first;
3326         if (kid->op_type != OP_HELEM)
3327             croak("%s argument is not a HASH element", op_desc[o->op_type]);
3328         null(kid);
3329     }
3330     return o;
3331 }
3332
3333 OP *
3334 ck_eof(o)
3335 OP *o;
3336 {
3337     I32 type = o->op_type;
3338
3339     if (o->op_flags & OPf_KIDS) {
3340         if (cLISTOPo->op_first->op_type == OP_STUB) {
3341             op_free(o);
3342             o = newUNOP(type, OPf_SPECIAL,
3343                 newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV)));
3344         }
3345         return ck_fun(o);
3346     }
3347     return o;
3348 }
3349
3350 OP *
3351 ck_eval(o)
3352 OP *o;
3353 {
3354     hints |= HINT_BLOCK_SCOPE;
3355     if (o->op_flags & OPf_KIDS) {
3356         SVOP *kid = (SVOP*)cUNOPo->op_first;
3357
3358         if (!kid) {
3359             o->op_flags &= ~OPf_KIDS;
3360             null(o);
3361         }
3362         else if (kid->op_type == OP_LINESEQ) {
3363             LOGOP *enter;
3364
3365             kid->op_next = o->op_next;
3366             cUNOPo->op_first = 0;
3367             op_free(o);
3368
3369             Newz(1101, enter, 1, LOGOP);
3370             enter->op_type = OP_ENTERTRY;
3371             enter->op_ppaddr = ppaddr[OP_ENTERTRY];
3372             enter->op_private = 0;
3373
3374             /* establish postfix order */
3375             enter->op_next = (OP*)enter;
3376
3377             o = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
3378             o->op_type = OP_LEAVETRY;
3379             o->op_ppaddr = ppaddr[OP_LEAVETRY];
3380             enter->op_other = o;
3381             return o;
3382         }
3383     }
3384     else {
3385         op_free(o);
3386         o = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3387     }
3388     o->op_targ = (PADOFFSET)hints;
3389     return o;
3390 }
3391
3392 OP *
3393 ck_exec(o)
3394 OP *o;
3395 {
3396     OP *kid;
3397     if (o->op_flags & OPf_STACKED) {
3398         o = ck_fun(o);
3399         kid = cUNOPo->op_first->op_sibling;
3400         if (kid->op_type == OP_RV2GV)
3401             null(kid);
3402     }
3403     else
3404         o = listkids(o);
3405     return o;
3406 }
3407
3408 OP *
3409 ck_gvconst(o)
3410 register OP *o;
3411 {
3412     o = fold_constants(o);
3413     if (o->op_type == OP_CONST)
3414         o->op_type = OP_GV;
3415     return o;
3416 }
3417
3418 OP *
3419 ck_rvconst(o)
3420 register OP *o;
3421 {
3422     dTHR;
3423     SVOP *kid = (SVOP*)cUNOPo->op_first;
3424
3425     o->op_private |= (hints & HINT_STRICT_REFS);
3426     if (kid->op_type == OP_CONST) {
3427         int iscv = (o->op_type==OP_RV2CV)*2;
3428         GV *gv = 0;
3429         kid->op_type = OP_GV;
3430         for (gv = 0; !gv; iscv++) {
3431             /*
3432              * This is a little tricky.  We only want to add the symbol if we
3433              * didn't add it in the lexer.  Otherwise we get duplicate strict
3434              * warnings.  But if we didn't add it in the lexer, we must at
3435              * least pretend like we wanted to add it even if it existed before,
3436              * or we get possible typo warnings.  OPpCONST_ENTERED says
3437              * whether the lexer already added THIS instance of this symbol.
3438              */
3439             gv = gv_fetchpv(SvPVx(kid->op_sv, na),
3440                 iscv | !(kid->op_private & OPpCONST_ENTERED),
3441                 iscv
3442                     ? SVt_PVCV
3443                     : o->op_type == OP_RV2SV
3444                         ? SVt_PV
3445                         : o->op_type == OP_RV2AV
3446                             ? SVt_PVAV
3447                             : o->op_type == OP_RV2HV
3448                                 ? SVt_PVHV
3449                                 : SVt_PVGV);
3450         }
3451         SvREFCNT_dec(kid->op_sv);
3452         kid->op_sv = SvREFCNT_inc(gv);
3453     }
3454     return o;
3455 }
3456
3457 OP *
3458 ck_formline(o)
3459 OP *o;
3460 {
3461     return ck_fun(o);
3462 }
3463
3464 OP *
3465 ck_ftst(o)
3466 OP *o;
3467 {
3468     dTHR;
3469     I32 type = o->op_type;
3470
3471     if (o->op_flags & OPf_REF)
3472         return o;
3473
3474     if (o->op_flags & OPf_KIDS) {
3475         SVOP *kid = (SVOP*)cUNOPo->op_first;
3476
3477         if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
3478             OP *newop = newGVOP(type, OPf_REF,
3479                 gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
3480             op_free(o);
3481             return newop;
3482         }
3483     }
3484     else {
3485         op_free(o);
3486         if (type == OP_FTTTY)
3487             return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
3488                                 SVt_PVIO));
3489         else
3490             return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3491     }
3492     return o;
3493 }
3494
3495 OP *
3496 ck_fun(o)
3497 OP *o;
3498 {
3499     dTHR;
3500     register OP *kid;
3501     OP **tokid;
3502     OP *sibl;
3503     I32 numargs = 0;
3504     int type = o->op_type;
3505     register I32 oa = opargs[type] >> OASHIFT;
3506
3507     if (o->op_flags & OPf_STACKED) {
3508         if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
3509             oa &= ~OA_OPTIONAL;
3510         else
3511             return no_fh_allowed(o);
3512     }
3513
3514     if (o->op_flags & OPf_KIDS) {
3515         tokid = &cLISTOPo->op_first;
3516         kid = cLISTOPo->op_first;
3517         if (kid->op_type == OP_PUSHMARK ||
3518             kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
3519         {
3520             tokid = &kid->op_sibling;
3521             kid = kid->op_sibling;
3522         }
3523         if (!kid && opargs[type] & OA_DEFGV)
3524             *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
3525
3526         while (oa && kid) {
3527             numargs++;
3528             sibl = kid->op_sibling;
3529             switch (oa & 7) {
3530             case OA_SCALAR:
3531                 scalar(kid);
3532                 break;
3533             case OA_LIST:
3534                 if (oa < 16) {
3535                     kid = 0;
3536                     continue;
3537                 }
3538                 else
3539                     list(kid);
3540                 break;
3541             case OA_AVREF:
3542                 if (kid->op_type == OP_CONST &&
3543                   (kid->op_private & OPpCONST_BARE)) {
3544                     char *name = SvPVx(((SVOP*)kid)->op_sv, na);
3545                     OP *newop = newAVREF(newGVOP(OP_GV, 0,
3546                         gv_fetchpv(name, TRUE, SVt_PVAV) ));
3547                     if (dowarn)
3548                         warn("Array @%s missing the @ in argument %d of %s()",
3549                             name, numargs, op_desc[type]);
3550                     op_free(kid);
3551                     kid = newop;
3552                     kid->op_sibling = sibl;
3553                     *tokid = kid;
3554                 }
3555                 else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
3556                     bad_type(numargs, "array", op_desc[o->op_type], kid);
3557                 mod(kid, type);
3558                 break;
3559             case OA_HVREF:
3560                 if (kid->op_type == OP_CONST &&
3561                   (kid->op_private & OPpCONST_BARE)) {
3562                     char *name = SvPVx(((SVOP*)kid)->op_sv, na);
3563                     OP *newop = newHVREF(newGVOP(OP_GV, 0,
3564                         gv_fetchpv(name, TRUE, SVt_PVHV) ));
3565                     if (dowarn)
3566                         warn("Hash %%%s missing the %% in argument %d of %s()",
3567                             name, numargs, op_desc[type]);
3568                     op_free(kid);
3569                     kid = newop;
3570                     kid->op_sibling = sibl;
3571                     *tokid = kid;
3572                 }
3573                 else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
3574                     bad_type(numargs, "hash", op_desc[o->op_type], kid);
3575                 mod(kid, type);
3576                 break;
3577             case OA_CVREF:
3578                 {
3579                     OP *newop = newUNOP(OP_NULL, 0, kid);
3580                     kid->op_sibling = 0;
3581                     linklist(kid);
3582                     newop->op_next = newop;
3583                     kid = newop;
3584                     kid->op_sibling = sibl;
3585                     *tokid = kid;
3586                 }
3587                 break;
3588             case OA_FILEREF:
3589                 if (kid->op_type != OP_GV) {
3590                     if (kid->op_type == OP_CONST &&
3591                       (kid->op_private & OPpCONST_BARE)) {
3592                         OP *newop = newGVOP(OP_GV, 0,
3593                             gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE,
3594                                         SVt_PVIO) );
3595                         op_free(kid);
3596                         kid = newop;
3597                     }
3598                     else {
3599                         kid->op_sibling = 0;
3600                         kid = newUNOP(OP_RV2GV, 0, scalar(kid));
3601                     }
3602                     kid->op_sibling = sibl;
3603                     *tokid = kid;
3604                 }
3605                 scalar(kid);
3606                 break;
3607             case OA_SCALARREF:
3608                 mod(scalar(kid), type);
3609                 break;
3610             }
3611             oa >>= 4;
3612             tokid = &kid->op_sibling;
3613             kid = kid->op_sibling;
3614         }
3615         o->op_private |= numargs;
3616         if (kid)
3617             return too_many_arguments(o,op_desc[o->op_type]);
3618         listkids(o);
3619     }
3620     else if (opargs[type] & OA_DEFGV) {
3621         op_free(o);
3622         return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3623     }
3624
3625     if (oa) {
3626         while (oa & OA_OPTIONAL)
3627             oa >>= 4;
3628         if (oa && oa != OA_LIST)
3629             return too_few_arguments(o,op_desc[o->op_type]);
3630     }
3631     return o;
3632 }
3633
3634 OP *
3635 ck_glob(o)
3636 OP *o;
3637 {
3638     GV *gv = newGVgen("main");
3639     gv_IOadd(gv);
3640     append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
3641     scalarkids(o);
3642     return ck_fun(o);
3643 }
3644
3645 OP *
3646 ck_grep(o)
3647 OP *o;
3648 {
3649     LOGOP *gwop;
3650     OP *kid;
3651     OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
3652
3653     o->op_ppaddr = ppaddr[OP_GREPSTART];
3654     Newz(1101, gwop, 1, LOGOP);
3655
3656     if (o->op_flags & OPf_STACKED) {
3657         OP* k;
3658         o = ck_sort(o);
3659         kid = cLISTOPo->op_first->op_sibling;
3660         for (k = cLISTOPo->op_first->op_sibling->op_next; k; k = k->op_next) {
3661             kid = k;
3662         }
3663         kid->op_next = (OP*)gwop;
3664         o->op_flags &= ~OPf_STACKED;
3665     }
3666     kid = cLISTOPo->op_first->op_sibling;
3667     if (type == OP_MAPWHILE)
3668         list(kid);
3669     else
3670         scalar(kid);
3671     o = ck_fun(o);
3672     if (error_count)
3673         return o;
3674     kid = cLISTOPo->op_first->op_sibling;
3675     if (kid->op_type != OP_NULL)
3676         croak("panic: ck_grep");
3677     kid = kUNOP->op_first;
3678
3679     gwop->op_type = type;
3680     gwop->op_ppaddr = ppaddr[type];
3681     gwop->op_first = listkids(o);
3682     gwop->op_flags |= OPf_KIDS;
3683     gwop->op_private = 1;
3684     gwop->op_other = LINKLIST(kid);
3685     gwop->op_targ = pad_alloc(type, SVs_PADTMP);
3686     kid->op_next = (OP*)gwop;
3687
3688     kid = cLISTOPo->op_first->op_sibling;
3689     if (!kid || !kid->op_sibling)
3690         return too_few_arguments(o,op_desc[o->op_type]);
3691     for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
3692         mod(kid, OP_GREPSTART);
3693
3694     return (OP*)gwop;
3695 }
3696
3697 OP *
3698 ck_index(o)
3699 OP *o;
3700 {
3701     if (o->op_flags & OPf_KIDS) {
3702         OP *kid = cLISTOPo->op_first->op_sibling;       /* get past pushmark */
3703         if (kid && kid->op_type == OP_CONST)
3704             fbm_compile(((SVOP*)kid)->op_sv, 0);
3705     }
3706     return ck_fun(o);
3707 }
3708
3709 OP *
3710 ck_lengthconst(o)
3711 OP *o;
3712 {
3713     /* XXX length optimization goes here */
3714     return ck_fun(o);
3715 }
3716
3717 OP *
3718 ck_lfun(o)
3719 OP *o;
3720 {
3721     return modkids(ck_fun(o), o->op_type);
3722 }
3723
3724 OP *
3725 ck_rfun(o)
3726 OP *o;
3727 {
3728     return refkids(ck_fun(o), o->op_type);
3729 }
3730
3731 OP *
3732 ck_listiob(o)
3733 OP *o;
3734 {
3735     register OP *kid;
3736
3737     kid = cLISTOPo->op_first;
3738     if (!kid) {
3739         o = force_list(o);
3740         kid = cLISTOPo->op_first;
3741     }
3742     if (kid->op_type == OP_PUSHMARK)
3743         kid = kid->op_sibling;
3744     if (kid && o->op_flags & OPf_STACKED)
3745         kid = kid->op_sibling;
3746     else if (kid && !kid->op_sibling) {         /* print HANDLE; */
3747         if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
3748             o->op_flags |= OPf_STACKED; /* make it a filehandle */
3749             kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
3750             cLISTOPo->op_first->op_sibling = kid;
3751             cLISTOPo->op_last = kid;
3752             kid = kid->op_sibling;
3753         }
3754     }
3755
3756     if (!kid)
3757         append_elem(o->op_type, o, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3758
3759     return listkids(o);
3760 }
3761
3762 OP *
3763 ck_match(o)
3764 OP *o;
3765 {
3766     cPMOPo->op_pmflags |= PMf_RUNTIME;
3767     cPMOPo->op_pmpermflags |= PMf_RUNTIME;
3768     return o;
3769 }
3770
3771 OP *
3772 ck_null(o)
3773 OP *o;
3774 {
3775     return o;
3776 }
3777
3778 OP *
3779 ck_repeat(o)
3780 OP *o;
3781 {
3782     if (cBINOPo->op_first->op_flags & OPf_PARENS) {
3783         o->op_private |= OPpREPEAT_DOLIST;
3784         cBINOPo->op_first = force_list(cBINOPo->op_first);
3785     }
3786     else
3787         scalar(o);
3788     return o;
3789 }
3790
3791 OP *
3792 ck_require(o)
3793 OP *o;
3794 {
3795     if (o->op_flags & OPf_KIDS) {       /* Shall we supply missing .pm? */
3796         SVOP *kid = (SVOP*)cUNOPo->op_first;
3797
3798         if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
3799             char *s;
3800             for (s = SvPVX(kid->op_sv); *s; s++) {
3801                 if (*s == ':' && s[1] == ':') {
3802                     *s = '/';
3803                     Move(s+2, s+1, strlen(s+2)+1, char);
3804                     --SvCUR(kid->op_sv);
3805                 }
3806             }
3807             sv_catpvn(kid->op_sv, ".pm", 3);
3808         }
3809     }
3810     return ck_fun(o);
3811 }
3812
3813 OP *
3814 ck_retarget(o)
3815 OP *o;
3816 {
3817     croak("NOT IMPL LINE %d",__LINE__);
3818     /* STUB */
3819     return o;
3820 }
3821
3822 OP *
3823 ck_select(o)
3824 OP *o;
3825 {
3826     OP* kid;
3827     if (o->op_flags & OPf_KIDS) {
3828         kid = cLISTOPo->op_first->op_sibling;   /* get past pushmark */
3829         if (kid && kid->op_sibling) {
3830             o->op_type = OP_SSELECT;
3831             o->op_ppaddr = ppaddr[OP_SSELECT];
3832             o = ck_fun(o);
3833             return fold_constants(o);
3834         }
3835     }
3836     o = ck_fun(o);
3837     kid = cLISTOPo->op_first->op_sibling;    /* get past pushmark */
3838     if (kid && kid->op_type == OP_RV2GV)
3839         kid->op_private &= ~HINT_STRICT_REFS;
3840     return o;
3841 }
3842
3843 OP *
3844 ck_shift(o)
3845 OP *o;
3846 {
3847     I32 type = o->op_type;
3848
3849     if (!(o->op_flags & OPf_KIDS)) {
3850         op_free(o);
3851         return newUNOP(type, 0,
3852             scalar(newUNOP(OP_RV2AV, 0,
3853                 scalar(newGVOP(OP_GV, 0,
3854                     gv_fetchpv((subline ? "_" : "ARGV"), TRUE, SVt_PVAV) )))));
3855     }
3856     return scalar(modkids(ck_fun(o), type));
3857 }
3858
3859 OP *
3860 ck_sort(o)
3861 OP *o;
3862 {
3863     if (o->op_flags & OPf_STACKED) {
3864         OP *kid = cLISTOPo->op_first->op_sibling;       /* get past pushmark */
3865         OP *k;
3866         kid = kUNOP->op_first;                          /* get past rv2gv */
3867
3868         if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
3869             linklist(kid);
3870             if (kid->op_type == OP_SCOPE) {
3871                 k = kid->op_next;
3872                 kid->op_next = 0;
3873             }
3874             else if (kid->op_type == OP_LEAVE) {
3875                 if (o->op_type == OP_SORT) {
3876                     null(kid);                  /* wipe out leave */
3877                     kid->op_next = kid;
3878
3879                     for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
3880                         if (k->op_next == kid)
3881                             k->op_next = 0;
3882                     }
3883                 }
3884                 else
3885                     kid->op_next = 0;           /* just disconnect the leave */
3886                 k = kLISTOP->op_first;
3887             }
3888             peep(k);
3889
3890             kid = cLISTOPo->op_first->op_sibling;       /* get past pushmark */
3891             null(kid);                                  /* wipe out rv2gv */
3892             if (o->op_type == OP_SORT)
3893                 kid->op_next = kid;
3894             else
3895                 kid->op_next = k;
3896             o->op_flags |= OPf_SPECIAL;
3897         }
3898     }
3899     return o;
3900 }
3901
3902 OP *
3903 ck_split(o)
3904 OP *o;
3905 {
3906     register OP *kid;
3907     PMOP* pm;
3908
3909     if (o->op_flags & OPf_STACKED)
3910         return no_fh_allowed(o);
3911
3912     kid = cLISTOPo->op_first;
3913     if (kid->op_type != OP_NULL)
3914         croak("panic: ck_split");
3915     kid = kid->op_sibling;
3916     op_free(cLISTOPo->op_first);
3917     cLISTOPo->op_first = kid;
3918     if (!kid) {
3919         cLISTOPo->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
3920         cLISTOPo->op_last = kid; /* There was only one element previously */
3921     }
3922
3923     if (kid->op_type != OP_MATCH) {
3924         OP *sibl = kid->op_sibling;
3925         kid->op_sibling = 0;
3926         kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
3927         if (cLISTOPo->op_first == cLISTOPo->op_last)
3928             cLISTOPo->op_last = kid;
3929         cLISTOPo->op_first = kid;
3930         kid->op_sibling = sibl;
3931     }
3932     pm = (PMOP*)kid;
3933     if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
3934         SvREFCNT_dec(pm->op_pmshort);   /* can't use substring to optimize */
3935         pm->op_pmshort = 0;
3936     }
3937
3938     kid->op_type = OP_PUSHRE;
3939     kid->op_ppaddr = ppaddr[OP_PUSHRE];
3940     scalar(kid);
3941
3942     if (!kid->op_sibling)
3943         append_elem(OP_SPLIT, o, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3944
3945     kid = kid->op_sibling;
3946     scalar(kid);
3947
3948     if (!kid->op_sibling)
3949         append_elem(OP_SPLIT, o, newSVOP(OP_CONST, 0, newSViv(0)));
3950
3951     kid = kid->op_sibling;
3952     scalar(kid);
3953
3954     if (kid->op_sibling)
3955         return too_many_arguments(o,op_desc[o->op_type]);
3956
3957     return o;
3958 }
3959
3960 OP *
3961 ck_subr(o)
3962 OP *o;
3963 {
3964     dTHR;
3965     OP *prev = ((cUNOPo->op_first->op_sibling)
3966              ? cUNOPo : ((UNOP*)cUNOPo->op_first))->op_first;
3967     OP *o2 = prev->op_sibling;
3968     OP *cvop;
3969     char *proto = 0;
3970     CV *cv = 0;
3971     int optional = 0;
3972     I32 arg = 0;
3973
3974     for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
3975     if (cvop->op_type == OP_RV2CV) {
3976         SVOP* tmpop;
3977         o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
3978         null(cvop);             /* disable rv2cv */
3979         tmpop = (SVOP*)((UNOP*)cvop)->op_first;
3980         if (tmpop->op_type == OP_GV) {
3981             cv = GvCV(tmpop->op_sv);
3982             if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER))
3983                 proto = SvPV((SV*)cv,na);
3984         }
3985     }
3986     o->op_private |= (hints & HINT_STRICT_REFS);
3987     if (perldb && curstash != debstash)
3988         o->op_private |= OPpENTERSUB_DB;
3989     while (o2 != cvop) {
3990         if (proto) {
3991             switch (*proto) {
3992             case '\0':
3993                 return too_many_arguments(o, CvNAME(cv));
3994             case ';':
3995                 optional = 1;
3996                 proto++;
3997                 continue;
3998             case '$':
3999                 proto++;
4000                 arg++;
4001                 scalar(o2);
4002                 break;
4003             case '%':
4004             case '@':
4005                 list(o2);
4006                 arg++;
4007                 break;
4008             case '&':
4009                 proto++;
4010                 arg++;
4011                 if (o2->op_type != OP_REFGEN && o2->op_type != OP_UNDEF)
4012                     bad_type(arg, "block", CvNAME(cv), o2);
4013                 break;
4014             case '*':
4015                 proto++;
4016                 arg++;
4017                 if (o2->op_type == OP_RV2GV)
4018                     goto wrapref;
4019                 {
4020                     OP* kid = o2;
4021                     o2 = newUNOP(OP_RV2GV, 0, kid);
4022                     o2->op_sibling = kid->op_sibling;
4023                     kid->op_sibling = 0;
4024                     prev->op_sibling = o;
4025                 }
4026                 goto wrapref;
4027             case '\\':
4028                 proto++;
4029                 arg++;
4030                 switch (*proto++) {
4031                 case '*':
4032                     if (o2->op_type != OP_RV2GV)
4033                         bad_type(arg, "symbol", CvNAME(cv), o2);
4034                     goto wrapref;
4035                 case '&':
4036                     if (o2->op_type != OP_RV2CV)
4037                         bad_type(arg, "sub", CvNAME(cv), o2);
4038                     goto wrapref;
4039                 case '$':
4040                     if (o2->op_type != OP_RV2SV && o2->op_type != OP_PADSV)
4041                         bad_type(arg, "scalar", CvNAME(cv), o2);
4042                     goto wrapref;
4043                 case '@':
4044                     if (o2->op_type != OP_RV2AV && o2->op_type != OP_PADAV)
4045                         bad_type(arg, "array", CvNAME(cv), o2);
4046                     goto wrapref;
4047                 case '%':
4048                     if (o2->op_type != OP_RV2HV && o2->op_type != OP_PADHV)
4049                         bad_type(arg, "hash", CvNAME(cv), o2);
4050                   wrapref:
4051                     {
4052                         OP* kid = o2;
4053                         o2 = newUNOP(OP_REFGEN, 0, kid);
4054                         o2->op_sibling = kid->op_sibling;
4055                         kid->op_sibling = 0;
4056                         prev->op_sibling = o;
4057                     }
4058                     break;
4059                 default: goto oops;
4060                 }
4061                 break;
4062             default:
4063               oops:
4064                 croak("Malformed prototype for %s: %s",
4065                         CvNAME(cv),SvPV((SV*)cv,na));
4066             }
4067         }
4068         else
4069             list(o2);
4070         mod(o2, OP_ENTERSUB);
4071         prev = o2;
4072         o2 = o2->op_sibling;
4073     }
4074     if (proto && !optional && *proto == '$')
4075         return too_few_arguments(o, CvNAME(cv));
4076     return o;
4077 }
4078
4079 OP *
4080 ck_svconst(o)
4081 OP *o;
4082 {
4083     SvREADONLY_on(cSVOPo->op_sv);
4084     return o;
4085 }
4086
4087 OP *
4088 ck_trunc(o)
4089 OP *o;
4090 {
4091     if (o->op_flags & OPf_KIDS) {
4092         SVOP *kid = (SVOP*)cUNOPo->op_first;
4093
4094         if (kid->op_type == OP_NULL)
4095             kid = (SVOP*)kid->op_sibling;
4096         if (kid &&
4097           kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
4098             o->op_flags |= OPf_SPECIAL;
4099     }
4100     return ck_fun(o);
4101 }
4102
4103 /* A peephole optimizer.  We visit the ops in the order they're to execute. */
4104
4105 void
4106 peep(o)
4107 register OP* o;
4108 {
4109     dTHR;
4110     register OP* oldop = 0;
4111     if (!o || o->op_seq)
4112         return;
4113     ENTER;
4114     SAVESPTR(op);
4115     SAVESPTR(curcop);
4116     for (; o; o = o->op_next) {
4117         if (o->op_seq)
4118             break;
4119         if (!op_seqmax)
4120             op_seqmax++;
4121         op = o;
4122         switch (o->op_type) {
4123         case OP_NEXTSTATE:
4124         case OP_DBSTATE:
4125             curcop = ((COP*)o);         /* for warnings */
4126             o->op_seq = op_seqmax++;
4127             break;
4128
4129         case OP_CONCAT:
4130         case OP_CONST:
4131         case OP_JOIN:
4132         case OP_UC:
4133         case OP_UCFIRST:
4134         case OP_LC:
4135         case OP_LCFIRST:
4136         case OP_QUOTEMETA:
4137             if (o->op_next->op_type == OP_STRINGIFY)
4138                 null(o->op_next);
4139             o->op_seq = op_seqmax++;
4140             break;
4141         case OP_STUB:
4142             if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) {
4143                 o->op_seq = op_seqmax++;
4144                 break;  /* Scalar stub must produce undef.  List stub is noop */
4145             }
4146             goto nothin;
4147         case OP_NULL:
4148             if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
4149                 curcop = ((COP*)op);
4150             goto nothin;
4151         case OP_SCALAR:
4152         case OP_LINESEQ:
4153         case OP_SCOPE:
4154           nothin:
4155             if (oldop && o->op_next) {
4156                 oldop->op_next = o->op_next;
4157                 continue;
4158             }
4159             o->op_seq = op_seqmax++;
4160             break;
4161
4162         case OP_GV:
4163             if (o->op_next->op_type == OP_RV2SV) {
4164                 if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) {
4165                     null(o->op_next);
4166                     o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
4167                     o->op_next = o->op_next->op_next;
4168                     o->op_type = OP_GVSV;
4169                     o->op_ppaddr = ppaddr[OP_GVSV];
4170                 }
4171             }
4172             else if (o->op_next->op_type == OP_RV2AV) {
4173                 OP* pop = o->op_next->op_next;
4174                 IV i;
4175                 if (pop->op_type == OP_CONST &&
4176                     (op = pop->op_next) &&
4177                     pop->op_next->op_type == OP_AELEM &&
4178                     !(pop->op_next->op_private &
4179                         (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) &&
4180                     (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
4181                                 <= 255 &&
4182                     i >= 0)
4183                 {
4184                     SvREFCNT_dec(((SVOP*)pop)->op_sv);
4185                     null(o->op_next);
4186                     null(pop->op_next);
4187                     null(pop);
4188                     o->op_flags |= pop->op_next->op_flags & OPf_MOD;
4189                     o->op_next = pop->op_next->op_next;
4190                     o->op_type = OP_AELEMFAST;
4191                     o->op_ppaddr = ppaddr[OP_AELEMFAST];
4192                     o->op_private = (U8)i;
4193                     GvAVn((GV*)(((SVOP*)o)->op_sv));
4194                 }
4195             }
4196             o->op_seq = op_seqmax++;
4197             break;
4198
4199         case OP_MAPWHILE:
4200         case OP_GREPWHILE:
4201         case OP_AND:
4202         case OP_OR:
4203             o->op_seq = op_seqmax++;
4204             peep(cLOGOP->op_other);
4205             break;
4206
4207         case OP_COND_EXPR:
4208             o->op_seq = op_seqmax++;
4209             peep(cCONDOP->op_true);
4210             peep(cCONDOP->op_false);
4211             break;
4212
4213         case OP_ENTERLOOP:
4214             o->op_seq = op_seqmax++;
4215             peep(cLOOP->op_redoop);
4216             peep(cLOOP->op_nextop);
4217             peep(cLOOP->op_lastop);
4218             break;
4219
4220         case OP_MATCH:
4221         case OP_SUBST:
4222             o->op_seq = op_seqmax++;
4223             peep(cPMOP->op_pmreplstart);
4224             break;
4225
4226         case OP_EXEC:
4227             o->op_seq = op_seqmax++;
4228             if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
4229                 if (o->op_next->op_sibling &&
4230                         o->op_next->op_sibling->op_type != OP_DIE) {
4231                     line_t oldline = curcop->cop_line;
4232
4233                     curcop->cop_line = ((COP*)o->op_next)->cop_line;
4234                     warn("Statement unlikely to be reached");
4235                     warn("(Maybe you meant system() when you said exec()?)\n");
4236                     curcop->cop_line = oldline;
4237                 }
4238             }
4239             break;
4240         default:
4241             o->op_seq = op_seqmax++;
4242             break;
4243         }
4244         oldop = o;
4245     }
4246     LEAVE;
4247 }