op.c

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