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