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