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