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