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