op.c

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