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