op.c

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