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