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         SvREFCNT_dec(kid->op_sv);
3137         kid->op_sv = SvREFCNT_inc(gv);
3138     }
3139     return op;
3140 }
3141
3142 OP *
3143 ck_formline(op)
3144 OP *op;
3145 {
3146     return ck_fun(op);
3147 }
3148
3149 OP *
3150 ck_ftst(op)
3151 OP *op;
3152 {
3153     I32 type = op->op_type;
3154
3155     if (op->op_flags & OPf_REF)
3156         return op;
3157
3158     if (op->op_flags & OPf_KIDS) {
3159         SVOP *kid = (SVOP*)cUNOP->op_first;
3160
3161         if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
3162             OP *newop = newGVOP(type, OPf_REF,
3163                 gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
3164             op_free(op);
3165             return newop;
3166         }
3167     }
3168     else {
3169         op_free(op);
3170         if (type == OP_FTTTY)
3171             return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
3172                                 SVt_PVIO));
3173         else
3174             return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3175     }
3176     return op;
3177 }
3178
3179 OP *
3180 ck_fun(op)
3181 OP *op;
3182 {
3183     register OP *kid;
3184     OP **tokid;
3185     OP *sibl;
3186     I32 numargs = 0;
3187     int type = op->op_type;
3188     register I32 oa = opargs[type] >> OASHIFT;
3189
3190     if (op->op_flags & OPf_STACKED) {
3191         if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
3192             oa &= ~OA_OPTIONAL;
3193         else
3194             return no_fh_allowed(op);
3195     }
3196
3197     if (op->op_flags & OPf_KIDS) {
3198         tokid = &cLISTOP->op_first;
3199         kid = cLISTOP->op_first;
3200         if (kid->op_type == OP_PUSHMARK ||
3201             kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
3202         {
3203             tokid = &kid->op_sibling;
3204             kid = kid->op_sibling;
3205         }
3206         if (!kid && opargs[type] & OA_DEFGV)
3207             *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
3208
3209         while (oa && kid) {
3210             numargs++;
3211             sibl = kid->op_sibling;
3212             switch (oa & 7) {
3213             case OA_SCALAR:
3214                 scalar(kid);
3215                 break;
3216             case OA_LIST:
3217                 if (oa < 16) {
3218                     kid = 0;
3219                     continue;
3220                 }
3221                 else
3222                     list(kid);
3223                 break;
3224             case OA_AVREF:
3225                 if (kid->op_type == OP_CONST &&
3226                   (kid->op_private & OPpCONST_BARE)) {
3227                     char *name = SvPVx(((SVOP*)kid)->op_sv, na);
3228                     OP *newop = newAVREF(newGVOP(OP_GV, 0,
3229                         gv_fetchpv(name, TRUE, SVt_PVAV) ));
3230                     if (dowarn)
3231                         warn("Array @%s missing the @ in argument %d of %s()",
3232                             name, numargs, op_name[type]);
3233                     op_free(kid);
3234                     kid = newop;
3235                     kid->op_sibling = sibl;
3236                     *tokid = kid;
3237                 }
3238                 else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
3239                     bad_type(numargs, "array", op, kid);
3240                 mod(kid, type);
3241                 break;
3242             case OA_HVREF:
3243                 if (kid->op_type == OP_CONST &&
3244                   (kid->op_private & OPpCONST_BARE)) {
3245                     char *name = SvPVx(((SVOP*)kid)->op_sv, na);
3246                     OP *newop = newHVREF(newGVOP(OP_GV, 0,
3247                         gv_fetchpv(name, TRUE, SVt_PVHV) ));
3248                     if (dowarn)
3249                         warn("Hash %%%s missing the %% in argument %d of %s()",
3250                             name, numargs, op_name[type]);
3251                     op_free(kid);
3252                     kid = newop;
3253                     kid->op_sibling = sibl;
3254                     *tokid = kid;
3255                 }
3256                 else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
3257                     bad_type(numargs, "hash", op, kid);
3258                 mod(kid, type);
3259                 break;
3260             case OA_CVREF:
3261                 {
3262                     OP *newop = newUNOP(OP_NULL, 0, kid);
3263                     kid->op_sibling = 0;
3264                     linklist(kid);
3265                     newop->op_next = newop;
3266                     kid = newop;
3267                     kid->op_sibling = sibl;
3268                     *tokid = kid;
3269                 }
3270                 break;
3271             case OA_FILEREF:
3272                 if (kid->op_type != OP_GV) {
3273                     if (kid->op_type == OP_CONST &&
3274                       (kid->op_private & OPpCONST_BARE)) {
3275                         OP *newop = newGVOP(OP_GV, 0,
3276                             gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE,
3277                                         SVt_PVIO) );
3278                         op_free(kid);
3279                         kid = newop;
3280                     }
3281                     else {
3282                         kid->op_sibling = 0;
3283                         kid = newUNOP(OP_RV2GV, 0, scalar(kid));
3284                     }
3285                     kid->op_sibling = sibl;
3286                     *tokid = kid;
3287                 }
3288                 scalar(kid);
3289                 break;
3290             case OA_SCALARREF:
3291                 mod(scalar(kid), type);
3292                 break;
3293             }
3294             oa >>= 4;
3295             tokid = &kid->op_sibling;
3296             kid = kid->op_sibling;
3297         }
3298         op->op_private = numargs;
3299         if (kid)
3300             return too_many_arguments(op);
3301         listkids(op);
3302     }
3303     else if (opargs[type] & OA_DEFGV) {
3304         op_free(op);
3305         return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3306     }
3307
3308     if (oa) {
3309         while (oa & OA_OPTIONAL)
3310             oa >>= 4;
3311         if (oa && oa != OA_LIST)
3312             return too_few_arguments(op);
3313     }
3314     return op;
3315 }
3316
3317 OP *
3318 ck_glob(op)
3319 OP *op;
3320 {
3321     GV *gv = newGVgen("main");
3322     gv_IOadd(gv);
3323     append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
3324     scalarkids(op);
3325     return ck_fun(op);
3326 }
3327
3328 OP *
3329 ck_grep(op)
3330 OP *op;
3331 {
3332     LOGOP *gwop;
3333     OP *kid;
3334     OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
3335
3336     op->op_ppaddr = ppaddr[OP_GREPSTART];
3337     Newz(1101, gwop, 1, LOGOP);
3338
3339     if (op->op_flags & OPf_STACKED) {
3340         OP* k;
3341         op = ck_sort(op);
3342         for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) {
3343             kid = k;
3344         }
3345         kid->op_next = (OP*)gwop;
3346         op->op_flags &= ~OPf_STACKED;
3347     }
3348     kid = cLISTOP->op_first->op_sibling;
3349     if (type == OP_MAPWHILE)
3350         list(kid);
3351     else
3352         scalar(kid);
3353     op = ck_fun(op);
3354     if (error_count)
3355         return op;
3356     kid = cLISTOP->op_first->op_sibling;
3357     if (kid->op_type != OP_NULL)
3358         croak("panic: ck_grep");
3359     kid = kUNOP->op_first;
3360
3361     gwop->op_type = type;
3362     gwop->op_ppaddr = ppaddr[type];
3363     gwop->op_first = listkids(op);
3364     gwop->op_flags |= OPf_KIDS;
3365     gwop->op_private = 1;
3366     gwop->op_other = LINKLIST(kid);
3367     gwop->op_targ = pad_alloc(type, SVs_PADTMP);
3368     kid->op_next = (OP*)gwop;
3369
3370     kid = cLISTOP->op_first->op_sibling;
3371     if (!kid || !kid->op_sibling)
3372         return too_few_arguments(op);
3373     for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
3374         mod(kid, OP_GREPSTART);
3375
3376     return (OP*)gwop;
3377 }
3378
3379 OP *
3380 ck_index(op)
3381 OP *op;
3382 {
3383     if (op->op_flags & OPf_KIDS) {
3384         OP *kid = cLISTOP->op_first->op_sibling;        /* get past pushmark */
3385         if (kid && kid->op_type == OP_CONST)
3386             fbm_compile(((SVOP*)kid)->op_sv, 0);
3387     }
3388     return ck_fun(op);
3389 }
3390
3391 OP *
3392 ck_lengthconst(op)
3393 OP *op;
3394 {
3395     /* XXX length optimization goes here */
3396     return ck_fun(op);
3397 }
3398
3399 OP *
3400 ck_lfun(op)
3401 OP *op;
3402 {
3403     return modkids(ck_fun(op), op->op_type);
3404 }
3405
3406 OP *
3407 ck_rfun(op)
3408 OP *op;
3409 {
3410     return refkids(ck_fun(op), op->op_type);
3411 }
3412
3413 OP *
3414 ck_listiob(op)
3415 OP *op;
3416 {
3417     register OP *kid;
3418
3419     kid = cLISTOP->op_first;
3420     if (!kid) {
3421         op = force_list(op);
3422         kid = cLISTOP->op_first;
3423     }
3424     if (kid->op_type == OP_PUSHMARK)
3425         kid = kid->op_sibling;
3426     if (kid && op->op_flags & OPf_STACKED)
3427         kid = kid->op_sibling;
3428     else if (kid && !kid->op_sibling) {         /* print HANDLE; */
3429         if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
3430             op->op_flags |= OPf_STACKED;        /* make it a filehandle */
3431             kid = newUNOP(OP_RV2GV, 0, scalar(kid));
3432             cLISTOP->op_first->op_sibling = kid;
3433             cLISTOP->op_last = kid;
3434             kid = kid->op_sibling;
3435         }
3436     }
3437
3438     if (!kid)
3439         append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3440
3441     return listkids(op);
3442 }
3443
3444 OP *
3445 ck_match(op)
3446 OP *op;
3447 {
3448     cPMOP->op_pmflags |= PMf_RUNTIME;
3449     return op;
3450 }
3451
3452 OP *
3453 ck_null(op)
3454 OP *op;
3455 {
3456     return op;
3457 }
3458
3459 OP *
3460 ck_repeat(op)
3461 OP *op;
3462 {
3463     if (cBINOP->op_first->op_flags & OPf_PARENS) {
3464         op->op_private = OPpREPEAT_DOLIST;
3465         cBINOP->op_first = force_list(cBINOP->op_first);
3466     }
3467     else
3468         scalar(op);
3469     return op;
3470 }
3471
3472 OP *
3473 ck_require(op)
3474 OP *op;
3475 {
3476     if (op->op_flags & OPf_KIDS) {      /* Shall we supply missing .pm? */
3477         SVOP *kid = (SVOP*)cUNOP->op_first;
3478
3479         if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
3480             char *s;
3481             for (s = SvPVX(kid->op_sv); *s; s++) {
3482                 if (*s == ':' && s[1] == ':') {
3483                     *s = '/';
3484                     strcpy(s+1,s+2);    /* known to be okay here */
3485                     --SvCUR(kid->op_sv);
3486                 }
3487             }
3488             sv_catpvn(kid->op_sv, ".pm", 3);
3489         }
3490     }
3491     return ck_fun(op);
3492 }
3493
3494 OP *
3495 ck_retarget(op)
3496 OP *op;
3497 {
3498     croak("NOT IMPL LINE %d",__LINE__);
3499     /* STUB */
3500     return op;
3501 }
3502
3503 OP *
3504 ck_select(op)
3505 OP *op;
3506 {
3507     if (op->op_flags & OPf_KIDS) {
3508         OP *kid = cLISTOP->op_first->op_sibling;        /* get past pushmark */
3509         if (kid && kid->op_sibling) {
3510             op->op_type = OP_SSELECT;
3511             op->op_ppaddr = ppaddr[OP_SSELECT];
3512             op = ck_fun(op);
3513             return fold_constants(op);
3514         }
3515     }
3516     return ck_fun(op);
3517 }
3518
3519 OP *
3520 ck_shift(op)
3521 OP *op;
3522 {
3523     I32 type = op->op_type;
3524
3525     if (!(op->op_flags & OPf_KIDS)) {
3526         op_free(op);
3527         return newUNOP(type, 0,
3528             scalar(newUNOP(OP_RV2AV, 0,
3529                 scalar(newGVOP(OP_GV, 0,
3530                     gv_fetchpv((subline ? "_" : "ARGV"), TRUE, SVt_PVAV) )))));
3531     }
3532     return scalar(modkids(ck_fun(op), type));
3533 }
3534
3535 OP *
3536 ck_sort(op)
3537 OP *op;
3538 {
3539     if (op->op_flags & OPf_STACKED) {
3540         OP *kid = cLISTOP->op_first->op_sibling;        /* get past pushmark */
3541         OP *k;
3542         kid = kUNOP->op_first;                          /* get past rv2gv */
3543
3544         if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
3545             linklist(kid);
3546             if (kid->op_type == OP_SCOPE) {
3547                 k = kid->op_next;
3548                 kid->op_next = 0;
3549             }
3550             else if (kid->op_type == OP_LEAVE) {
3551                 null(kid);                      /* wipe out leave */
3552                 kid->op_next = kid;
3553
3554                 for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
3555                     if (k->op_next == kid)
3556                         k->op_next = 0;
3557                 }
3558                 k = kLISTOP->op_first;
3559             }
3560             peep(k);
3561
3562             kid = cLISTOP->op_first->op_sibling;        /* get past pushmark */
3563             null(kid);                                  /* wipe out rv2gv */
3564             if (op->op_type == OP_SORT)
3565                 kid->op_next = kid;
3566             else
3567                 kid->op_next = k;
3568             op->op_flags |= OPf_SPECIAL;
3569         }
3570     }
3571     return op;
3572 }
3573
3574 OP *
3575 ck_split(op)
3576 OP *op;
3577 {
3578     register OP *kid;
3579     PMOP* pm;
3580
3581     if (op->op_flags & OPf_STACKED)
3582         return no_fh_allowed(op);
3583
3584     kid = cLISTOP->op_first;
3585     if (kid->op_type != OP_NULL)
3586         croak("panic: ck_split");
3587     kid = kid->op_sibling;
3588     op_free(cLISTOP->op_first);
3589     cLISTOP->op_first = kid;
3590     if (!kid) {
3591         cLISTOP->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
3592         cLISTOP->op_last = kid; /* There was only one element previously */
3593     }
3594
3595     if (kid->op_type != OP_MATCH) {
3596         OP *sibl = kid->op_sibling;
3597         kid->op_sibling = 0;
3598         kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
3599         if (cLISTOP->op_first == cLISTOP->op_last)
3600             cLISTOP->op_last = kid;
3601         cLISTOP->op_first = kid;
3602         kid->op_sibling = sibl;
3603     }
3604     pm = (PMOP*)kid;
3605     if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
3606         SvREFCNT_dec(pm->op_pmshort);   /* can't use substring to optimize */
3607         pm->op_pmshort = 0;
3608     }
3609
3610     kid->op_type = OP_PUSHRE;
3611     kid->op_ppaddr = ppaddr[OP_PUSHRE];
3612     scalar(kid);
3613
3614     if (!kid->op_sibling)
3615         append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3616
3617     kid = kid->op_sibling;
3618     scalar(kid);
3619
3620     if (!kid->op_sibling)
3621         append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0)));
3622
3623     kid = kid->op_sibling;
3624     scalar(kid);
3625
3626     if (kid->op_sibling)
3627         return too_many_arguments(op);
3628
3629     return op;
3630 }
3631
3632 OP *
3633 ck_subr(op)
3634 OP *op;
3635 {
3636     OP *o = ((cUNOP->op_first->op_sibling)
3637              ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first->op_sibling;
3638
3639     if (o->op_type == OP_RV2CV)
3640         null(o);                /* disable rv2cv */
3641     op->op_private = (hints & HINT_STRICT_REFS);
3642     if (perldb && curstash != debstash)
3643         op->op_private |= OPpDEREF_DB;
3644     while (o = o->op_sibling)
3645         mod(o, OP_ENTERSUB);
3646     return op;
3647 }
3648
3649 OP *
3650 ck_svconst(op)
3651 OP *op;
3652 {
3653     SvREADONLY_on(cSVOP->op_sv);
3654     return op;
3655 }
3656
3657 OP *
3658 ck_trunc(op)
3659 OP *op;
3660 {
3661     if (op->op_flags & OPf_KIDS) {
3662         SVOP *kid = (SVOP*)cUNOP->op_first;
3663
3664         if (kid->op_type == OP_NULL)
3665             kid = (SVOP*)kid->op_sibling;
3666         if (kid &&
3667           kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
3668             op->op_flags |= OPf_SPECIAL;
3669     }
3670     return ck_fun(op);
3671 }
3672
3673 /* A peephole optimizer.  We visit the ops in the order they're to execute. */
3674
3675 void
3676 peep(o)
3677 register OP* o;
3678 {
3679     register OP* oldop = 0;
3680     if (!o || o->op_seq)
3681         return;
3682     ENTER;
3683     SAVESPTR(op);
3684     SAVESPTR(curcop);
3685     for (; o; o = o->op_next) {
3686         if (o->op_seq)
3687             break;
3688         op = o;
3689         switch (o->op_type) {
3690         case OP_NEXTSTATE:
3691         case OP_DBSTATE:
3692             curcop = ((COP*)o);         /* for warnings */
3693             break;
3694
3695         case OP_CONCAT:
3696         case OP_CONST:
3697         case OP_JOIN:
3698         case OP_UC:
3699         case OP_UCFIRST:
3700         case OP_LC:
3701         case OP_LCFIRST:
3702         case OP_QUOTEMETA:
3703             if (o->op_next->op_type == OP_STRINGIFY)
3704                 null(o->op_next);
3705             o->op_seq = ++op_seqmax;
3706             break;
3707         case OP_STUB:
3708             if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) {
3709                 o->op_seq = ++op_seqmax;
3710                 break;  /* Scalar stub must produce undef.  List stub is noop */
3711             }
3712             /* FALL THROUGH */
3713         case OP_NULL:
3714         case OP_SCALAR:
3715         case OP_LINESEQ:
3716         case OP_SCOPE:
3717             if (oldop && o->op_next) {
3718                 oldop->op_next = o->op_next;
3719                 continue;
3720             }
3721             o->op_seq = ++op_seqmax;
3722             break;
3723
3724         case OP_GV:
3725             if (o->op_next->op_type == OP_RV2SV) {
3726                 if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) {
3727                     null(o->op_next);
3728                     o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
3729                     o->op_next = o->op_next->op_next;
3730                     o->op_type = OP_GVSV;
3731                     o->op_ppaddr = ppaddr[OP_GVSV];
3732                 }
3733             }
3734             else if (o->op_next->op_type == OP_RV2AV) {
3735                 OP* pop = o->op_next->op_next;
3736                 IV i;
3737                 if (pop->op_type == OP_CONST &&
3738                     (op = pop->op_next) &&
3739                     pop->op_next->op_type == OP_AELEM &&
3740                     !(pop->op_next->op_private &
3741                         (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) &&
3742                     (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
3743                                 <= 255 &&
3744                     i >= 0)
3745                 {
3746                     null(o->op_next);
3747                     null(pop->op_next);
3748                     null(pop);
3749                     o->op_flags |= pop->op_next->op_flags & OPf_MOD;
3750                     o->op_next = pop->op_next->op_next;
3751                     o->op_type = OP_AELEMFAST;
3752                     o->op_ppaddr = ppaddr[OP_AELEMFAST];
3753                     o->op_private = (U8)i;
3754                     GvAVn((GV*)(((SVOP*)o)->op_sv));
3755                 }
3756             }
3757             o->op_seq = ++op_seqmax;
3758             break;
3759
3760         case OP_MAPWHILE:
3761         case OP_GREPWHILE:
3762         case OP_AND:
3763         case OP_OR:
3764             o->op_seq = ++op_seqmax;
3765             peep(cLOGOP->op_other);
3766             break;
3767
3768         case OP_COND_EXPR:
3769             o->op_seq = ++op_seqmax;
3770             peep(cCONDOP->op_true);
3771             peep(cCONDOP->op_false);
3772             break;
3773
3774         case OP_ENTERLOOP:
3775             o->op_seq = ++op_seqmax;
3776             peep(cLOOP->op_redoop);
3777             peep(cLOOP->op_nextop);
3778             peep(cLOOP->op_lastop);
3779             break;
3780
3781         case OP_MATCH:
3782         case OP_SUBST:
3783             o->op_seq = ++op_seqmax;
3784             peep(cPMOP->op_pmreplstart);
3785             break;
3786
3787         case OP_EXEC:
3788             o->op_seq = ++op_seqmax;
3789             if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
3790                 if (o->op_next->op_sibling &&
3791                         o->op_next->op_sibling->op_type != OP_DIE) {
3792                     line_t oldline = curcop->cop_line;
3793
3794                     curcop->cop_line = ((COP*)o->op_next)->cop_line;
3795                     warn("Statement unlikely to be reached");
3796                     warn("(Maybe you meant system() when you said exec()?)\n");
3797                     curcop->cop_line = oldline;
3798                 }
3799             }
3800             break;
3801         default:
3802             o->op_seq = ++op_seqmax;
3803             break;
3804         }
3805         oldop = o;
3806     }
3807     LEAVE;
3808 }