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         CvPADLIST(compcv) = 0;
2765         SvREFCNT_dec(compcv);
2766     }
2767     else {
2768         cv = compcv;
2769     }
2770     GvCV(gv) = cv;
2771     GvCVGEN(gv) = 0;
2772     CvFILEGV(cv) = curcop->cop_filegv;
2773     CvGV(cv) = SvREFCNT_inc(gv);
2774     CvSTASH(cv) = curstash;
2775
2776     if (!block) {
2777         CvROOT(cv) = 0;
2778         op_free(op);
2779         copline = NOLINE;
2780         LEAVE_SCOPE(floor);
2781         return cv;
2782     }
2783
2784     av = newAV();                       /* Will be @_ */
2785     av_extend(av, 0);
2786     av_store(comppad, 0, (SV*)av);
2787     AvFLAGS(av) = AVf_REIFY;
2788
2789     for (ix = AvFILL(comppad); ix > 0; ix--) {
2790         if (!SvPADMY(curpad[ix]))
2791             SvPADTMP_on(curpad[ix]);
2792     }
2793
2794     if (AvFILL(comppad_name) < AvFILL(comppad))
2795         av_store(comppad_name, AvFILL(comppad), Nullsv);
2796
2797     CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
2798     CvSTART(cv) = LINKLIST(CvROOT(cv));
2799     CvROOT(cv)->op_next = 0;
2800     peep(CvSTART(cv));
2801     if (s = strrchr(name,':'))
2802         s++;
2803     else
2804         s = name;
2805     if (strEQ(s, "BEGIN")) {
2806         line_t oldline = compiling.cop_line;
2807
2808         ENTER;
2809         SAVESPTR(compiling.cop_filegv);
2810         SAVEI32(perldb);
2811         if (!beginav)
2812             beginav = newAV();
2813         av_push(beginav, (SV *)cv);
2814         DEBUG_x( dump_sub(gv) );
2815         rs = nrs;
2816         rslen = nrslen;
2817         rschar = nrschar;
2818         rspara = (nrslen == 2);
2819         GvCV(gv) = 0;
2820         calllist(beginav);
2821         rs = "\n";
2822         rslen = 1;
2823         rschar = '\n';
2824         rspara = 0;
2825         curcop = &compiling;
2826         curcop->cop_line = oldline;     /* might have recursed to yylex */
2827         LEAVE;
2828     }
2829     else if (strEQ(s, "END")) {
2830         if (!endav)
2831             endav = newAV();
2832         av_unshift(endav, 1);
2833         av_store(endav, 0, SvREFCNT_inc(cv));
2834     }
2835     if (perldb && curstash != debstash) {
2836         SV *sv;
2837         SV *tmpstr = sv_newmortal();
2838
2839         sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
2840         sv = newSVpv(buf,0);
2841         sv_catpv(sv,"-");
2842         sprintf(buf,"%ld",(long)curcop->cop_line);
2843         sv_catpv(sv,buf);
2844         gv_efullname(tmpstr,gv);
2845         hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
2846     }
2847     op_free(op);
2848     copline = NOLINE;
2849     LEAVE_SCOPE(floor);
2850     if (!op) {
2851         GvCV(gv) = 0;   /* Will remember in SVOP instead. */
2852         SvFLAGS(cv) |= SVpcv_ANON;
2853     }
2854     return cv;
2855 }
2856
2857 #ifdef DEPRECATED
2858 CV *
2859 newXSUB(name, ix, subaddr, filename)
2860 char *name;
2861 I32 ix;
2862 I32 (*subaddr)();
2863 char *filename;
2864 {
2865     CV* cv = newXS(name, (void(*)())subaddr, filename);
2866     CvOLDSTYLE(cv) = TRUE;
2867     CvXSUBANY(cv).any_i32 = ix;
2868     return cv;
2869 }
2870 #endif
2871
2872 CV *
2873 newXS(name, subaddr, filename)
2874 char *name;
2875 void (*subaddr) _((CV*));
2876 char *filename;
2877 {
2878     register CV *cv;
2879     GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV);
2880     char *s;
2881
2882     if (name)
2883         sub_generation++;
2884     if (cv = GvCV(gv)) {
2885         if (GvCVGEN(gv))
2886             cv = 0;                     /* just a cached method */
2887         else if (CvROOT(cv) || CvXSUB(cv)) {    /* already defined? */
2888             if (dowarn) {
2889                 line_t oldline = curcop->cop_line;
2890
2891                 curcop->cop_line = copline;
2892                 warn("Subroutine %s redefined",name);
2893                 curcop->cop_line = oldline;
2894             }
2895             SvREFCNT_dec(cv);
2896             cv = 0;
2897         }
2898     }
2899     if (cv) {                           /* must reuse cv if autoloaded */
2900         assert(SvREFCNT(CvGV(cv)) > 1);
2901         SvREFCNT_dec(CvGV(cv));
2902     }
2903     else {
2904         cv = (CV*)NEWSV(1105,0);
2905         sv_upgrade((SV *)cv, SVt_PVCV);
2906     }
2907     GvCV(gv) = cv;
2908     CvGV(cv) = SvREFCNT_inc(gv);
2909     GvCVGEN(gv) = 0;
2910     CvFILEGV(cv) = gv_fetchfile(filename);
2911     CvXSUB(cv) = subaddr;
2912     if (!name)
2913         s = "__ANON__";
2914     else if (s = strrchr(name,':'))
2915         s++;
2916     else
2917         s = name;
2918     if (strEQ(s, "BEGIN")) {
2919         if (!beginav)
2920             beginav = newAV();
2921         av_push(beginav, SvREFCNT_inc(gv));
2922     }
2923     else if (strEQ(s, "END")) {
2924         if (!endav)
2925             endav = newAV();
2926         av_unshift(endav, 1);
2927         av_store(endav, 0, SvREFCNT_inc(gv));
2928     }
2929     if (!name) {
2930         GvCV(gv) = 0;   /* Will remember elsewhere instead. */
2931         SvFLAGS(cv) |= SVpcv_ANON;
2932     }
2933     return cv;
2934 }
2935
2936 void
2937 newFORM(floor,op,block)
2938 I32 floor;
2939 OP *op;
2940 OP *block;
2941 {
2942     register CV *cv;
2943     char *name;
2944     GV *gv;
2945     AV* av;
2946     I32 ix;
2947
2948     if (op)
2949         name = SvPVx(cSVOP->op_sv, na);
2950     else
2951         name = "STDOUT";
2952     gv = gv_fetchpv(name,TRUE, SVt_PVFM);
2953     SvMULTI_on(gv);
2954     if (cv = GvFORM(gv)) {
2955         if (dowarn) {
2956             line_t oldline = curcop->cop_line;
2957
2958             curcop->cop_line = copline;
2959             warn("Format %s redefined",name);
2960             curcop->cop_line = oldline;
2961         }
2962         SvREFCNT_dec(cv);
2963     }
2964     cv = compcv;
2965     GvFORM(gv) = cv;
2966     CvGV(cv) = SvREFCNT_inc(gv);
2967     CvFILEGV(cv) = curcop->cop_filegv;
2968
2969     for (ix = AvFILL(comppad); ix > 0; ix--) {
2970         if (!SvPADMY(curpad[ix]))
2971             SvPADTMP_on(curpad[ix]);
2972     }
2973
2974     CvPADLIST(cv) = av = newAV();
2975     AvREAL_off(av);
2976     av_store(av, 1, SvREFCNT_inc((SV*)comppad));
2977     AvFILL(av) = 1;
2978
2979     CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
2980     CvSTART(cv) = LINKLIST(CvROOT(cv));
2981     CvROOT(cv)->op_next = 0;
2982     peep(CvSTART(cv));
2983     FmLINES(cv) = 0;
2984     op_free(op);
2985     copline = NOLINE;
2986     LEAVE_SCOPE(floor);
2987 }
2988
2989 OP *
2990 newMETHOD(ref,name)
2991 OP *ref;
2992 OP *name;
2993 {
2994     LOGOP* mop;
2995     Newz(1101, mop, 1, LOGOP);
2996     mop->op_type = OP_METHOD;
2997     mop->op_ppaddr = ppaddr[OP_METHOD];
2998     mop->op_first = scalar(ref);
2999     mop->op_flags |= OPf_KIDS;
3000     mop->op_private = 1;
3001     mop->op_other = LINKLIST(name);
3002     mop->op_targ = pad_alloc(OP_METHOD, SVs_PADTMP);
3003     mop->op_next = LINKLIST(ref);
3004     ref->op_next = (OP*)mop;
3005     return scalar((OP*)mop);
3006 }
3007
3008 OP *
3009 newANONLIST(op)
3010 OP* op;
3011 {
3012     return newUNOP(OP_REFGEN, 0,
3013         mod(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN));
3014 }
3015
3016 OP *
3017 newANONHASH(op)
3018 OP* op;
3019 {
3020     return newUNOP(OP_REFGEN, 0,
3021         mod(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN));
3022 }
3023
3024 OP *
3025 newANONSUB(floor, block)
3026 I32 floor;
3027 OP *block;
3028 {
3029     return newUNOP(OP_REFGEN, 0,
3030         newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, block)));
3031 }
3032
3033 OP *
3034 oopsAV(o)
3035 OP *o;
3036 {
3037     switch (o->op_type) {
3038     case OP_PADSV:
3039         o->op_type = OP_PADAV;
3040         o->op_ppaddr = ppaddr[OP_PADAV];
3041         return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV);
3042
3043     case OP_RV2SV:
3044         o->op_type = OP_RV2AV;
3045         o->op_ppaddr = ppaddr[OP_RV2AV];
3046         ref(o, OP_RV2AV);
3047         break;
3048
3049     default:
3050         warn("oops: oopsAV");
3051         break;
3052     }
3053     return o;
3054 }
3055
3056 OP *
3057 oopsHV(o)
3058 OP *o;
3059 {
3060     switch (o->op_type) {
3061     case OP_PADSV:
3062     case OP_PADAV:
3063         o->op_type = OP_PADHV;
3064         o->op_ppaddr = ppaddr[OP_PADHV];
3065         return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV);
3066
3067     case OP_RV2SV:
3068     case OP_RV2AV:
3069         o->op_type = OP_RV2HV;
3070         o->op_ppaddr = ppaddr[OP_RV2HV];
3071         ref(o, OP_RV2HV);
3072         break;
3073
3074     default:
3075         warn("oops: oopsHV");
3076         break;
3077     }
3078     return o;
3079 }
3080
3081 OP *
3082 newAVREF(o)
3083 OP *o;
3084 {
3085     if (o->op_type == OP_PADANY) {
3086         o->op_type = OP_PADAV;
3087         o->op_ppaddr = ppaddr[OP_PADAV];
3088         return o;
3089     }
3090     return newUNOP(OP_RV2AV, 0, scalar(o));
3091 }
3092
3093 OP *
3094 newGVREF(type,o)
3095 I32 type;
3096 OP *o;
3097 {
3098     if (type == OP_MAPSTART)
3099         return newUNOP(OP_NULL, 0, o);
3100     return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
3101 }
3102
3103 OP *
3104 newHVREF(o)
3105 OP *o;
3106 {
3107     if (o->op_type == OP_PADANY) {
3108         o->op_type = OP_PADHV;
3109         o->op_ppaddr = ppaddr[OP_PADHV];
3110         return o;
3111     }
3112     return newUNOP(OP_RV2HV, 0, scalar(o));
3113 }
3114
3115 OP *
3116 oopsCV(o)
3117 OP *o;
3118 {
3119     croak("NOT IMPL LINE %d",__LINE__);
3120     /* STUB */
3121     return o;
3122 }
3123
3124 OP *
3125 newCVREF(o)
3126 OP *o;
3127 {
3128     return newUNOP(OP_RV2CV, 0, scalar(o));
3129 }
3130
3131 OP *
3132 newSVREF(o)
3133 OP *o;
3134 {
3135     if (o->op_type == OP_PADANY) {
3136         o->op_type = OP_PADSV;
3137         o->op_ppaddr = ppaddr[OP_PADSV];
3138         return o;
3139     }
3140     return newUNOP(OP_RV2SV, 0, scalar(o));
3141 }
3142
3143 /* Check routines. */
3144
3145 OP *
3146 ck_concat(op)
3147 OP *op;
3148 {
3149     if (cUNOP->op_first->op_type == OP_CONCAT)
3150         op->op_flags |= OPf_STACKED;
3151     return op;
3152 }
3153
3154 OP *
3155 ck_spair(op)
3156 OP *op;
3157 {
3158     if (op->op_flags & OPf_KIDS) {
3159         OP* newop;
3160         OP* kid;
3161         op = modkids(ck_fun(op), op->op_type);
3162         kid = cUNOP->op_first;
3163         newop = kUNOP->op_first->op_sibling;
3164         if (newop &&
3165             (newop->op_sibling ||
3166              !(opargs[newop->op_type] & OA_RETSCALAR) ||
3167              newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
3168              newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
3169
3170             return op;
3171         }
3172         op_free(kUNOP->op_first);
3173         kUNOP->op_first = newop;
3174     }
3175     op->op_ppaddr = ppaddr[++op->op_type];
3176     return ck_fun(op);
3177 }
3178
3179 OP *
3180 ck_delete(op)
3181 OP *op;
3182 {
3183     op = ck_fun(op);
3184     if (op->op_flags & OPf_KIDS) {
3185         OP *kid = cUNOP->op_first;
3186         if (kid->op_type != OP_HELEM)
3187             croak("%s argument is not a HASH element", op_name[op->op_type]);
3188         null(kid);
3189     }
3190     return op;
3191 }
3192
3193 OP *
3194 ck_eof(op)
3195 OP *op;
3196 {
3197     I32 type = op->op_type;
3198
3199     if (op->op_flags & OPf_KIDS) {
3200         if (cLISTOP->op_first->op_type == OP_STUB) {
3201             op_free(op);
3202             op = newUNOP(type, OPf_SPECIAL,
3203                 newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV)));
3204         }
3205         return ck_fun(op);
3206     }
3207     return op;
3208 }
3209
3210 OP *
3211 ck_eval(op)
3212 OP *op;
3213 {
3214     hints |= HINT_BLOCK_SCOPE;
3215     if (op->op_flags & OPf_KIDS) {
3216         SVOP *kid = (SVOP*)cUNOP->op_first;
3217
3218         if (!kid) {
3219             op->op_flags &= ~OPf_KIDS;
3220             null(op);
3221         }
3222         else if (kid->op_type == OP_LINESEQ) {
3223             LOGOP *enter;
3224
3225             kid->op_next = op->op_next;
3226             cUNOP->op_first = 0;
3227             op_free(op);
3228
3229             Newz(1101, enter, 1, LOGOP);
3230             enter->op_type = OP_ENTERTRY;
3231             enter->op_ppaddr = ppaddr[OP_ENTERTRY];
3232             enter->op_private = 0;
3233
3234             /* establish postfix order */
3235             enter->op_next = (OP*)enter;
3236
3237             op = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
3238             op->op_type = OP_LEAVETRY;
3239             op->op_ppaddr = ppaddr[OP_LEAVETRY];
3240             enter->op_other = op;
3241             return op;
3242         }
3243     }
3244     else {
3245         op_free(op);
3246         op = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3247     }
3248     op->op_targ = (PADOFFSET)hints;
3249     return op;
3250 }
3251
3252 OP *
3253 ck_exec(op)
3254 OP *op;
3255 {
3256     OP *kid;
3257     if (op->op_flags & OPf_STACKED) {
3258         op = ck_fun(op);
3259         kid = cUNOP->op_first->op_sibling;
3260         if (kid->op_type == OP_RV2GV)
3261             null(kid);
3262     }
3263     else
3264         op = listkids(op);
3265     return op;
3266 }
3267
3268 OP *
3269 ck_gvconst(o)
3270 register OP *o;
3271 {
3272     o = fold_constants(o);
3273     if (o->op_type == OP_CONST)
3274         o->op_type = OP_GV;
3275     return o;
3276 }
3277
3278 OP *
3279 ck_rvconst(op)
3280 register OP *op;
3281 {
3282     SVOP *kid = (SVOP*)cUNOP->op_first;
3283
3284     op->op_private = (hints & HINT_STRICT_REFS);
3285     if (kid->op_type == OP_CONST) {
3286         int iscv = (op->op_type==OP_RV2CV)*2;
3287         GV *gv = 0;
3288         kid->op_type = OP_GV;
3289         for (gv = 0; !gv; iscv++) {
3290             /*
3291              * This is a little tricky.  We only want to add the symbol if we
3292              * didn't add it in the lexer.  Otherwise we get duplicate strict
3293              * warnings.  But if we didn't add it in the lexer, we must at
3294              * least pretend like we wanted to add it even if it existed before,
3295              * or we get possible typo warnings.  OPpCONST_ENTERED says
3296              * whether the lexer already added THIS instance of this symbol.
3297              */
3298             gv = gv_fetchpv(SvPVx(kid->op_sv, na),
3299                 iscv | !(kid->op_private & OPpCONST_ENTERED),
3300                 iscv
3301                     ? SVt_PVCV
3302                     : op->op_type == OP_RV2SV
3303                         ? SVt_PV
3304                         : op->op_type == OP_RV2AV
3305                             ? SVt_PVAV
3306                             : op->op_type == OP_RV2HV
3307                                 ? SVt_PVHV
3308                                 : SVt_PVGV);
3309         }
3310         SvREFCNT_dec(kid->op_sv);
3311         kid->op_sv = SvREFCNT_inc(gv);
3312     }
3313     return op;
3314 }
3315
3316 OP *
3317 ck_formline(op)
3318 OP *op;
3319 {
3320     return ck_fun(op);
3321 }
3322
3323 OP *
3324 ck_ftst(op)
3325 OP *op;
3326 {
3327     I32 type = op->op_type;
3328
3329     if (op->op_flags & OPf_REF)
3330         return op;
3331
3332     if (op->op_flags & OPf_KIDS) {
3333         SVOP *kid = (SVOP*)cUNOP->op_first;
3334
3335         if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
3336             OP *newop = newGVOP(type, OPf_REF,
3337                 gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
3338             op_free(op);
3339             return newop;
3340         }
3341     }
3342     else {
3343         op_free(op);
3344         if (type == OP_FTTTY)
3345             return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
3346                                 SVt_PVIO));
3347         else
3348             return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3349     }
3350     return op;
3351 }
3352
3353 OP *
3354 ck_fun(op)
3355 OP *op;
3356 {
3357     register OP *kid;
3358     OP **tokid;
3359     OP *sibl;
3360     I32 numargs = 0;
3361     int type = op->op_type;
3362     register I32 oa = opargs[type] >> OASHIFT;
3363
3364     if (op->op_flags & OPf_STACKED) {
3365         if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
3366             oa &= ~OA_OPTIONAL;
3367         else
3368             return no_fh_allowed(op);
3369     }
3370
3371     if (op->op_flags & OPf_KIDS) {
3372         tokid = &cLISTOP->op_first;
3373         kid = cLISTOP->op_first;
3374         if (kid->op_type == OP_PUSHMARK ||
3375             kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
3376         {
3377             tokid = &kid->op_sibling;
3378             kid = kid->op_sibling;
3379         }
3380         if (!kid && opargs[type] & OA_DEFGV)
3381             *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
3382
3383         while (oa && kid) {
3384             numargs++;
3385             sibl = kid->op_sibling;
3386             switch (oa & 7) {
3387             case OA_SCALAR:
3388                 scalar(kid);
3389                 break;
3390             case OA_LIST:
3391                 if (oa < 16) {
3392                     kid = 0;
3393                     continue;
3394                 }
3395                 else
3396                     list(kid);
3397                 break;
3398             case OA_AVREF:
3399                 if (kid->op_type == OP_CONST &&
3400                   (kid->op_private & OPpCONST_BARE)) {
3401                     char *name = SvPVx(((SVOP*)kid)->op_sv, na);
3402                     OP *newop = newAVREF(newGVOP(OP_GV, 0,
3403                         gv_fetchpv(name, TRUE, SVt_PVAV) ));
3404                     if (dowarn)
3405                         warn("Array @%s missing the @ in argument %d of %s()",
3406                             name, numargs, op_name[type]);
3407                     op_free(kid);
3408                     kid = newop;
3409                     kid->op_sibling = sibl;
3410                     *tokid = kid;
3411                 }
3412                 else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
3413                     bad_type(numargs, "array", op, kid);
3414                 mod(kid, type);
3415                 break;
3416             case OA_HVREF:
3417                 if (kid->op_type == OP_CONST &&
3418                   (kid->op_private & OPpCONST_BARE)) {
3419                     char *name = SvPVx(((SVOP*)kid)->op_sv, na);
3420                     OP *newop = newHVREF(newGVOP(OP_GV, 0,
3421                         gv_fetchpv(name, TRUE, SVt_PVHV) ));
3422                     if (dowarn)
3423                         warn("Hash %%%s missing the %% in argument %d of %s()",
3424                             name, numargs, op_name[type]);
3425                     op_free(kid);
3426                     kid = newop;
3427                     kid->op_sibling = sibl;
3428                     *tokid = kid;
3429                 }
3430                 else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
3431                     bad_type(numargs, "hash", op, kid);
3432                 mod(kid, type);
3433                 break;
3434             case OA_CVREF:
3435                 {
3436                     OP *newop = newUNOP(OP_NULL, 0, kid);
3437                     kid->op_sibling = 0;
3438                     linklist(kid);
3439                     newop->op_next = newop;
3440                     kid = newop;
3441                     kid->op_sibling = sibl;
3442                     *tokid = kid;
3443                 }
3444                 break;
3445             case OA_FILEREF:
3446                 if (kid->op_type != OP_GV) {
3447                     if (kid->op_type == OP_CONST &&
3448                       (kid->op_private & OPpCONST_BARE)) {
3449                         OP *newop = newGVOP(OP_GV, 0,
3450                             gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE,
3451                                         SVt_PVIO) );
3452                         op_free(kid);
3453                         kid = newop;
3454                     }
3455                     else {
3456                         kid->op_sibling = 0;
3457                         kid = newUNOP(OP_RV2GV, 0, scalar(kid));
3458                     }
3459                     kid->op_sibling = sibl;
3460                     *tokid = kid;
3461                 }
3462                 scalar(kid);
3463                 break;
3464             case OA_SCALARREF:
3465                 mod(scalar(kid), type);
3466                 break;
3467             }
3468             oa >>= 4;
3469             tokid = &kid->op_sibling;
3470             kid = kid->op_sibling;
3471         }
3472         op->op_private = numargs;
3473         if (kid)
3474             return too_many_arguments(op);
3475         listkids(op);
3476     }
3477     else if (opargs[type] & OA_DEFGV) {
3478         op_free(op);
3479         return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3480     }
3481
3482     if (oa) {
3483         while (oa & OA_OPTIONAL)
3484             oa >>= 4;
3485         if (oa && oa != OA_LIST)
3486             return too_few_arguments(op);
3487     }
3488     return op;
3489 }
3490
3491 OP *
3492 ck_glob(op)
3493 OP *op;
3494 {
3495     GV *gv = newGVgen("main");
3496     gv_IOadd(gv);
3497     append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
3498     scalarkids(op);
3499     return ck_fun(op);
3500 }
3501
3502 OP *
3503 ck_grep(op)
3504 OP *op;
3505 {
3506     LOGOP *gwop;
3507     OP *kid;
3508     OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
3509
3510     op->op_ppaddr = ppaddr[OP_GREPSTART];
3511     Newz(1101, gwop, 1, LOGOP);
3512
3513     if (op->op_flags & OPf_STACKED) {
3514         OP* k;
3515         op = ck_sort(op);
3516         for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) {
3517             kid = k;
3518         }
3519         kid->op_next = (OP*)gwop;
3520         op->op_flags &= ~OPf_STACKED;
3521     }
3522     kid = cLISTOP->op_first->op_sibling;
3523     if (type == OP_MAPWHILE)
3524         list(kid);
3525     else
3526         scalar(kid);
3527     op = ck_fun(op);
3528     if (error_count)
3529         return op;
3530     kid = cLISTOP->op_first->op_sibling;
3531     if (kid->op_type != OP_NULL)
3532         croak("panic: ck_grep");
3533     kid = kUNOP->op_first;
3534
3535     gwop->op_type = type;
3536     gwop->op_ppaddr = ppaddr[type];
3537     gwop->op_first = listkids(op);
3538     gwop->op_flags |= OPf_KIDS;
3539     gwop->op_private = 1;
3540     gwop->op_other = LINKLIST(kid);
3541     gwop->op_targ = pad_alloc(type, SVs_PADTMP);
3542     kid->op_next = (OP*)gwop;
3543
3544     kid = cLISTOP->op_first->op_sibling;
3545     if (!kid || !kid->op_sibling)
3546         return too_few_arguments(op);
3547     for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
3548         mod(kid, OP_GREPSTART);
3549
3550     return (OP*)gwop;
3551 }
3552
3553 OP *
3554 ck_index(op)
3555 OP *op;
3556 {
3557     if (op->op_flags & OPf_KIDS) {
3558         OP *kid = cLISTOP->op_first->op_sibling;        /* get past pushmark */
3559         if (kid && kid->op_type == OP_CONST)
3560             fbm_compile(((SVOP*)kid)->op_sv, 0);
3561     }
3562     return ck_fun(op);
3563 }
3564
3565 OP *
3566 ck_lengthconst(op)
3567 OP *op;
3568 {
3569     /* XXX length optimization goes here */
3570     return ck_fun(op);
3571 }
3572
3573 OP *
3574 ck_lfun(op)
3575 OP *op;
3576 {
3577     return modkids(ck_fun(op), op->op_type);
3578 }
3579
3580 OP *
3581 ck_rfun(op)
3582 OP *op;
3583 {
3584     return refkids(ck_fun(op), op->op_type);
3585 }
3586
3587 OP *
3588 ck_listiob(op)
3589 OP *op;
3590 {
3591     register OP *kid;
3592
3593     kid = cLISTOP->op_first;
3594     if (!kid) {
3595         op = force_list(op);
3596         kid = cLISTOP->op_first;
3597     }
3598     if (kid->op_type == OP_PUSHMARK)
3599         kid = kid->op_sibling;
3600     if (kid && op->op_flags & OPf_STACKED)
3601         kid = kid->op_sibling;
3602     else if (kid && !kid->op_sibling) {         /* print HANDLE; */
3603         if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
3604             op->op_flags |= OPf_STACKED;        /* make it a filehandle */
3605             kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
3606             cLISTOP->op_first->op_sibling = kid;
3607             cLISTOP->op_last = kid;
3608             kid = kid->op_sibling;
3609         }
3610     }
3611
3612     if (!kid)
3613         append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3614
3615     return listkids(op);
3616 }
3617
3618 OP *
3619 ck_match(op)
3620 OP *op;
3621 {
3622     cPMOP->op_pmflags |= PMf_RUNTIME;
3623     return op;
3624 }
3625
3626 OP *
3627 ck_null(op)
3628 OP *op;
3629 {
3630     return op;
3631 }
3632
3633 OP *
3634 ck_repeat(op)
3635 OP *op;
3636 {
3637     if (cBINOP->op_first->op_flags & OPf_PARENS) {
3638         op->op_private = OPpREPEAT_DOLIST;
3639         cBINOP->op_first = force_list(cBINOP->op_first);
3640     }
3641     else
3642         scalar(op);
3643     return op;
3644 }
3645
3646 OP *
3647 ck_require(op)
3648 OP *op;
3649 {
3650     if (op->op_flags & OPf_KIDS) {      /* Shall we supply missing .pm? */
3651         SVOP *kid = (SVOP*)cUNOP->op_first;
3652
3653         if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
3654             char *s;
3655             for (s = SvPVX(kid->op_sv); *s; s++) {
3656                 if (*s == ':' && s[1] == ':') {
3657                     *s = '/';
3658                     Move(s+2, s+1, strlen(s+2)+1, char);
3659                     --SvCUR(kid->op_sv);
3660                 }
3661             }
3662             sv_catpvn(kid->op_sv, ".pm", 3);
3663         }
3664     }
3665     return ck_fun(op);
3666 }
3667
3668 OP *
3669 ck_retarget(op)
3670 OP *op;
3671 {
3672     croak("NOT IMPL LINE %d",__LINE__);
3673     /* STUB */
3674     return op;
3675 }
3676
3677 OP *
3678 ck_select(op)
3679 OP *op;
3680 {
3681     if (op->op_flags & OPf_KIDS) {
3682         OP *kid = cLISTOP->op_first->op_sibling;        /* get past pushmark */
3683         if (kid && kid->op_sibling) {
3684             op->op_type = OP_SSELECT;
3685             op->op_ppaddr = ppaddr[OP_SSELECT];
3686             op = ck_fun(op);
3687             return fold_constants(op);
3688         }
3689     }
3690     return ck_fun(op);
3691 }
3692
3693 OP *
3694 ck_shift(op)
3695 OP *op;
3696 {
3697     I32 type = op->op_type;
3698
3699     if (!(op->op_flags & OPf_KIDS)) {
3700         op_free(op);
3701         return newUNOP(type, 0,
3702             scalar(newUNOP(OP_RV2AV, 0,
3703                 scalar(newGVOP(OP_GV, 0,
3704                     gv_fetchpv((subline ? "_" : "ARGV"), TRUE, SVt_PVAV) )))));
3705     }
3706     return scalar(modkids(ck_fun(op), type));
3707 }
3708
3709 OP *
3710 ck_sort(op)
3711 OP *op;
3712 {
3713     if (op->op_flags & OPf_STACKED) {
3714         OP *kid = cLISTOP->op_first->op_sibling;        /* get past pushmark */
3715         OP *k;
3716         kid = kUNOP->op_first;                          /* get past rv2gv */
3717
3718         if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
3719             linklist(kid);
3720             if (kid->op_type == OP_SCOPE) {
3721                 k = kid->op_next;
3722                 kid->op_next = 0;
3723             }
3724             else if (kid->op_type == OP_LEAVE) {
3725                 if (op->op_type == OP_SORT) {
3726                     null(kid);                  /* wipe out leave */
3727                     kid->op_next = kid;
3728
3729                     for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
3730                         if (k->op_next == kid)
3731                             k->op_next = 0;
3732                     }
3733                 }
3734                 else
3735                     kid->op_next = 0;           /* just disconnect the leave */
3736                 k = kLISTOP->op_first;
3737             }
3738             peep(k);
3739
3740             kid = cLISTOP->op_first->op_sibling;        /* get past pushmark */
3741             null(kid);                                  /* wipe out rv2gv */
3742             if (op->op_type == OP_SORT)
3743                 kid->op_next = kid;
3744             else
3745                 kid->op_next = k;
3746             op->op_flags |= OPf_SPECIAL;
3747         }
3748     }
3749     return op;
3750 }
3751
3752 OP *
3753 ck_split(op)
3754 OP *op;
3755 {
3756     register OP *kid;
3757     PMOP* pm;
3758
3759     if (op->op_flags & OPf_STACKED)
3760         return no_fh_allowed(op);
3761
3762     kid = cLISTOP->op_first;
3763     if (kid->op_type != OP_NULL)
3764         croak("panic: ck_split");
3765     kid = kid->op_sibling;
3766     op_free(cLISTOP->op_first);
3767     cLISTOP->op_first = kid;
3768     if (!kid) {
3769         cLISTOP->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
3770         cLISTOP->op_last = kid; /* There was only one element previously */
3771     }
3772
3773     if (kid->op_type != OP_MATCH) {
3774         OP *sibl = kid->op_sibling;
3775         kid->op_sibling = 0;
3776         kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
3777         if (cLISTOP->op_first == cLISTOP->op_last)
3778             cLISTOP->op_last = kid;
3779         cLISTOP->op_first = kid;
3780         kid->op_sibling = sibl;
3781     }
3782     pm = (PMOP*)kid;
3783     if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
3784         SvREFCNT_dec(pm->op_pmshort);   /* can't use substring to optimize */
3785         pm->op_pmshort = 0;
3786     }
3787
3788     kid->op_type = OP_PUSHRE;
3789     kid->op_ppaddr = ppaddr[OP_PUSHRE];
3790     scalar(kid);
3791
3792     if (!kid->op_sibling)
3793         append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3794
3795     kid = kid->op_sibling;
3796     scalar(kid);
3797
3798     if (!kid->op_sibling)
3799         append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0)));
3800
3801     kid = kid->op_sibling;
3802     scalar(kid);
3803
3804     if (kid->op_sibling)
3805         return too_many_arguments(op);
3806
3807     return op;
3808 }
3809
3810 OP *
3811 ck_subr(op)
3812 OP *op;
3813 {
3814     OP *o = ((cUNOP->op_first->op_sibling)
3815              ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first->op_sibling;
3816
3817     if (o->op_type == OP_RV2CV)
3818         null(o);                /* disable rv2cv */
3819     op->op_private = (hints & HINT_STRICT_REFS);
3820     if (perldb && curstash != debstash)
3821         op->op_private |= OPpDEREF_DB;
3822     while (o = o->op_sibling)
3823         mod(o, OP_ENTERSUB);
3824     return op;
3825 }
3826
3827 OP *
3828 ck_svconst(op)
3829 OP *op;
3830 {
3831     SvREADONLY_on(cSVOP->op_sv);
3832     return op;
3833 }
3834
3835 OP *
3836 ck_trunc(op)
3837 OP *op;
3838 {
3839     if (op->op_flags & OPf_KIDS) {
3840         SVOP *kid = (SVOP*)cUNOP->op_first;
3841
3842         if (kid->op_type == OP_NULL)
3843             kid = (SVOP*)kid->op_sibling;
3844         if (kid &&
3845           kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
3846             op->op_flags |= OPf_SPECIAL;
3847     }
3848     return ck_fun(op);
3849 }
3850
3851 /* A peephole optimizer.  We visit the ops in the order they're to execute. */
3852
3853 void
3854 peep(o)
3855 register OP* o;
3856 {
3857     register OP* oldop = 0;
3858     if (!o || o->op_seq)
3859         return;
3860     ENTER;
3861     SAVESPTR(op);
3862     SAVESPTR(curcop);
3863     for (; o; o = o->op_next) {
3864         if (o->op_seq)
3865             break;
3866         op = o;
3867         switch (o->op_type) {
3868         case OP_NEXTSTATE:
3869         case OP_DBSTATE:
3870             curcop = ((COP*)o);         /* for warnings */
3871             o->op_seq = ++op_seqmax;
3872             break;
3873
3874         case OP_CONCAT:
3875         case OP_CONST:
3876         case OP_JOIN:
3877         case OP_UC:
3878         case OP_UCFIRST:
3879         case OP_LC:
3880         case OP_LCFIRST:
3881         case OP_QUOTEMETA:
3882             if (o->op_next->op_type == OP_STRINGIFY)
3883                 null(o->op_next);
3884             o->op_seq = ++op_seqmax;
3885             break;
3886         case OP_STUB:
3887             if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) {
3888                 o->op_seq = ++op_seqmax;
3889                 break;  /* Scalar stub must produce undef.  List stub is noop */
3890             }
3891             goto nothin;
3892         case OP_NULL:
3893             if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
3894                 curcop = ((COP*)op);
3895             goto nothin;
3896         case OP_SCALAR:
3897         case OP_LINESEQ:
3898         case OP_SCOPE:
3899           nothin:
3900             if (oldop && o->op_next) {
3901                 oldop->op_next = o->op_next;
3902                 continue;
3903             }
3904             o->op_seq = ++op_seqmax;
3905             break;
3906
3907         case OP_GV:
3908             if (o->op_next->op_type == OP_RV2SV) {
3909                 if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) {
3910                     null(o->op_next);
3911                     o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
3912                     o->op_next = o->op_next->op_next;
3913                     o->op_type = OP_GVSV;
3914                     o->op_ppaddr = ppaddr[OP_GVSV];
3915                 }
3916             }
3917             else if (o->op_next->op_type == OP_RV2AV) {
3918                 OP* pop = o->op_next->op_next;
3919                 IV i;
3920                 if (pop->op_type == OP_CONST &&
3921                     (op = pop->op_next) &&
3922                     pop->op_next->op_type == OP_AELEM &&
3923                     !(pop->op_next->op_private &
3924                         (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) &&
3925                     (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
3926                                 <= 255 &&
3927                     i >= 0)
3928                 {
3929                     SvREFCNT_dec(((SVOP*)pop)->op_sv);
3930                     null(o->op_next);
3931                     null(pop->op_next);
3932                     null(pop);
3933                     o->op_flags |= pop->op_next->op_flags & OPf_MOD;
3934                     o->op_next = pop->op_next->op_next;
3935                     o->op_type = OP_AELEMFAST;
3936                     o->op_ppaddr = ppaddr[OP_AELEMFAST];
3937                     o->op_private = (U8)i;
3938                     GvAVn((GV*)(((SVOP*)o)->op_sv));
3939                 }
3940             }
3941             o->op_seq = ++op_seqmax;
3942             break;
3943
3944         case OP_MAPWHILE:
3945         case OP_GREPWHILE:
3946         case OP_AND:
3947         case OP_OR:
3948             o->op_seq = ++op_seqmax;
3949             peep(cLOGOP->op_other);
3950             break;
3951
3952         case OP_COND_EXPR:
3953             o->op_seq = ++op_seqmax;
3954             peep(cCONDOP->op_true);
3955             peep(cCONDOP->op_false);
3956             break;
3957
3958         case OP_ENTERLOOP:
3959             o->op_seq = ++op_seqmax;
3960             peep(cLOOP->op_redoop);
3961             peep(cLOOP->op_nextop);
3962             peep(cLOOP->op_lastop);
3963             break;
3964
3965         case OP_MATCH:
3966         case OP_SUBST:
3967             o->op_seq = ++op_seqmax;
3968             peep(cPMOP->op_pmreplstart);
3969             break;
3970
3971         case OP_EXEC:
3972             o->op_seq = ++op_seqmax;
3973             if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
3974                 if (o->op_next->op_sibling &&
3975                         o->op_next->op_sibling->op_type != OP_DIE) {
3976                     line_t oldline = curcop->cop_line;
3977
3978                     curcop->cop_line = ((COP*)o->op_next)->cop_line;
3979                     warn("Statement unlikely to be reached");
3980                     warn("(Maybe you meant system() when you said exec()?)\n");
3981                     curcop->cop_line = oldline;
3982                 }
3983             }
3984             break;
3985         default:
3986             o->op_seq = ++op_seqmax;
3987             break;
3988         }
3989         oldop = o;
3990     }
3991     LEAVE;
3992 }