op.c

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