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