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