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