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