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