This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
d345575cc8c56f1cf42b007d03e3846e9314512e
[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         kid->op_sv = SvREFCNT_inc(gv);
3137     }
3138     return op;
3139 }
3140
3141 OP *
3142 ck_formline(op)
3143 OP *op;
3144 {
3145     return ck_fun(op);
3146 }
3147
3148 OP *
3149 ck_ftst(op)
3150 OP *op;
3151 {
3152     I32 type = op->op_type;
3153
3154     if (op->op_flags & OPf_REF)
3155         return op;
3156
3157     if (op->op_flags & OPf_KIDS) {
3158         SVOP *kid = (SVOP*)cUNOP->op_first;
3159
3160         if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
3161             OP *newop = newGVOP(type, OPf_REF,
3162                 gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
3163             op_free(op);
3164             return newop;
3165         }
3166     }
3167     else {
3168         op_free(op);
3169         if (type == OP_FTTTY)
3170             return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
3171                                 SVt_PVIO));
3172         else
3173             return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3174     }
3175     return op;
3176 }
3177
3178 OP *
3179 ck_fun(op)
3180 OP *op;
3181 {
3182     register OP *kid;
3183     OP **tokid;
3184     OP *sibl;
3185     I32 numargs = 0;
3186     int type = op->op_type;
3187     register I32 oa = opargs[type] >> OASHIFT;
3188     
3189     if (op->op_flags & OPf_STACKED) {
3190         if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
3191             oa &= ~OA_OPTIONAL;
3192         else
3193             return no_fh_allowed(op);
3194     }
3195
3196     if (op->op_flags & OPf_KIDS) {
3197         tokid = &cLISTOP->op_first;
3198         kid = cLISTOP->op_first;
3199         if (kid->op_type == OP_PUSHMARK ||
3200             kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
3201         {
3202             tokid = &kid->op_sibling;
3203             kid = kid->op_sibling;
3204         }
3205         if (!kid && opargs[type] & OA_DEFGV)
3206             *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
3207
3208         while (oa && kid) {
3209             numargs++;
3210             sibl = kid->op_sibling;
3211             switch (oa & 7) {
3212             case OA_SCALAR:
3213                 scalar(kid);
3214                 break;
3215             case OA_LIST:
3216                 if (oa < 16) {
3217                     kid = 0;
3218                     continue;
3219                 }
3220                 else
3221                     list(kid);
3222                 break;
3223             case OA_AVREF:
3224                 if (kid->op_type == OP_CONST &&
3225                   (kid->op_private & OPpCONST_BARE)) {
3226                     char *name = SvPVx(((SVOP*)kid)->op_sv, na);
3227                     OP *newop = newAVREF(newGVOP(OP_GV, 0,
3228                         gv_fetchpv(name, TRUE, SVt_PVAV) ));
3229                     if (dowarn)
3230                         warn("Array @%s missing the @ in argument %d of %s()",
3231                             name, numargs, op_name[type]);
3232                     op_free(kid);
3233                     kid = newop;
3234                     kid->op_sibling = sibl;
3235                     *tokid = kid;
3236                 }
3237                 else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
3238                     bad_type(numargs, "array", op, kid);
3239                 mod(kid, type);
3240                 break;
3241             case OA_HVREF:
3242                 if (kid->op_type == OP_CONST &&
3243                   (kid->op_private & OPpCONST_BARE)) {
3244                     char *name = SvPVx(((SVOP*)kid)->op_sv, na);
3245                     OP *newop = newHVREF(newGVOP(OP_GV, 0,
3246                         gv_fetchpv(name, TRUE, SVt_PVHV) ));
3247                     if (dowarn)
3248                         warn("Hash %%%s missing the %% in argument %d of %s()",
3249                             name, numargs, op_name[type]);
3250                     op_free(kid);
3251                     kid = newop;
3252                     kid->op_sibling = sibl;
3253                     *tokid = kid;
3254                 }
3255                 else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
3256                     bad_type(numargs, "hash", op, kid);
3257                 mod(kid, type);
3258                 break;
3259             case OA_CVREF:
3260                 {
3261                     OP *newop = newUNOP(OP_NULL, 0, kid);
3262                     kid->op_sibling = 0;
3263                     linklist(kid);
3264                     newop->op_next = newop;
3265                     kid = newop;
3266                     kid->op_sibling = sibl;
3267                     *tokid = kid;
3268                 }
3269                 break;
3270             case OA_FILEREF:
3271                 if (kid->op_type != OP_GV) {
3272                     if (kid->op_type == OP_CONST &&
3273                       (kid->op_private & OPpCONST_BARE)) {
3274                         OP *newop = newGVOP(OP_GV, 0,
3275                             gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE,
3276                                         SVt_PVIO) );
3277                         op_free(kid);
3278                         kid = newop;
3279                     }
3280                     else {
3281                         kid->op_sibling = 0;
3282                         kid = newUNOP(OP_RV2GV, 0, scalar(kid));
3283                     }
3284                     kid->op_sibling = sibl;
3285                     *tokid = kid;
3286                 }
3287                 scalar(kid);
3288                 break;
3289             case OA_SCALARREF:
3290                 mod(scalar(kid), type);
3291                 break;
3292             }
3293             oa >>= 4;
3294             tokid = &kid->op_sibling;
3295             kid = kid->op_sibling;
3296         }
3297         op->op_private = numargs;
3298         if (kid)
3299             return too_many_arguments(op);
3300         listkids(op);
3301     }
3302     else if (opargs[type] & OA_DEFGV) {
3303         op_free(op);
3304         return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3305     }
3306
3307     if (oa) {
3308         while (oa & OA_OPTIONAL)
3309             oa >>= 4;
3310         if (oa && oa != OA_LIST)
3311             return too_few_arguments(op);
3312     }
3313     return op;
3314 }
3315
3316 OP *
3317 ck_glob(op)
3318 OP *op;
3319 {
3320     GV *gv = newGVgen("main");
3321     gv_IOadd(gv);
3322     append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
3323     scalarkids(op);
3324     return ck_fun(op);
3325 }
3326
3327 OP *
3328 ck_grep(op)
3329 OP *op;
3330 {
3331     LOGOP *gwop;
3332     OP *kid;
3333     OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
3334
3335     op->op_ppaddr = ppaddr[OP_GREPSTART];
3336     Newz(1101, gwop, 1, LOGOP);
3337     
3338     if (op->op_flags & OPf_STACKED) {
3339         OP* k;
3340         op = ck_sort(op);
3341         for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) {
3342             kid = k;
3343         }
3344         kid->op_next = (OP*)gwop;
3345         op->op_flags &= ~OPf_STACKED;
3346     }
3347     kid = cLISTOP->op_first->op_sibling;
3348     if (type == OP_MAPWHILE)
3349         list(kid);
3350     else
3351         scalar(kid);
3352     op = ck_fun(op);
3353     if (error_count)
3354         return op;
3355     kid = cLISTOP->op_first->op_sibling; 
3356     if (kid->op_type != OP_NULL)
3357         croak("panic: ck_grep");
3358     kid = kUNOP->op_first;
3359
3360     gwop->op_type = type;
3361     gwop->op_ppaddr = ppaddr[type];
3362     gwop->op_first = listkids(op);
3363     gwop->op_flags |= OPf_KIDS;
3364     gwop->op_private = 1;
3365     gwop->op_other = LINKLIST(kid);
3366     gwop->op_targ = pad_alloc(type, SVs_PADTMP);
3367     kid->op_next = (OP*)gwop;
3368
3369     kid = cLISTOP->op_first->op_sibling;
3370     if (!kid || !kid->op_sibling)
3371         return too_few_arguments(op);
3372     for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
3373         mod(kid, OP_GREPSTART);
3374
3375     return (OP*)gwop;
3376 }
3377
3378 OP *
3379 ck_index(op)
3380 OP *op;
3381 {
3382     if (op->op_flags & OPf_KIDS) {
3383         OP *kid = cLISTOP->op_first->op_sibling;        /* get past pushmark */
3384         if (kid && kid->op_type == OP_CONST)
3385             fbm_compile(((SVOP*)kid)->op_sv, 0);
3386     }
3387     return ck_fun(op);
3388 }
3389
3390 OP *
3391 ck_lengthconst(op)
3392 OP *op;
3393 {
3394     /* XXX length optimization goes here */
3395     return ck_fun(op);
3396 }
3397
3398 OP *
3399 ck_lfun(op)
3400 OP *op;
3401 {
3402     return modkids(ck_fun(op), op->op_type);
3403 }
3404
3405 OP *
3406 ck_rfun(op)
3407 OP *op;
3408 {
3409     return refkids(ck_fun(op), op->op_type);
3410 }
3411
3412 OP *
3413 ck_listiob(op)
3414 OP *op;
3415 {
3416     register OP *kid;
3417     
3418     kid = cLISTOP->op_first;
3419     if (!kid) {
3420         op = force_list(op);
3421         kid = cLISTOP->op_first;
3422     }
3423     if (kid->op_type == OP_PUSHMARK)
3424         kid = kid->op_sibling;
3425     if (kid && op->op_flags & OPf_STACKED)
3426         kid = kid->op_sibling;
3427     else if (kid && !kid->op_sibling) {         /* print HANDLE; */
3428         if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
3429             op->op_flags |= OPf_STACKED;        /* make it a filehandle */
3430             kid = newUNOP(OP_RV2GV, 0, scalar(kid));
3431             cLISTOP->op_first->op_sibling = kid;
3432             cLISTOP->op_last = kid;
3433             kid = kid->op_sibling;
3434         }
3435     }
3436         
3437     if (!kid)
3438         append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3439
3440     return listkids(op);
3441 }
3442
3443 OP *
3444 ck_match(op)
3445 OP *op;
3446 {
3447     cPMOP->op_pmflags |= PMf_RUNTIME;
3448     return op;
3449 }
3450
3451 OP *
3452 ck_null(op)
3453 OP *op;
3454 {
3455     return op;
3456 }
3457
3458 OP *
3459 ck_repeat(op)
3460 OP *op;
3461 {
3462     if (cBINOP->op_first->op_flags & OPf_PARENS) {
3463         op->op_private = OPpREPEAT_DOLIST;
3464         cBINOP->op_first = force_list(cBINOP->op_first);
3465     }
3466     else
3467         scalar(op);
3468     return op;
3469 }
3470
3471 OP *
3472 ck_require(op)
3473 OP *op;
3474 {
3475     if (op->op_flags & OPf_KIDS) {      /* Shall we supply missing .pm? */
3476         SVOP *kid = (SVOP*)cUNOP->op_first;
3477
3478         if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
3479             char *s;
3480             for (s = SvPVX(kid->op_sv); *s; s++) {
3481                 if (*s == ':' && s[1] == ':') {
3482                     *s = '/';
3483                     strcpy(s+1,s+2);    /* known to be okay here */
3484                     --SvCUR(kid->op_sv);
3485                 }
3486             }
3487             sv_catpvn(kid->op_sv, ".pm", 3);
3488         }
3489     }
3490     return ck_fun(op);
3491 }
3492
3493 OP *
3494 ck_retarget(op)
3495 OP *op;
3496 {
3497     croak("NOT IMPL LINE %d",__LINE__);
3498     /* STUB */
3499     return op;
3500 }
3501
3502 OP *
3503 ck_select(op)
3504 OP *op;
3505 {
3506     if (op->op_flags & OPf_KIDS) {
3507         OP *kid = cLISTOP->op_first->op_sibling;        /* get past pushmark */
3508         if (kid && kid->op_sibling) {
3509             op->op_type = OP_SSELECT;
3510             op->op_ppaddr = ppaddr[OP_SSELECT];
3511             op = ck_fun(op);
3512             return fold_constants(op);
3513         }
3514     }
3515     return ck_fun(op);
3516 }
3517
3518 OP *
3519 ck_shift(op)
3520 OP *op;
3521 {
3522     I32 type = op->op_type;
3523
3524     if (!(op->op_flags & OPf_KIDS)) {
3525         op_free(op);
3526         return newUNOP(type, 0,
3527             scalar(newUNOP(OP_RV2AV, 0,
3528                 scalar(newGVOP(OP_GV, 0,
3529                     gv_fetchpv((subline ? "_" : "ARGV"), TRUE, SVt_PVAV) )))));
3530     }
3531     return scalar(modkids(ck_fun(op), type));
3532 }
3533
3534 OP *
3535 ck_sort(op)
3536 OP *op;
3537 {
3538     if (op->op_flags & OPf_STACKED) {
3539         OP *kid = cLISTOP->op_first->op_sibling;        /* get past pushmark */
3540         OP *k;
3541         kid = kUNOP->op_first;                          /* get past rv2gv */
3542
3543         if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
3544             linklist(kid);
3545             if (kid->op_type == OP_SCOPE) {
3546                 k = kid->op_next;
3547                 kid->op_next = 0;
3548             }
3549             else if (kid->op_type == OP_LEAVE) {
3550                 null(kid);                      /* wipe out leave */
3551                 kid->op_next = kid;
3552
3553                 for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
3554                     if (k->op_next == kid)
3555                         k->op_next = 0;
3556                 }
3557                 k = kLISTOP->op_first;
3558             }
3559             peep(k);
3560
3561             kid = cLISTOP->op_first->op_sibling;        /* get past pushmark */
3562             null(kid);                                  /* wipe out rv2gv */
3563             if (op->op_type == OP_SORT)
3564                 kid->op_next = kid;
3565             else
3566                 kid->op_next = k;
3567             op->op_flags |= OPf_SPECIAL;
3568         }
3569     }
3570     return op;
3571 }
3572
3573 OP *
3574 ck_split(op)
3575 OP *op;
3576 {
3577     register OP *kid;
3578     PMOP* pm;
3579     
3580     if (op->op_flags & OPf_STACKED)
3581         return no_fh_allowed(op);
3582
3583     kid = cLISTOP->op_first;
3584     if (kid->op_type != OP_NULL)
3585         croak("panic: ck_split");
3586     kid = kid->op_sibling;
3587     op_free(cLISTOP->op_first);
3588     cLISTOP->op_first = kid;
3589     if (!kid) {
3590         cLISTOP->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
3591         cLISTOP->op_last = kid; /* There was only one element previously */
3592     }
3593
3594     if (kid->op_type != OP_MATCH) {
3595         OP *sibl = kid->op_sibling;
3596         kid->op_sibling = 0;
3597         kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
3598         if (cLISTOP->op_first == cLISTOP->op_last)
3599             cLISTOP->op_last = kid;
3600         cLISTOP->op_first = kid;
3601         kid->op_sibling = sibl;
3602     }
3603     pm = (PMOP*)kid;
3604     if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
3605         SvREFCNT_dec(pm->op_pmshort);   /* can't use substring to optimize */
3606         pm->op_pmshort = 0;
3607     }
3608
3609     kid->op_type = OP_PUSHRE;
3610     kid->op_ppaddr = ppaddr[OP_PUSHRE];
3611     scalar(kid);
3612
3613     if (!kid->op_sibling)
3614         append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3615
3616     kid = kid->op_sibling;
3617     scalar(kid);
3618
3619     if (!kid->op_sibling)
3620         append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0)));
3621
3622     kid = kid->op_sibling;
3623     scalar(kid);
3624
3625     if (kid->op_sibling)
3626         return too_many_arguments(op);
3627
3628     return op;
3629 }
3630
3631 OP *
3632 ck_subr(op)
3633 OP *op;
3634 {
3635     OP *o = ((cUNOP->op_first->op_sibling)
3636              ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first->op_sibling;
3637
3638     if (o->op_type == OP_RV2CV)
3639         null(o);                /* disable rv2cv */
3640     op->op_private = (hints & HINT_STRICT_REFS);
3641     if (perldb && curstash != debstash)
3642         op->op_private |= OPpDEREF_DB;
3643     while (o = o->op_sibling)
3644         mod(o, OP_ENTERSUB);
3645     return op;
3646 }
3647
3648 OP *
3649 ck_svconst(op)
3650 OP *op;
3651 {
3652     SvREADONLY_on(cSVOP->op_sv);
3653     return op;
3654 }
3655
3656 OP *
3657 ck_trunc(op)
3658 OP *op;
3659 {
3660     if (op->op_flags & OPf_KIDS) {
3661         SVOP *kid = (SVOP*)cUNOP->op_first;
3662
3663         if (kid->op_type == OP_NULL)
3664             kid = (SVOP*)kid->op_sibling;
3665         if (kid &&
3666           kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
3667             op->op_flags |= OPf_SPECIAL;
3668     }
3669     return ck_fun(op);
3670 }
3671
3672 /* A peephole optimizer.  We visit the ops in the order they're to execute. */
3673
3674 void
3675 peep(o)
3676 register OP* o;
3677 {
3678     register OP* oldop = 0;
3679     if (!o || o->op_seq)
3680         return;
3681     ENTER;
3682     SAVESPTR(op);
3683     SAVESPTR(curcop);
3684     for (; o; o = o->op_next) {
3685         if (o->op_seq)
3686             break;
3687         op = o;
3688         switch (o->op_type) {
3689         case OP_NEXTSTATE:
3690         case OP_DBSTATE:
3691             curcop = ((COP*)o);         /* for warnings */
3692             break;
3693
3694         case OP_CONCAT:
3695         case OP_CONST:
3696         case OP_JOIN:
3697         case OP_UC:
3698         case OP_UCFIRST:
3699         case OP_LC:
3700         case OP_LCFIRST:
3701         case OP_QUOTEMETA:
3702             if (o->op_next->op_type == OP_STRINGIFY)
3703                 null(o->op_next);
3704             o->op_seq = ++op_seqmax;
3705             break;
3706         case OP_STUB:
3707             if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) {
3708                 o->op_seq = ++op_seqmax;
3709                 break;  /* Scalar stub must produce undef.  List stub is noop */
3710             }
3711             /* FALL THROUGH */
3712         case OP_NULL:
3713         case OP_SCALAR:
3714         case OP_LINESEQ:
3715         case OP_SCOPE:
3716             if (oldop && o->op_next) {
3717                 oldop->op_next = o->op_next;
3718                 continue;
3719             }
3720             o->op_seq = ++op_seqmax;
3721             break;
3722
3723         case OP_GV:
3724             if (o->op_next->op_type == OP_RV2SV) {
3725                 if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) {
3726                     null(o->op_next);
3727                     o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
3728                     o->op_next = o->op_next->op_next;
3729                     o->op_type = OP_GVSV;
3730                     o->op_ppaddr = ppaddr[OP_GVSV];
3731                 }
3732             }
3733             else if (o->op_next->op_type == OP_RV2AV) {
3734                 OP* pop = o->op_next->op_next;
3735                 IV i;
3736                 if (pop->op_type == OP_CONST &&
3737                     (op = pop->op_next) &&
3738                     pop->op_next->op_type == OP_AELEM &&
3739                     !(pop->op_next->op_private &
3740                         (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) &&
3741                     (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
3742                                 <= 255 &&
3743                     i >= 0)
3744                 {
3745                     null(o->op_next);
3746                     null(pop->op_next);
3747                     null(pop);
3748                     o->op_flags |= pop->op_next->op_flags & OPf_MOD;
3749                     o->op_next = pop->op_next->op_next;
3750                     o->op_type = OP_AELEMFAST;
3751                     o->op_ppaddr = ppaddr[OP_AELEMFAST];
3752                     o->op_private = (U8)i;
3753                     GvAVn((GV*)(((SVOP*)o)->op_sv));
3754                 }
3755             }
3756             o->op_seq = ++op_seqmax;
3757             break;
3758
3759         case OP_MAPWHILE:
3760         case OP_GREPWHILE:
3761         case OP_AND:
3762         case OP_OR:
3763             o->op_seq = ++op_seqmax;
3764             peep(cLOGOP->op_other);
3765             break;
3766
3767         case OP_COND_EXPR:
3768             o->op_seq = ++op_seqmax;
3769             peep(cCONDOP->op_true);
3770             peep(cCONDOP->op_false);
3771             break;
3772
3773         case OP_ENTERLOOP:
3774             o->op_seq = ++op_seqmax;
3775             peep(cLOOP->op_redoop);
3776             peep(cLOOP->op_nextop);
3777             peep(cLOOP->op_lastop);
3778             break;
3779
3780         case OP_MATCH:
3781         case OP_SUBST:
3782             o->op_seq = ++op_seqmax;
3783             peep(cPMOP->op_pmreplstart);
3784             break;
3785
3786         case OP_EXEC:
3787             o->op_seq = ++op_seqmax;
3788             if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
3789                 if (o->op_next->op_sibling &&
3790                         o->op_next->op_sibling->op_type != OP_DIE) {
3791                     line_t oldline = curcop->cop_line;
3792
3793                     curcop->cop_line = ((COP*)o->op_next)->cop_line;
3794                     warn("Statement unlikely to be reached");
3795                     warn("(Maybe you meant system() when you said exec()?)\n");
3796                     curcop->cop_line = oldline;
3797                 }
3798             }
3799             break;
3800         default:
3801             o->op_seq = ++op_seqmax;
3802             break;
3803         }
3804         oldop = o;
3805     }
3806     LEAVE;
3807 }