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