This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
perl 5.0 alpha 3
[perl5.git] / op.c
CommitLineData
79072805
LW		 1/* $RCSfile: cmd.h,v $$Revision: 4.1 $$Date: 92/08/07 17:19:19 $
2 *
3 * Copyright (c) 1991, 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 * $Log: cmd.h,v $
9 */
10
11#include "EXTERN.h"
12#include "perl.h"
13
14extern int yychar;
15
16/* Lowest byte of opargs */
17#define OA_MARK 1
18#define OA_FOLDCONST 2
19#define OA_RETSCALAR 4
20#define OA_TARGET 8
21#define OA_RETINTEGER 16
22#define OA_OTHERINT 32
23#define OA_DANGEROUS 64
24
25/* Remaining nybbles of opargs */
26#define OA_SCALAR 1
27#define OA_LIST 2
28#define OA_AVREF 3
29#define OA_HVREF 4
30#define OA_CVREF 5
31#define OA_FILEREF 6
32#define OA_SCALARREF 7
33#define OA_OPTIONAL 8
34
79072805
LW		 35void
36cpy7bit(d,s,l)
37register char *d;
38register char *s;
39register I32 l;
40{
41 while (l--)
42 *d++ = *s++ & 127;
43 *d = '\0';
44}
45
46int
47yyerror(s)
48char *s;
49{
50 char tmpbuf[258];
51 char tmp2buf[258];
52 char *tname = tmpbuf;
53
54 if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
55 oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
56 while (isSPACE(*oldoldbufptr))
57 oldoldbufptr++;
58 cpy7bit(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
59 sprintf(tname,"next 2 tokens \"%s\"",tmp2buf);
60 }
61 else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
62 oldbufptr != bufptr) {
63 while (isSPACE(*oldbufptr))
64 oldbufptr++;
65 cpy7bit(tmp2buf, oldbufptr, bufptr - oldbufptr);
66 sprintf(tname,"next token \"%s\"",tmp2buf);
67 }
68 else if (yychar > 255)
69 tname = "next token ???";
70 else if (!yychar || (yychar == ';' && !rsfp))
71 (void)strcpy(tname,"at EOF");
72 else if ((yychar & 127) == 127)
73 (void)strcpy(tname,"at end of line");
74 else if (yychar < 32)
75 (void)sprintf(tname,"next char ^%c",yychar+64);
76 else
77 (void)sprintf(tname,"next char %c",yychar);
78 (void)sprintf(buf, "%s at %s line %d, %s\n",
79 s,SvPV(GvSV(curcop->cop_filegv)),curcop->cop_line,tname);
80 if (curcop->cop_line == multi_end && multi_start < multi_end)
81 sprintf(buf+strlen(buf),
82 " (Might be a runaway multi-line %c%c string starting on line %d)\n",
83 multi_open,multi_close,multi_start);
84 if (in_eval)
85 sv_catpv(GvSV(gv_fetchpv("@",TRUE)),buf);
86 else
87 fputs(buf,stderr);
88 if (++error_count >= 10)
89 fatal("%s has too many errors.\n",
90 SvPV(GvSV(curcop->cop_filegv)));
91 return 0;
92}
93
94OP *
95no_fh_allowed(op)
96OP *op;
97{
98 sprintf(tokenbuf,"Missing comma after first argument to %s function",
99 op_name[op->op_type]);
100 yyerror(tokenbuf);
101 return op;
102}
103
104OP *
105too_few_arguments(op)
106OP *op;
107{
108 sprintf(tokenbuf,"Not enough arguments for %s", op_name[op->op_type]);
109 yyerror(tokenbuf);
110 return op;
111}
112
113OP *
114too_many_arguments(op)
115OP *op;
116{
117 sprintf(tokenbuf,"Too many arguments for %s", op_name[op->op_type]);
118 yyerror(tokenbuf);
119 return op;
120}
121
122/* "register" allocation */
123
124PADOFFSET
93a17b20
LW		 125pad_allocmy(name)
126char *name;
127{
128 PADOFFSET off = pad_alloc(OP_PADSV, 'M');
129 SV *sv = NEWSV(0,0);
130 sv_upgrade(sv, SVt_PVNV);
131 sv_setpv(sv, name);
132 av_store(comppadname, off, sv);
133 SvNV(sv) = (double)cop_seq;
134 SvIV(sv) = 99999999;
135 if (*name == '@')
136 av_store(comppad, off, newAV());
137 else if (*name == '%')
138 av_store(comppad, off, newHV(COEFFSIZE));
139 return off;
140}
141
142PADOFFSET
143pad_findmy(name)
144char *name;
145{
146 I32 off;
147 SV *sv;
148 SV **svp = AvARRAY(comppadname);
149 register I32 i;
150 register CONTEXT *cx;
151 bool saweval;
152 AV *curlist;
153 AV *curname;
154 CV *cv;
155 I32 seq = cop_seq;
156
157 for (off = comppadnamefill; off > 0; off--) {
158 if ((sv = svp[off]) &&
159 seq <= SvIV(sv) &&
160 seq > (I32)SvNV(sv) &&
161 strEQ(SvPV(sv), name))
162 {
163 return (PADOFFSET)off;
164 }
165 }
166
167 /* Nothing in current lexical context--try eval's context, if any.
168 * This is necessary to let the perldb get at lexically scoped variables.
169 * XXX This will also probably interact badly with eval tree caching.
170 */
171
172 saweval = FALSE;
173 for (i = cxstack_ix; i >= 0; i--) {
174 cx = &cxstack[i];
175 switch (cx->cx_type) {
176 default:
177 break;
178 case CXt_EVAL:
179 saweval = TRUE;
180 break;
181 case CXt_SUB:
182 if (!saweval)
183 return 0;
184 cv = cx->blk_sub.cv;
185 if (debstash && CvSTASH(cv) == debstash) /* ignore DB'* scope */
186 continue;
187 seq = cxstack[i+1].blk_oldcop->cop_seq;
188 curlist = CvPADLIST(cv);
189 curname = (AV*)*av_fetch(curlist, 0, FALSE);
190 svp = AvARRAY(curname);
191 for (off = AvFILL(curname); off > 0; off--) {
192 if ((sv = svp[off]) &&
193 seq <= SvIV(sv) &&
194 seq > (I32)SvNV(sv) &&
195 strEQ(SvPV(sv), name))
196 {
197 PADOFFSET newoff = pad_alloc(OP_PADSV, 'M');
198 AV *oldpad = (AV*)*av_fetch(curlist, CvDEPTH(cv), FALSE);
199 SV *oldsv = *av_fetch(oldpad, off, TRUE);
200 SV *sv = NEWSV(0,0);
201 sv_upgrade(sv, SVt_PVNV);
202 sv_setpv(sv, name);
203 av_store(comppadname, newoff, sv);
204 SvNV(sv) = (double)curcop->cop_seq;
205 SvIV(sv) = 99999999;
206 av_store(comppad, newoff, sv_ref(oldsv));
207 return newoff;
208 }
209 }
210 return 0;
211 }
212 }
213
214 return 0;
215}
216
217void
218pad_leavemy(fill)
219I32 fill;
220{
221 I32 off;
222 SV **svp = AvARRAY(comppadname);
223 SV *sv;
224 for (off = AvFILL(comppadname); off > fill; off--) {
225 if (sv = svp[off])
226 SvIV(sv) = cop_seq;
227 }
228}
229
230PADOFFSET
79072805
LW		 231pad_alloc(optype,tmptype)
232I32 optype;
233char tmptype;
234{
235 SV *sv;
236 I32 retval;
237
238 if (AvARRAY(comppad) != curpad)
239 fatal("panic: pad_alloc");
240 if (tmptype == 'M') {
241 do {
242 sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE);
243 } while (SvSTORAGE(sv)); /* need a fresh one */
244 retval = AvFILL(comppad);
245 }
246 else {
247 do {
248 sv = *av_fetch(comppad, ++padix, TRUE);
249 } while (SvSTORAGE(sv) == 'T' || SvSTORAGE(sv) == 'M');
250 retval = padix;
251 }
252 SvSTORAGE(sv) = tmptype;
253 curpad = AvARRAY(comppad);
254 DEBUG_X(fprintf(stderr, "Pad alloc %d for %s\n", retval, op_name[optype]));
255 return (PADOFFSET)retval;
256}
257
258SV *
259pad_sv(po)
260PADOFFSET po;
261{
262 if (!po)
263 fatal("panic: pad_sv po");
264 DEBUG_X(fprintf(stderr, "Pad sv %d\n", po));
265 return curpad[po]; /* eventually we'll turn this into a macro */
266}
267
268void
269pad_free(po)
270PADOFFSET po;
271{
272 if (AvARRAY(comppad) != curpad)
273 fatal("panic: pad_free curpad");
274 if (!po)
275 fatal("panic: pad_free po");
276 DEBUG_X(fprintf(stderr, "Pad free %d\n", po));
277 if (curpad[po])
278 SvSTORAGE(curpad[po]) = 'F';
279 if (po < padix)
280 padix = po - 1;
281}
282
283void
284pad_swipe(po)
285PADOFFSET po;
286{
287 if (AvARRAY(comppad) != curpad)
288 fatal("panic: pad_swipe curpad");
289 if (!po)
290 fatal("panic: pad_swipe po");
291 DEBUG_X(fprintf(stderr, "Pad swipe %d\n", po));
292 curpad[po] = NEWSV(0,0);
293 SvSTORAGE(curpad[po]) = 'F';
294 if (po < padix)
295 padix = po - 1;
296}
297
298void
299pad_reset()
300{
301 register I32 po;
302
303 if (AvARRAY(comppad) != curpad)
304 fatal("panic: pad_reset curpad");
305 DEBUG_X(fprintf(stderr, "Pad reset\n"));
306 for (po = AvMAX(comppad); po > 0; po--) {
307 if (curpad[po] && SvSTORAGE(curpad[po]) == 'T')
308 SvSTORAGE(curpad[po]) = 'F';
309 }
310 padix = 0;
311}
312
313/* Destructor */
314
315void
316op_free(op)
317OP *op;
318{
319 register OP *kid;
320
321 if (!op)
322 return;
323
324 if (op->op_flags & OPf_KIDS) {
325 for (kid = cUNOP->op_first; kid; kid = kid->op_sibling)
326 op_free(kid);
327 }
328
329 if (op->op_targ > 0)
330 pad_free(op->op_targ);
331
332 switch (op->op_type) {
333 case OP_GV:
334/*XXX sv_free(cGVOP->op_gv); */
335 break;
336 case OP_CONST:
337 sv_free(cSVOP->op_sv);
338 break;
339 }
340
341 Safefree(op);
342}
343
344/* Contextualizers */
345
346#define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist(o))
347
348OP *
349linklist(op)
350OP *op;
351{
352 register OP *kid;
353
354 if (op->op_next)
355 return op->op_next;
356
357 /* establish postfix order */
358 if (cUNOP->op_first) {
359 op->op_next = LINKLIST(cUNOP->op_first);
360 for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
361 if (kid->op_sibling)
362 kid->op_next = LINKLIST(kid->op_sibling);
363 else
364 kid->op_next = op;
365 }
366 }
367 else
368 op->op_next = op;
369
370 return op->op_next;
371}
372
373OP *
374scalarkids(op)
375OP *op;
376{
377 OP *kid;
378 if (op && op->op_flags & OPf_KIDS) {
379 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
380 scalar(kid);
381 }
382 return op;
383}
384
385OP *
386scalar(op)
387OP *op;
388{
389 OP *kid;
390
391 if (!op || (op->op_flags & OPf_KNOW)) /* assumes no premature commitment */
392 return op;
393
394 op->op_flags &= ~OPf_LIST;
395 op->op_flags |= OPf_KNOW;
396
397 switch (op->op_type) {
398 case OP_REPEAT:
399 scalar(cBINOP->op_first);
400 return op;
401 case OP_OR:
402 case OP_AND:
403 case OP_COND_EXPR:
404 break;
405 default:
406 case OP_MATCH:
407 case OP_SUBST:
408 case OP_NULL:
409 if (!(op->op_flags & OPf_KIDS))
410 return op;
411 break;
412 case OP_LEAVE:
413 case OP_LEAVETRY:
414 case OP_LINESEQ:
415 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
416 if (kid->op_sibling)
417 scalarvoid(kid);
418 else
419 scalar(kid);
420 }
93a17b20 421 curcop = &compiling;
79072805
LW		 422 return op;
423 case OP_LIST:
424 op = prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), op);
425 break;
426 }
427 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
428 scalar(kid);
429 return op;
430}
431
432OP *
433scalarvoid(op)
434OP *op;
435{
436 OP *kid;
437
438 if (!op)
439 return op;
440 if (op->op_flags & OPf_LIST)
441 return op;
442
443 op->op_flags |= OPf_KNOW;
444
445 switch (op->op_type) {
446 default:
93a17b20
LW		 447 if (dowarn && (opargs[op->op_type] & OA_FOLDCONST))
448 warn("Useless use of %s", op_name[op->op_type]);
79072805
LW		 449 return op;
450
93a17b20
LW		 451 case OP_NEXTSTATE:
452 curcop = ((COP*)op); /* for warning above */
453 break;
454
79072805
LW		 455 case OP_CONST:
456 op->op_type = OP_NULL; /* don't execute a constant */
457 sv_free(cSVOP->op_sv); /* don't even remember it */
458 break;
459
460 case OP_POSTINC:
461 op->op_type = OP_PREINC;
462 op->op_ppaddr = ppaddr[OP_PREINC];
463 break;
464
465 case OP_POSTDEC:
466 op->op_type = OP_PREDEC;
467 op->op_ppaddr = ppaddr[OP_PREDEC];
468 break;
469
470 case OP_REPEAT:
471 scalarvoid(cBINOP->op_first);
472 break;
473 case OP_OR:
474 case OP_AND:
475 case OP_COND_EXPR:
476 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
477 scalarvoid(kid);
478 break;
479 case OP_ENTERTRY:
480 case OP_ENTER:
481 case OP_SCALAR:
482 case OP_NULL:
483 if (!(op->op_flags & OPf_KIDS))
484 break;
485 case OP_LEAVE:
486 case OP_LEAVETRY:
487 case OP_LINESEQ:
488 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
489 scalarvoid(kid);
490 break;
491 case OP_LIST:
492 op = prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), op);
493 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
494 scalarvoid(kid);
495 break;
496 }
497 return op;
498}
499
500OP *
501listkids(op)
502OP *op;
503{
504 OP *kid;
505 if (op && op->op_flags & OPf_KIDS) {
506 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
507 list(kid);
508 }
509 return op;
510}
511
512OP *
513list(op)
514OP *op;
515{
516 OP *kid;
517
518 if (!op || (op->op_flags & OPf_KNOW)) /* assumes no premature commitment */
519 return op;
520
521 op->op_flags |= (OPf_KNOW | OPf_LIST);
522
523 switch (op->op_type) {
524 case OP_FLOP:
525 case OP_REPEAT:
526 list(cBINOP->op_first);
527 break;
528 case OP_OR:
529 case OP_AND:
530 case OP_COND_EXPR:
531 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
532 list(kid);
533 break;
534 default:
535 case OP_MATCH:
536 case OP_SUBST:
537 case OP_NULL:
538 if (!(op->op_flags & OPf_KIDS))
539 break;
540 if (!op->op_next && cUNOP->op_first->op_type == OP_FLOP) {
541 list(cBINOP->op_first);
542 return gen_constant_list(op);
543 }
544 case OP_LIST:
545 listkids(op);
546 break;
547 case OP_LEAVE:
548 case OP_LEAVETRY:
549 case OP_LINESEQ:
550 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
551 if (kid->op_sibling)
552 scalarvoid(kid);
553 else
554 list(kid);
555 }
93a17b20 556 curcop = &compiling;
79072805
LW		 557 break;
558 }
559 return op;
560}
561
562OP *
563scalarseq(op)
564OP *op;
565{
566 OP *kid;
567
568 if (op &&
569 (op->op_type == OP_LINESEQ ||
570 op->op_type == OP_LEAVE ||
571 op->op_type == OP_LEAVETRY) )
572 {
573 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
574 if (kid->op_sibling)
575 scalarvoid(kid);
576 }
93a17b20 577 curcop = &compiling;
79072805
LW		 578 }
579 return op;
580}
581
582OP *
583refkids(op, type)
584OP *op;
585I32 type;
586{
587 OP *kid;
588 if (op && op->op_flags & OPf_KIDS) {
589 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
590 ref(kid, type);
591 }
592 return op;
593}
594
595static I32 refcount;
596
597OP *
598ref(op, type)
599OP *op;
600I32 type;
601{
602 OP *kid;
603 SV *sv;
604
605 if (!op)
606 return op;
607
608 switch (op->op_type) {
609 case OP_ENTERSUBR:
610 if ((type == OP_DEFINED || type == OP_UNDEF || type == OP_REFGEN) &&
611 !(op->op_flags & OPf_STACKED)) {
93a17b20
LW		 612 op->op_type = OP_RV2CV; /* entersubr => rv2cv */
613 op->op_ppaddr = ppaddr[OP_RV2CV];
614 cUNOP->op_first->op_type = OP_NULL; /* disable pushmark */
615 cUNOP->op_first->op_ppaddr = ppaddr[OP_NULL];
79072805
LW		 616 break;
617 }
618 /* FALL THROUGH */
619 default:
620 if (type == OP_DEFINED)
621 return scalar(op); /* ordinary expression, not lvalue */
622 sprintf(tokenbuf, "Can't %s %s in %s",
623 type == OP_REFGEN ? "refer to" : "modify",
624 op_name[op->op_type],
625 type ? op_name[type] : "local");
626 yyerror(tokenbuf);
627 return op;
628
629 case OP_COND_EXPR:
630 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
631 ref(kid, type);
632 break;
633
634 case OP_RV2AV:
635 case OP_RV2HV:
636 case OP_RV2GV:
93a17b20 637 ref(cUNOP->op_first, op->op_type);
79072805
LW		 638 /* FALL THROUGH */
639 case OP_AASSIGN:
640 case OP_ASLICE:
641 case OP_HSLICE:
93a17b20
LW		 642 case OP_NEXTSTATE:
643 case OP_DBSTATE:
79072805
LW		 644 refcount = 10000;
645 break;
93a17b20
LW		 646 case OP_PADSV:
647 case OP_PADAV:
648 case OP_PADHV:
79072805
LW		 649 case OP_UNDEF:
650 case OP_GV:
651 case OP_RV2SV:
652 case OP_AV2ARYLEN:
653 case OP_SASSIGN:
654 case OP_REFGEN:
655 case OP_ANONLIST:
656 case OP_ANONHASH:
657 refcount++;
658 break;
659
660 case OP_PUSHMARK:
661 break;
662
663 case OP_SUBSTR:
664 case OP_VEC:
665 op->op_targ = pad_alloc(op->op_type,'M');
666 sv = PAD_SV(op->op_targ);
667 sv_upgrade(sv, SVt_PVLV);
668 sv_magic(sv, 0, op->op_type == OP_VEC ? 'v' : 'x', 0, 0);
669 curpad[op->op_targ] = sv;
670 /* FALL THROUGH */
671 case OP_NULL:
672 if (!(op->op_flags & OPf_KIDS))
673 fatal("panic: ref");
674 ref(cBINOP->op_first, type ? type : op->op_type);
675 break;
676 case OP_AELEM:
677 case OP_HELEM:
678 ref(cBINOP->op_first, type ? type : op->op_type);
93a17b20
LW		 679 if (type == OP_RV2AV || type == OP_RV2HV)
680 op->op_private = type;
79072805
LW		 681 break;
682
683 case OP_LEAVE:
684 case OP_ENTER:
685 if (type != OP_RV2HV && type != OP_RV2AV)
686 break;
687 if (!(op->op_flags & OPf_KIDS))
688 break;
689 /* FALL THROUGH */
690 case OP_LIST:
691 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
692 ref(kid, type);
693 break;
694 }
695 op->op_flags |= OPf_LVAL;
696 if (!type) {
697 op->op_flags &= ~OPf_SPECIAL;
93a17b20 698 op->op_flags |= OPf_INTRO;
79072805
LW		 699 }
700 else if (type == OP_AASSIGN || type == OP_SASSIGN)
701 op->op_flags |= OPf_SPECIAL;
702 return op;
703}
704
705OP *
93a17b20
LW		 706my(op)
707OP *op;
708{
709 OP *kid;
710 SV *sv;
711 I32 type;
712
713 if (!op)
714 return op;
715
716 type = op->op_type;
717 if (type == OP_LIST) {
718 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
719 my(kid);
720 }
721 else if (type != OP_PADSV &&
722 type != OP_PADAV &&
723 type != OP_PADHV &&
724 type != OP_PUSHMARK)
725 {
726 sprintf(tokenbuf, "Can't declare %s in my", op_name[op->op_type]);
727 yyerror(tokenbuf);
728 return op;
729 }
730 op->op_flags |= OPf_LVAL|OPf_INTRO;
731 return op;
732}
733
734OP *
79072805
LW		 735sawparens(o)
736OP *o;
737{
738 if (o)
739 o->op_flags |= OPf_PARENS;
740 return o;
741}
742
743OP *
744bind_match(type, left, right)
745I32 type;
746OP *left;
747OP *right;
748{
749 OP *op;
750
751 if (right->op_type == OP_MATCH ||
752 right->op_type == OP_SUBST ||
753 right->op_type == OP_TRANS) {
754 right->op_flags |= OPf_STACKED;
755 if (right->op_type != OP_MATCH)
756 left = ref(left, right->op_type);
757 if (right->op_type == OP_TRANS)
758 op = newBINOP(OP_NULL, 0, scalar(left), right);
759 else
760 op = prepend_elem(right->op_type, scalar(left), right);
761 if (type == OP_NOT)
762 return newUNOP(OP_NOT, 0, scalar(op));
763 return op;
764 }
765 else
766 return bind_match(type, left,
767 pmruntime(newPMOP(OP_MATCH, 0), right, Nullop));
768}
769
770OP *
771invert(op)
772OP *op;
773{
774 if (!op)
775 return op;
776 /* XXX need to optimize away NOT NOT here? Or do we let optimizer do it? */
777 return newUNOP(OP_NOT, OPf_SPECIAL, scalar(op));
778}
779
780OP *
781scope(o)
782OP *o;
783{
784 if (o) {
785 o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
786 o->op_type = OP_LEAVE;
787 o->op_ppaddr = ppaddr[OP_LEAVE];
788 }
789 return o;
790}
791
792OP *
793block_head(o, startp)
794OP *o;
795OP **startp;
796{
797 if (!o) {
798 *startp = 0;
799 return o;
800 }
801 o = scalarseq(scope(o));
802 *startp = LINKLIST(o);
803 o->op_next = 0;
804 peep(*startp);
805 return o;
806}
807
808OP *
93a17b20 809localize(o, lex)
79072805 810OP *o;
93a17b20 811I32 lex;
79072805
LW		 812{
813 if (o->op_flags & OPf_PARENS)
814 list(o);
815 else
816 scalar(o);
93a17b20
LW		 817 in_my = FALSE;
818 if (lex)
819 return my(o);
820 else
821 return ref(o, OP_NULL); /* a bit kludgey */
79072805
LW		 822}
823
824OP *
825jmaybe(o)
826OP *o;
827{
828 if (o->op_type == OP_LIST) {
829 o = convert(OP_JOIN, 0,
830 prepend_elem(OP_LIST,
831 newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE))),
832 o));
833 }
834 return o;
835}
836
837OP *
838fold_constants(o)
839register OP *o;
840{
841 register OP *curop;
842 I32 type = o->op_type;
843 SV *sv;
844
845 if (opargs[type] & OA_RETSCALAR)
846 scalar(o);
847 if (opargs[type] & OA_TARGET)
848 o->op_targ = pad_alloc(type,'T');
849
850 if (!(opargs[type] & OA_FOLDCONST))
851 goto nope;
852
853 for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
93a17b20
LW		 854 if (curop->op_type != OP_CONST &&
855 curop->op_type != OP_LIST &&
856 curop->op_type != OP_SCALAR &&
857 curop->op_type != OP_PUSHMARK) {
79072805
LW		 858 goto nope;
859 }
860 }
861
862 curop = LINKLIST(o);
863 o->op_next = 0;
864 op = curop;
865 run();
866 if (o->op_targ && *stack_sp == PAD_SV(o->op_targ))
867 pad_swipe(o->op_targ);
868 op_free(o);
869 if (type == OP_RV2GV)
870 return newGVOP(OP_GV, 0, *(stack_sp--));
871 else
872 return newSVOP(OP_CONST, 0, *(stack_sp--));
873
874 nope:
875 if (!(opargs[type] & OA_OTHERINT))
876 return o;
877 if (!(o->op_flags & OPf_KIDS))
878 return o;
879
880 for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
881 if (curop->op_type == OP_CONST) {
882 if (SvIOK(((SVOP*)curop)->op_sv))
883 continue;
884 return o;
885 }
886 if (opargs[curop->op_type] & OA_RETINTEGER)
887 continue;
888 return o;
889 }
890
891 o->op_ppaddr = ppaddr[++(o->op_type)];
892 return o;
893}
894
895OP *
896gen_constant_list(o)
897register OP *o;
898{
899 register OP *curop;
900 OP *anonop;
901 I32 tmpmark;
902 I32 tmpsp;
903 I32 oldtmps_floor = tmps_floor;
904 AV *av;
905 GV *gv;
906
907 tmpmark = stack_sp - stack_base;
908 anonop = newANONLIST(o);
909 curop = LINKLIST(anonop);
910 anonop->op_next = 0;
911 op = curop;
912 run();
913 tmpsp = stack_sp - stack_base;
914 tmps_floor = oldtmps_floor;
915 stack_sp = stack_base + tmpmark;
916
917 o->op_type = OP_RV2AV;
918 o->op_ppaddr = ppaddr[OP_RV2AV];
919 o->op_sibling = 0;
920 curop = ((UNOP*)o)->op_first;
921 ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, newSVsv(stack_sp[1]));
922 op_free(curop);
923 curop = ((UNOP*)anonop)->op_first;
924 curop = ((UNOP*)curop)->op_first;
925 curop->op_sibling = 0;
926 op_free(anonop);
927 o->op_next = 0;
928 linklist(o);
929 return list(o);
930}
931
932OP *
933convert(type, flags, op)
934I32 type;
935I32 flags;
936OP* op;
937{
938 OP *kid;
939 OP *last;
940
941 if (opargs[type] & OA_MARK)
942 op = prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), op);
943
944 if (!op || op->op_type != OP_LIST)
945 op = newLISTOP(OP_LIST, 0, op, Nullop);
946
947 op->op_type = type;
948 op->op_ppaddr = ppaddr[type];
949 op->op_flags |= flags;
950
951 op = (*check[type])(op);
952 if (op->op_type != type)
953 return op;
954
955 if (cLISTOP->op_children < 7) {
956 /* XXX do we really need to do this if we're done appending?? */
957 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
958 last = kid;
959 cLISTOP->op_last = last; /* in case check substituted last arg */
960 }
961
962 return fold_constants(op);
963}
964
965/* List constructors */
966
967OP *
968append_elem(type, first, last)
969I32 type;
970OP* first;
971OP* last;
972{
973 if (!first)
974 return last;
975 else if (!last)
976 return first;
977 else if (first->op_type == type) {
978 if (first->op_flags & OPf_KIDS)
979 ((LISTOP*)first)->op_last->op_sibling = last;
980 else {
981 first->op_flags |= OPf_KIDS;
982 ((LISTOP*)first)->op_first = last;
983 }
984 ((LISTOP*)first)->op_last = last;
985 ((LISTOP*)first)->op_children++;
986 return first;
987 }
988
989 return newLISTOP(type, 0, first, last);
990}
991
992OP *
993append_list(type, first, last)
994I32 type;
995LISTOP* first;
996LISTOP* last;
997{
998 if (!first)
999 return (OP*)last;
1000 else if (!last)
1001 return (OP*)first;
1002 else if (first->op_type != type)
1003 return prepend_elem(type, (OP*)first, (OP*)last);
1004 else if (last->op_type != type)
1005 return append_elem(type, (OP*)first, (OP*)last);
1006
1007 first->op_last->op_sibling = last->op_first;
1008 first->op_last = last->op_last;
1009 first->op_children += last->op_children;
1010 if (first->op_children)
1011 last->op_flags |= OPf_KIDS;
1012
1013 Safefree(last);
1014 return (OP*)first;
1015}
1016
1017OP *
1018prepend_elem(type, first, last)
1019I32 type;
1020OP* first;
1021OP* last;
1022{
1023 if (!first)
1024 return last;
1025 else if (!last)
1026 return first;
1027 else if (last->op_type == type) {
1028 if (!(last->op_flags & OPf_KIDS)) {
1029 ((LISTOP*)last)->op_last = first;
1030 last->op_flags |= OPf_KIDS;
1031 }
1032 first->op_sibling = ((LISTOP*)last)->op_first;
1033 ((LISTOP*)last)->op_first = first;
1034 ((LISTOP*)last)->op_children++;
1035 return last;
1036 }
1037
1038 return newLISTOP(type, 0, first, last);
1039}
1040
1041/* Constructors */
1042
1043OP *
1044newNULLLIST()
1045{
1046 return Nullop;
1047}
1048
1049OP *
1050newLISTOP(type, flags, first, last)
1051I32 type;
1052I32 flags;
1053OP* first;
1054OP* last;
1055{
1056 LISTOP *listop;
1057
1058 Newz(1101, listop, 1, LISTOP);
1059
1060 listop->op_type = type;
1061 listop->op_ppaddr = ppaddr[type];
1062 listop->op_children = (first != 0) + (last != 0);
1063 listop->op_flags = flags;
1064 if (listop->op_children)
1065 listop->op_flags |= OPf_KIDS;
1066
1067 if (!last && first)
1068 last = first;
1069 else if (!first && last)
1070 first = last;
1071 listop->op_first = first;
1072 listop->op_last = last;
1073 if (first && first != last)
1074 first->op_sibling = last;
1075
1076 return (OP*)listop;
1077}
1078
1079OP *
1080newOP(type, flags)
1081I32 type;
1082I32 flags;
1083{
1084 OP *op;
1085 Newz(1101, op, 1, OP);
1086 op->op_type = type;
1087 op->op_ppaddr = ppaddr[type];
1088 op->op_flags = flags;
1089
1090 op->op_next = op;
1091 /* op->op_private = 0; */
1092 if (opargs[type] & OA_RETSCALAR)
1093 scalar(op);
1094 if (opargs[type] & OA_TARGET)
1095 op->op_targ = pad_alloc(type,'T');
1096 return (*check[type])(op);
1097}
1098
1099OP *
1100newUNOP(type, flags, first)
1101I32 type;
1102I32 flags;
1103OP* first;
1104{
1105 UNOP *unop;
1106
1107 if (opargs[type] & OA_MARK) {
1108 if (first->op_type == OP_LIST)
1109 prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), first);
1110 else
1111 return newBINOP(type, flags, newOP(OP_PUSHMARK, 0), first);
1112 }
1113
93a17b20
LW		 1114 if (!first)
1115 first = newOP(OP_STUB, 0);
1116
79072805
LW		 1117 Newz(1101, unop, 1, UNOP);
1118 unop->op_type = type;
1119 unop->op_ppaddr = ppaddr[type];
1120 unop->op_first = first;
1121 unop->op_flags = flags | OPf_KIDS;
1122 unop->op_private = 1;
1123
1124 unop = (UNOP*)(*check[type])((OP*)unop);
1125 if (unop->op_next)
1126 return (OP*)unop;
1127
1128 return fold_constants(unop);
1129}
1130
1131OP *
1132newBINOP(type, flags, first, last)
1133I32 type;
1134I32 flags;
1135OP* first;
1136OP* last;
1137{
1138 BINOP *binop;
1139 Newz(1101, binop, 1, BINOP);
1140
1141 if (!first)
1142 first = newOP(OP_NULL, 0);
1143
1144 binop->op_type = type;
1145 binop->op_ppaddr = ppaddr[type];
1146 binop->op_first = first;
1147 binop->op_flags = flags | OPf_KIDS;
1148 if (!last) {
1149 last = first;
1150 binop->op_private = 1;
1151 }
1152 else {
1153 binop->op_private = 2;
1154 first->op_sibling = last;
1155 }
1156
1157 binop = (BINOP*)(*check[type])((OP*)binop);
1158 if (binop->op_next)
1159 return (OP*)binop;
1160
1161 binop->op_last = last = binop->op_first->op_sibling;
1162
1163 return fold_constants(binop);
1164}
1165
1166OP *
1167pmtrans(op, expr, repl)
1168OP *op;
1169OP *expr;
1170OP *repl;
1171{
1172 PMOP *pm = (PMOP*)op;
1173 SV *tstr = ((SVOP*)expr)->op_sv;
1174 SV *rstr = ((SVOP*)repl)->op_sv;
1175 register char *t = SvPVn(tstr);
1176 register char *r = SvPVn(rstr);
1177 I32 tlen = SvCUR(tstr);
1178 I32 rlen = SvCUR(rstr);
1179 register I32 i;
1180 register I32 j;
1181 I32 squash;
1182 I32 delete;
1183 I32 complement;
1184 register short *tbl;
1185
1186 tbl = (short*)cPVOP->op_pv;
1187 complement = op->op_private & OPpTRANS_COMPLEMENT;
1188 delete = op->op_private & OPpTRANS_DELETE;
1189 squash = op->op_private & OPpTRANS_SQUASH;
1190
1191 if (complement) {
1192 Zero(tbl, 256, short);
1193 for (i = 0; i < tlen; i++)
1194 tbl[t[i] & 0377] = -1;
1195 for (i = 0, j = 0; i < 256; i++) {
1196 if (!tbl[i]) {
1197 if (j >= rlen) {
1198 if (delete)
1199 tbl[i] = -2;
1200 else if (rlen)
1201 tbl[i] = r[j-1] & 0377;
1202 else
1203 tbl[i] = i;
1204 }
1205 else
1206 tbl[i] = r[j++] & 0377;
1207 }
1208 }
1209 }
1210 else {
1211 if (!rlen && !delete) {
1212 r = t; rlen = tlen;
1213 }
1214 for (i = 0; i < 256; i++)
1215 tbl[i] = -1;
1216 for (i = 0, j = 0; i < tlen; i++,j++) {
1217 if (j >= rlen) {
1218 if (delete) {
1219 if (tbl[t[i] & 0377] == -1)
1220 tbl[t[i] & 0377] = -2;
1221 continue;
1222 }
1223 --j;
1224 }
1225 if (tbl[t[i] & 0377] == -1)
1226 tbl[t[i] & 0377] = r[j] & 0377;
1227 }
1228 }
1229 op_free(expr);
1230 op_free(repl);
1231
1232 return op;
1233}
1234
1235OP *
1236newPMOP(type, flags)
1237I32 type;
1238I32 flags;
1239{
1240 PMOP *pmop;
1241
1242 Newz(1101, pmop, 1, PMOP);
1243 pmop->op_type = type;
1244 pmop->op_ppaddr = ppaddr[type];
1245 pmop->op_flags = flags;
1246 pmop->op_private = 0;
1247
1248 /* link into pm list */
1249 if (type != OP_TRANS) {
1250 pmop->op_pmnext = HvPMROOT(curstash);
1251 HvPMROOT(curstash) = pmop;
1252 }
1253
1254 return (OP*)pmop;
1255}
1256
1257OP *
1258pmruntime(op, expr, repl)
1259OP *op;
1260OP *expr;
1261OP *repl;
1262{
1263 PMOP *pm;
1264 LOGOP *rcop;
1265
1266 if (op->op_type == OP_TRANS)
1267 return pmtrans(op, expr, repl);
1268
1269 pm = (PMOP*)op;
1270
1271 if (expr->op_type == OP_CONST) {
1272 SV *pat = ((SVOP*)expr)->op_sv;
1273 char *p = SvPVn(pat);
1274 if ((op->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
93a17b20 1275 sv_setpvn(pat, "\\s+", 3);
79072805
LW		 1276 p = SvPVn(pat);
1277 pm->op_pmflags |= PMf_SKIPWHITE;
1278 }
1279 scan_prefix(pm, p, SvCUR(pat));
1280 if (pm->op_pmshort && (pm->op_pmflags & PMf_SCANFIRST))
1281 fbm_compile(pm->op_pmshort, pm->op_pmflags & PMf_FOLD);
1282 pm->op_pmregexp = regcomp(p, p + SvCUR(pat), pm->op_pmflags & PMf_FOLD);
1283 hoistmust(pm);
1284 op_free(expr);
1285 }
1286 else {
1287 Newz(1101, rcop, 1, LOGOP);
1288 rcop->op_type = OP_REGCOMP;
1289 rcop->op_ppaddr = ppaddr[OP_REGCOMP];
1290 rcop->op_first = scalar(expr);
1291 rcop->op_flags |= OPf_KIDS;
1292 rcop->op_private = 1;
1293 rcop->op_other = op;
1294
1295 /* establish postfix order */
1296 rcop->op_next = LINKLIST(expr);
1297 expr->op_next = (OP*)rcop;
1298
1299 prepend_elem(op->op_type, scalar(rcop), op);
1300 }
1301
1302 if (repl) {
1303 if (repl->op_type == OP_CONST) {
1304 pm->op_pmflags |= PMf_CONST;
1305 prepend_elem(op->op_type, scalar(repl), op);
1306 }
1307 else {
1308 OP *curop;
1309 OP *lastop = 0;
1310 for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
1311 if (opargs[curop->op_type] & OA_DANGEROUS) {
1312 if (curop->op_type == OP_GV) {
1313 GV *gv = ((GVOP*)curop)->op_gv;
93a17b20 1314 if (strchr("&`'123456789+", *GvENAME(gv)))
79072805
LW		 1315 break;
1316 }
1317 else if (curop->op_type == OP_RV2CV)
1318 break;
1319 else if (curop->op_type == OP_RV2SV ||
1320 curop->op_type == OP_RV2AV ||
1321 curop->op_type == OP_RV2HV ||
1322 curop->op_type == OP_RV2GV) {
1323 if (lastop && lastop->op_type != OP_GV) /*funny deref?*/
1324 break;
1325 }
1326 else
1327 break;
1328 }
1329 lastop = curop;
1330 }
1331 if (curop == repl) {
1332 pm->op_pmflags |= PMf_CONST; /* const for long enough */
1333 prepend_elem(op->op_type, scalar(repl), op);
1334 }
1335 else {
1336 Newz(1101, rcop, 1, LOGOP);
1337 rcop->op_type = OP_SUBSTCONT;
1338 rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
1339 rcop->op_first = scalar(repl);
1340 rcop->op_flags |= OPf_KIDS;
1341 rcop->op_private = 1;
1342 rcop->op_other = op;
1343
1344 /* establish postfix order */
1345 rcop->op_next = LINKLIST(repl);
1346 repl->op_next = (OP*)rcop;
1347
1348 pm->op_pmreplroot = scalar(rcop);
1349 pm->op_pmreplstart = LINKLIST(rcop);
1350 rcop->op_next = 0;
1351 }
1352 }
1353 }
1354
1355 return (OP*)pm;
1356}
1357
1358OP *
1359newSVOP(type, flags, sv)
1360I32 type;
1361I32 flags;
1362SV *sv;
1363{
1364 SVOP *svop;
1365 Newz(1101, svop, 1, SVOP);
1366 svop->op_type = type;
1367 svop->op_ppaddr = ppaddr[type];
1368 svop->op_sv = sv;
1369 svop->op_next = (OP*)svop;
1370 svop->op_flags = flags;
1371 if (opargs[type] & OA_RETSCALAR)
1372 scalar(svop);
1373 if (opargs[type] & OA_TARGET)
1374 svop->op_targ = pad_alloc(type,'T');
1375 return (*check[type])((OP*)svop);
1376}
1377
1378OP *
1379newGVOP(type, flags, gv)
1380I32 type;
1381I32 flags;
1382GV *gv;
1383{
1384 GVOP *gvop;
1385 Newz(1101, gvop, 1, GVOP);
1386 gvop->op_type = type;
1387 gvop->op_ppaddr = ppaddr[type];
1388 gvop->op_gv = (GV*)sv_ref(gv);
1389 gvop->op_next = (OP*)gvop;
1390 gvop->op_flags = flags;
1391 if (opargs[type] & OA_RETSCALAR)
1392 scalar(gvop);
1393 if (opargs[type] & OA_TARGET)
1394 gvop->op_targ = pad_alloc(type,'T');
1395 return (*check[type])((OP*)gvop);
1396}
1397
1398OP *
1399newPVOP(type, flags, pv)
1400I32 type;
1401I32 flags;
1402char *pv;
1403{
1404 PVOP *pvop;
1405 Newz(1101, pvop, 1, PVOP);
1406 pvop->op_type = type;
1407 pvop->op_ppaddr = ppaddr[type];
1408 pvop->op_pv = pv;
1409 pvop->op_next = (OP*)pvop;
1410 pvop->op_flags = flags;
1411 if (opargs[type] & OA_RETSCALAR)
1412 scalar(pvop);
1413 if (opargs[type] & OA_TARGET)
1414 pvop->op_targ = pad_alloc(type,'T');
1415 return (*check[type])((OP*)pvop);
1416}
1417
1418OP *
1419newCVOP(type, flags, cv, cont)
1420I32 type;
1421I32 flags;
1422CV *cv;
1423OP *cont;
1424{
1425 CVOP *cvop;
1426 Newz(1101, cvop, 1, CVOP);
1427 cvop->op_type = type;
1428 cvop->op_ppaddr = ppaddr[type];
1429 cvop->op_cv = cv;
1430 cvop->op_cont = cont;
1431 cvop->op_next = (OP*)cvop;
1432 cvop->op_flags = flags;
1433 if (opargs[type] & OA_RETSCALAR)
1434 scalar(cvop);
1435 if (opargs[type] & OA_TARGET)
1436 cvop->op_targ = pad_alloc(type,'T');
1437 return (*check[type])((OP*)cvop);
1438}
1439
1440void
1441package(op)
1442OP *op;
1443{
1444 char tmpbuf[256];
1445 GV *tmpgv;
93a17b20
LW		 1446 SV *sv;
1447 char *name;
79072805
LW		 1448
1449 save_hptr(&curstash);
1450 save_item(curstname);
93a17b20
LW		 1451 if (op) {
1452 sv = cSVOP->op_sv;
1453 name = SvPVn(sv);
1454 sv_setpv(curstname,name);
1455 sprintf(tmpbuf,"'_%s",name);
1456 tmpgv = gv_fetchpv(tmpbuf,TRUE);
1457 if (!GvHV(tmpgv))
1458 GvHV(tmpgv) = newHV(0);
1459 curstash = GvHV(tmpgv);
1460 if (!HvNAME(curstash))
1461 HvNAME(curstash) = savestr(name);
1462 HvCOEFFSIZE(curstash) = 0;
1463 op_free(op);
1464 }
1465 else {
1466 sv_setpv(curstname,"<none>");
1467 curstash = Nullhv;
1468 }
79072805
LW		 1469 copline = NOLINE;
1470 expect = XBLOCK;
1471}
1472
1473OP *
1474newSLICEOP(flags, subscript, listval)
1475I32 flags;
1476OP *subscript;
1477OP *listval;
1478{
1479 return newBINOP(OP_LSLICE, flags,
1480 list(prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), subscript)),
1481 list(prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), listval)) );
1482}
1483
1484static I32
1485list_assignment(op)
1486register OP *op;
1487{
1488 if (!op)
1489 return TRUE;
1490
1491 if (op->op_type == OP_NULL && op->op_flags & OPf_KIDS)
1492 op = cUNOP->op_first;
1493
1494 if (op->op_type == OP_COND_EXPR) {
1495 I32 t = list_assignment(cCONDOP->op_first->op_sibling);
1496 I32 f = list_assignment(cCONDOP->op_first->op_sibling->op_sibling);
1497
1498 if (t && f)
1499 return TRUE;
1500 if (t || f)
1501 yyerror("Assignment to both a list and a scalar");
1502 return FALSE;
1503 }
1504
1505 if (op->op_type == OP_LIST || op->op_flags & OPf_PARENS ||
1506 op->op_type == OP_RV2AV || op->op_type == OP_RV2HV ||
1507 op->op_type == OP_ASLICE || op->op_type == OP_HSLICE)
1508 return TRUE;
1509
93a17b20
LW		 1510 if (op->op_type == OP_PADAV || op->op_type == OP_PADHV)
1511 return TRUE;
1512
79072805
LW		 1513 if (op->op_type == OP_RV2SV)
1514 return FALSE;
1515
1516 return FALSE;
1517}
1518
1519OP *
1520newASSIGNOP(flags, left, right)
1521I32 flags;
1522OP *left;
1523OP *right;
1524{
1525 OP *op;
1526
1527 if (list_assignment(left)) {
1528 refcount = 0;
1529 left = ref(left, OP_AASSIGN);
1530 if (right && right->op_type == OP_SPLIT) {
1531 if ((op = ((LISTOP*)right)->op_first) && op->op_type == OP_PUSHRE) {
1532 PMOP *pm = (PMOP*)op;
1533 if (left->op_type == OP_RV2AV) {
1534 op = ((UNOP*)left)->op_first;
1535 if (op->op_type == OP_GV && !pm->op_pmreplroot) {
1536 pm->op_pmreplroot = (OP*)((GVOP*)op)->op_gv;
1537 pm->op_pmflags |= PMf_ONCE;
1538 op_free(left);
1539 return right;
1540 }
1541 }
1542 else {
1543 if (refcount < 10000) {
1544 SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
1545 if (SvIV(sv) == 0)
1546 sv_setiv(sv, refcount+1);
1547 }
1548 }
1549 }
1550 }
1551 op = newBINOP(OP_AASSIGN, flags,
1552 list(prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), right)),
1553 list(prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), left)) );
1554 op->op_private = 0;
93a17b20 1555 if (!(left->op_flags & OPf_INTRO)) {
79072805
LW		 1556 static int generation = 0;
1557 OP *curop;
1558 OP *lastop = op;
1559 generation++;
1560 for (curop = LINKLIST(op); curop != op; curop = LINKLIST(curop)) {
1561 if (opargs[curop->op_type] & OA_DANGEROUS) {
1562 if (curop->op_type == OP_GV) {
1563 GV *gv = ((GVOP*)curop)->op_gv;
1564 if (gv == defgv || SvCUR(gv) == generation)
1565 break;
1566 SvCUR(gv) = generation;
1567 }
1568 else if (curop->op_type == OP_RV2CV)
1569 break;
1570 else if (curop->op_type == OP_RV2SV ||
1571 curop->op_type == OP_RV2AV ||
1572 curop->op_type == OP_RV2HV ||
1573 curop->op_type == OP_RV2GV) {
1574 if (lastop->op_type != OP_GV) /* funny deref? */
1575 break;
1576 }
1577 else
1578 break;
1579 }
1580 lastop = curop;
1581 }
1582 if (curop != op)
1583 op->op_private = OPpASSIGN_COMMON;
1584 }
1585 op->op_targ = pad_alloc(OP_AASSIGN, 'T'); /* for scalar context */
1586 return op;
1587 }
1588 if (!right)
1589 right = newOP(OP_UNDEF, 0);
1590 if (right->op_type == OP_READLINE) {
1591 right->op_flags |= OPf_STACKED;
1592 return newBINOP(OP_NULL, flags, ref(scalar(left), OP_SASSIGN), scalar(right));
1593 }
1594 else
1595 op = newBINOP(OP_SASSIGN, flags,
1596 scalar(right), ref(scalar(left), OP_SASSIGN) );
1597 return op;
1598}
1599
1600OP *
1601newSTATEOP(flags, label, op)
1602I32 flags;
1603char *label;
1604OP *op;
1605{
1606 register COP *cop;
1607
93a17b20
LW		 1608 comppadnamefill = AvFILL(comppadname); /* introduce my variables */
1609
79072805 1610 Newz(1101, cop, 1, COP);
93a17b20
LW		 1611 cop->op_type = OP_NEXTSTATE;
1612 cop->op_ppaddr = ppaddr[ perldb ? OP_DBSTATE : OP_NEXTSTATE ];
79072805
LW		 1613 cop->op_flags = flags;
1614 cop->op_private = 0;
1615 cop->op_next = (OP*)cop;
1616
1617 cop->cop_label = label;
93a17b20 1618 cop->cop_seq = cop_seq++;
79072805
LW		 1619
1620 if (copline == NOLINE)
1621 cop->cop_line = curcop->cop_line;
1622 else {
1623 cop->cop_line = copline;
1624 copline = NOLINE;
1625 }
1626 cop->cop_filegv = curcop->cop_filegv;
1627 cop->cop_stash = curstash;
1628
93a17b20
LW		 1629 if (perldb) {
1630 SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE);
1631 if (svp && *svp != &sv_undef && !SvIOK(*svp)) {
1632 SvIV(*svp) = 1;
1633 SvIOK_on(*svp);
1634 SvSTASH(*svp) = (HV*)cop;
1635 }
1636 }
1637
79072805
LW		 1638 return prepend_elem(OP_LINESEQ, (OP*)cop, op);
1639}
1640
1641OP *
1642newLOGOP(type, flags, first, other)
1643I32 type;
1644I32 flags;
1645OP* first;
1646OP* other;
1647{
1648 LOGOP *logop;
1649 OP *op;
1650
1651 scalar(first);
1652 /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
1653 if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) {
1654 if (type == OP_AND || type == OP_OR) {
1655 if (type == OP_AND)
1656 type = OP_OR;
1657 else
1658 type = OP_AND;
1659 op = first;
1660 first = cUNOP->op_first;
1661 if (op->op_next)
1662 first->op_next = op->op_next;
1663 cUNOP->op_first = Nullop;
1664 op_free(op);
1665 }
1666 }
1667 if (first->op_type == OP_CONST) {
93a17b20
LW		 1668 if (dowarn && (first->op_private & OPpCONST_BARE))
1669 warn("Probable precedence problem on %s", op_name[type]);
79072805
LW		 1670 if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
1671 op_free(first);
1672 return other;
1673 }
1674 else {
1675 op_free(other);
1676 return first;
1677 }
1678 }
1679 else if (first->op_type == OP_WANTARRAY) {
1680 if (type == OP_AND)
1681 list(other);
1682 else
1683 scalar(other);
1684 }
1685
1686 if (!other)
1687 return first;
1688
1689 Newz(1101, logop, 1, LOGOP);
1690
1691 logop->op_type = type;
1692 logop->op_ppaddr = ppaddr[type];
1693 logop->op_first = first;
1694 logop->op_flags = flags | OPf_KIDS;
1695 logop->op_other = LINKLIST(other);
1696 logop->op_private = 1;
1697
1698 /* establish postfix order */
1699 logop->op_next = LINKLIST(first);
1700 first->op_next = (OP*)logop;
1701 first->op_sibling = other;
1702
1703 op = newUNOP(OP_NULL, 0, (OP*)logop);
1704 other->op_next = op;
1705
1706 return op;
1707}
1708
1709OP *
1710newCONDOP(flags, first, true, false)
1711I32 flags;
1712OP* first;
1713OP* true;
1714OP* false;
1715{
1716 CONDOP *condop;
1717 OP *op;
1718
1719 if (!false)
1720 return newLOGOP(OP_AND, 0, first, true);
1721
1722 scalar(first);
1723 if (first->op_type == OP_CONST) {
1724 if (SvTRUE(((SVOP*)first)->op_sv)) {
1725 op_free(first);
1726 op_free(false);
1727 return true;
1728 }
1729 else {
1730 op_free(first);
1731 op_free(true);
1732 return false;
1733 }
1734 }
1735 else if (first->op_type == OP_WANTARRAY) {
1736 list(true);
1737 scalar(false);
1738 }
1739 Newz(1101, condop, 1, CONDOP);
1740
1741 condop->op_type = OP_COND_EXPR;
1742 condop->op_ppaddr = ppaddr[OP_COND_EXPR];
1743 condop->op_first = first;
1744 condop->op_flags = flags | OPf_KIDS;
1745 condop->op_true = LINKLIST(true);
1746 condop->op_false = LINKLIST(false);
1747 condop->op_private = 1;
1748
1749 /* establish postfix order */
1750 condop->op_next = LINKLIST(first);
1751 first->op_next = (OP*)condop;
1752
1753 first->op_sibling = true;
1754 true->op_sibling = false;
1755 op = newUNOP(OP_NULL, 0, (OP*)condop);
1756
1757 true->op_next = op;
1758 false->op_next = op;
1759
1760 return op;
1761}
1762
1763OP *
1764newRANGE(flags, left, right)
1765I32 flags;
1766OP *left;
1767OP *right;
1768{
1769 CONDOP *condop;
1770 OP *flip;
1771 OP *flop;
1772 OP *op;
1773
1774 Newz(1101, condop, 1, CONDOP);
1775
1776 condop->op_type = OP_RANGE;
1777 condop->op_ppaddr = ppaddr[OP_RANGE];
1778 condop->op_first = left;
1779 condop->op_flags = OPf_KIDS;
1780 condop->op_true = LINKLIST(left);
1781 condop->op_false = LINKLIST(right);
1782 condop->op_private = 1;
1783
1784 left->op_sibling = right;
1785
1786 condop->op_next = (OP*)condop;
1787 flip = newUNOP(OP_FLIP, flags, (OP*)condop);
1788 flop = newUNOP(OP_FLOP, 0, flip);
1789 op = newUNOP(OP_NULL, 0, flop);
1790 linklist(flop);
1791
1792 left->op_next = flip;
1793 right->op_next = flop;
1794
1795 condop->op_targ = pad_alloc(OP_RANGE, 'M');
1796 sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV);
1797 flip->op_targ = pad_alloc(OP_RANGE, 'M');
1798 sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
1799
1800 flip->op_private = left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
1801 flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
1802
1803 flip->op_next = op;
1804 if (!flip->op_private || !flop->op_private)
1805 linklist(op); /* blow off optimizer unless constant */
1806
1807 return op;
1808}
1809
1810OP *
1811newLOOPOP(flags, debuggable, expr, block)
1812I32 flags;
1813I32 debuggable;
1814OP *expr;
1815OP *block;
1816{
1817 OP* listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
93a17b20
LW		 1818 OP* op;
1819
1820 if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB))
1821 expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), expr);
1822
1823 op = newLOGOP(OP_AND, 0, expr, listop);
79072805
LW		 1824 ((LISTOP*)listop)->op_last->op_next = LINKLIST(op);
1825
1826 if (block->op_flags & OPf_SPECIAL && /* skip conditional on do {} ? */
1827 (block->op_type == OP_ENTERSUBR || block->op_type == OP_NULL))
1828 op->op_next = ((LOGOP*)cUNOP->op_first)->op_other;
1829
1830 op->op_flags |= flags;
1831 return op;
1832}
1833
1834OP *
1835newWHILEOP(flags, debuggable, loop, expr, block, cont)
1836I32 flags;
1837I32 debuggable;
1838LOOP *loop;
1839OP *expr;
1840OP *block;
1841OP *cont;
1842{
1843 OP *redo;
1844 OP *next = 0;
1845 OP *listop;
1846 OP *op;
1847 OP *condop;
1848
1849 if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB))
1850 expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), expr);
1851
1852 if (!block)
1853 block = newOP(OP_NULL, 0);
1854
1855 if (cont)
1856 next = LINKLIST(cont);
1857 if (expr)
1858 cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
1859
1860 listop = append_list(OP_LINESEQ, block, cont);
1861 redo = LINKLIST(listop);
1862
1863 if (expr) {
1864 op = newLOGOP(OP_AND, 0, expr, scalar(listop));
1865 ((LISTOP*)listop)->op_last->op_next = condop =
1866 (op == listop ? redo : LINKLIST(op));
1867 if (!next)
1868 next = condop;
1869 }
1870 else
1871 op = listop;
1872
1873 if (!loop) {
1874 Newz(1101,loop,1,LOOP);
1875 loop->op_type = OP_ENTERLOOP;
1876 loop->op_ppaddr = ppaddr[OP_ENTERLOOP];
1877 loop->op_private = 0;
1878 loop->op_next = (OP*)loop;
1879 }
1880
1881 op = newBINOP(OP_LEAVELOOP, 0, loop, op);
1882
1883 loop->op_redoop = redo;
1884 loop->op_lastop = op;
1885
1886 if (next)
1887 loop->op_nextop = next;
1888 else
1889 loop->op_nextop = op;
1890
1891 op->op_flags |= flags;
1892 return op;
1893}
1894
1895OP *
1896newFOROP(flags,label,forline,sv,expr,block,cont)
1897I32 flags;
1898char *label;
1899line_t forline;
1900OP* sv;
1901OP* expr;
1902OP*block;
1903OP*cont;
1904{
1905 LOOP *loop;
1906
1907 copline = forline;
1908 if (sv) {
1909 if (sv->op_type == OP_RV2SV) {
1910 OP *op = sv;
1911 sv = cUNOP->op_first;
1912 sv->op_next = sv;
1913 cUNOP->op_first = Nullop;
1914 op_free(op);
1915 }
1916 else
1917 fatal("Can't use %s for loop variable", op_name[sv->op_type]);
1918 }
1919 else {
1920 sv = newGVOP(OP_GV, 0, defgv);
1921 }
1922 loop = (LOOP*)list(convert(OP_ENTERITER, 0,
1923 append_elem(OP_LIST,
1924 prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), expr),
1925 scalar(sv))));
1926 return newSTATEOP(0, label, newWHILEOP(flags, 1,
93a17b20 1927 loop, newOP(OP_ITER, 0), block, cont));
79072805
LW		 1928}
1929
1930void
1931cv_free(cv)
1932CV *cv;
1933{
1934 if (!CvUSERSUB(cv) && CvROOT(cv)) {
1935 op_free(CvROOT(cv));
1936 CvROOT(cv) = Nullop;
1937 if (CvDEPTH(cv))
1938 warn("Deleting active subroutine"); /* XXX */
1939 if (CvPADLIST(cv)) {
1940 I32 i = AvFILL(CvPADLIST(cv));
1941 while (i > 0) {
1942 SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
1943 if (svp)
1944 av_free(*svp);
1945 }
1946 av_free(CvPADLIST(cv));
1947 }
1948 }
1949 Safefree(cv);
1950}
1951
1952void
1953newSUB(floor,op,block)
1954I32 floor;
1955OP *op;
1956OP *block;
1957{
1958 register CV *cv;
1959 char *name = SvPVnx(cSVOP->op_sv);
1960 GV *gv = gv_fetchpv(name,TRUE);
1961 AV* av;
1962
1963 if (cv = GvCV(gv)) {
1964 if (CvDEPTH(cv))
1965 CvDELETED(cv) = TRUE; /* probably an autoloader */
1966 else {
93a17b20 1967 if (dowarn && CvROOT(cv)) {
79072805
LW		 1968 line_t oldline = curcop->cop_line;
1969
1970 curcop->cop_line = copline;
1971 warn("Subroutine %s redefined",name);
1972 curcop->cop_line = oldline;
1973 }
1974 cv_free(cv);
1975 }
1976 }
1977 Newz(101,cv,1,CV);
1978 sv_upgrade(cv, SVt_PVCV);
1979 GvCV(gv) = cv;
1980 CvFILEGV(cv) = curcop->cop_filegv;
1981
1982 av = newAV();
1983 AvREAL_off(av);
93a17b20
LW		 1984 if (AvFILL(comppadname) < AvFILL(comppad))
1985 av_store(comppadname, AvFILL(comppad), Nullsv);
1986 av_store(av, 0, (SV*)comppadname);
79072805
LW		 1987 av_store(av, 1, (SV*)comppad);
1988 AvFILL(av) = 1;
1989 CvPADLIST(cv) = av;
93a17b20 1990 comppadname = newAV();
79072805 1991
93a17b20
LW		 1992 if (!block) {
1993 CvROOT(cv) = 0;
1994 op_free(op);
1995 copline = NOLINE;
1996 leave_scope(floor);
1997 return;
1998 }
79072805
LW		 1999 CvROOT(cv) = newUNOP(OP_LEAVESUBR, 0, scalarseq(block));
2000 CvSTART(cv) = LINKLIST(CvROOT(cv));
2001 CvROOT(cv)->op_next = 0;
93a17b20 2002 CvSTASH(cv) = curstash;
79072805
LW		 2003 peep(CvSTART(cv));
2004 CvDELETED(cv) = FALSE;
93a17b20
LW		 2005 if (strEQ(name, "BEGIN")) {
2006 line_t oldline = curcop->cop_line;
2007 GV* oldfile = curcop->cop_filegv;
2008
2009 if (!beginav)
2010 beginav = newAV();
2011 av_push(beginav, sv_ref(gv));
2012 DEBUG_x( dump_sub(gv) );
2013 rs = nrs;
2014 rslen = nrslen;
2015 rschar = nrschar;
2016 rspara = (nrslen == 2);
2017 calllist(beginav);
2018 cv_free(cv);
2019 rs = "\n";
2020 rslen = 1;
2021 rschar = '\n';
2022 rspara = 0;
2023 GvCV(gv) = 0;
2024 curcop = &compiling;
2025 curcop->cop_line = oldline; /* might have compiled something */
2026 curcop->cop_filegv = oldfile; /* recursively, clobbering these */
2027 }
2028 else if (strEQ(name, "END")) {
2029 if (!endav)
2030 endav = newAV();
2031 av_unshift(endav, 1);
2032 av_store(endav, 0, sv_ref(gv));
2033 }
79072805
LW		 2034 if (perldb) {
2035 SV *sv;
2036 SV *tmpstr = sv_mortalcopy(&sv_undef);
2037
2038 sprintf(buf,"%s:%ld",SvPV(GvSV(curcop->cop_filegv)), subline);
2039 sv = newSVpv(buf,0);
2040 sv_catpv(sv,"-");
2041 sprintf(buf,"%ld",(long)curcop->cop_line);
2042 sv_catpv(sv,buf);
2043 gv_efullname(tmpstr,gv);
2044 hv_store(GvHV(DBsub), SvPV(tmpstr), SvCUR(tmpstr), sv, 0);
2045 }
2046 op_free(op);
2047 copline = NOLINE;
2048 leave_scope(floor);
2049}
2050
2051void
2052newUSUB(name, ix, subaddr, filename)
2053char *name;
2054I32 ix;
2055I32 (*subaddr)();
2056char *filename;
2057{
2058 register CV *cv;
2059 GV *gv = gv_fetchpv(name,allgvs);
2060
2061 if (!gv) /* unused function */
2062 return;
2063 if (cv = GvCV(gv)) {
2064 if (dowarn)
2065 warn("Subroutine %s redefined",name);
2066 if (!CvUSERSUB(cv) && CvROOT(cv)) {
2067 op_free(CvROOT(cv));
2068 CvROOT(cv) = Nullop;
2069 }
2070 Safefree(cv);
2071 }
2072 Newz(101,cv,1,CV);
2073 sv_upgrade(cv, SVt_PVCV);
2074 GvCV(gv) = cv;
2075 CvFILEGV(cv) = gv_fetchfile(filename);
2076 CvUSERSUB(cv) = subaddr;
2077 CvUSERINDEX(cv) = ix;
2078 CvDELETED(cv) = FALSE;
93a17b20
LW		 2079 if (strEQ(name, "BEGIN")) {
2080 if (!beginav)
2081 beginav = newAV();
2082 av_push(beginav, sv_ref(gv));
2083 }
2084 else if (strEQ(name, "END")) {
2085 if (!endav)
2086 endav = newAV();
2087 av_unshift(endav, 1);
2088 av_store(endav, 0, sv_ref(gv));
2089 }
79072805
LW		 2090}
2091
2092void
2093newFORM(floor,op,block)
2094I32 floor;
2095OP *op;
2096OP *block;
2097{
2098 register CV *cv;
2099 char *name;
2100 GV *gv;
2101 AV* av;
2102
2103 if (op)
2104 name = SvPVnx(cSVOP->op_sv);
2105 else
2106 name = "STDOUT";
2107 gv = gv_fetchpv(name,TRUE);
2108 if (cv = GvFORM(gv)) {
2109 if (dowarn) {
2110 line_t oldline = curcop->cop_line;
2111
2112 curcop->cop_line = copline;
2113 warn("Format %s redefined",name);
2114 curcop->cop_line = oldline;
2115 }
2116 cv_free(cv);
2117 }
2118 Newz(101,cv,1,CV);
2119 sv_upgrade(cv, SVt_PVFM);
2120 GvFORM(gv) = cv;
2121 CvFILEGV(cv) = curcop->cop_filegv;
2122
2123 CvPADLIST(cv) = av = newAV();
2124 AvREAL_off(av);
2125 av_store(av, 1, (SV*)comppad);
2126 AvFILL(av) = 1;
2127
2128 CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
2129 CvSTART(cv) = LINKLIST(CvROOT(cv));
2130 CvROOT(cv)->op_next = 0;
2131 peep(CvSTART(cv));
2132 CvDELETED(cv) = FALSE;
2133 FmLINES(cv) = 0;
2134 op_free(op);
2135 copline = NOLINE;
2136 leave_scope(floor);
2137}
2138
2139OP *
2140newMETHOD(ref,name)
2141OP *ref;
2142OP *name;
2143{
2144 LOGOP* mop;
2145 Newz(1101, mop, 1, LOGOP);
2146 mop->op_type = OP_METHOD;
2147 mop->op_ppaddr = ppaddr[OP_METHOD];
2148 mop->op_first = scalar(ref);
2149 mop->op_flags |= OPf_KIDS;
2150 mop->op_private = 1;
2151 mop->op_other = LINKLIST(name);
2152 mop->op_targ = pad_alloc(OP_METHOD,'T');
2153 mop->op_next = LINKLIST(ref);
2154 ref->op_next = (OP*)mop;
2155 return (OP*)mop;
2156}
2157
2158OP *
2159newANONLIST(op)
2160OP* op;
2161{
93a17b20
LW		 2162 return newUNOP(OP_REFGEN, 0,
2163 ref(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN));
79072805
LW		 2164}
2165
2166OP *
2167newANONHASH(op)
2168OP* op;
2169{
93a17b20
LW		 2170 return newUNOP(OP_REFGEN, 0,
2171 ref(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN));
79072805
LW		 2172}
2173
2174OP *
2175oopsAV(o)
2176OP *o;
2177{
93a17b20
LW		 2178 if (o->op_type == OP_PADAV)
2179 return o;
79072805
LW		 2180 if (o->op_type == OP_RV2SV) {
2181 o->op_type = OP_RV2AV;
2182 o->op_ppaddr = ppaddr[OP_RV2AV];
2183 ref(o, OP_RV2AV);
2184 }
2185 else
2186 warn("oops: oopsAV");
2187 return o;
2188}
2189
2190OP *
2191oopsHV(o)
2192OP *o;
2193{
93a17b20
LW		 2194 if (o->op_type == OP_PADHV)
2195 return o;
79072805
LW		 2196 if (o->op_type == OP_RV2SV || o->op_type == OP_RV2AV) {
2197 o->op_type = OP_RV2HV;
2198 o->op_ppaddr = ppaddr[OP_RV2HV];
2199 ref(o, OP_RV2HV);
2200 }
2201 else
2202 warn("oops: oopsHV");
2203 return o;
2204}
2205
2206OP *
2207newAVREF(o)
2208OP *o;
2209{
93a17b20
LW		 2210 if (o->op_type == OP_PADAV)
2211 return o;
79072805
LW		 2212 return newUNOP(OP_RV2AV, 0, scalar(o));
2213}
2214
2215OP *
2216newGVREF(o)
2217OP *o;
2218{
2219 return newUNOP(OP_RV2GV, 0, scalar(o));
2220}
2221
2222OP *
2223newHVREF(o)
2224OP *o;
2225{
93a17b20
LW		 2226 if (o->op_type == OP_PADHV)
2227 return o;
79072805
LW		 2228 return newUNOP(OP_RV2HV, 0, scalar(o));
2229}
2230
2231OP *
2232oopsCV(o)
2233OP *o;
2234{
2235 fatal("NOT IMPL LINE %d",__LINE__);
2236 /* STUB */
2237 return o;
2238}
2239
2240OP *
2241newCVREF(o)
2242OP *o;
2243{
2244 return newUNOP(OP_RV2CV, 0, scalar(o));
2245}
2246
2247OP *
2248newSVREF(o)
2249OP *o;
2250{
93a17b20
LW		 2251 if (o->op_type == OP_PADSV)
2252 return o;
79072805
LW		 2253 return newUNOP(OP_RV2SV, 0, scalar(o));
2254}
2255
2256/* Check routines. */
2257
2258OP *
2259ck_aelem(op)
2260OP *op;
2261{
2262 /* XXX need to optimize constant subscript here. */
2263 return op;
2264}
2265
2266OP *
2267ck_concat(op)
2268OP *op;
2269{
2270 if (cUNOP->op_first->op_type == OP_CONCAT)
2271 op->op_flags |= OPf_STACKED;
2272 return op;
2273}
2274
2275OP *
2276ck_chop(op)
2277OP *op;
2278{
2279 if (op->op_flags & OPf_KIDS) {
2280 OP* newop;
2281 op = refkids(ck_fun(op), op->op_type);
2282 if (op->op_private != 1)
2283 return op;
2284 newop = cUNOP->op_first->op_sibling;
2285 if (!newop || newop->op_type != OP_RV2SV)
2286 return op;
2287 op_free(cUNOP->op_first);
2288 cUNOP->op_first = newop;
2289 }
2290 op->op_type = OP_SCHOP;
2291 op->op_ppaddr = ppaddr[OP_SCHOP];
2292 return op;
2293}
2294
2295OP *
2296ck_eof(op)
2297OP *op;
2298{
2299 I32 type = op->op_type;
2300
2301 if (op->op_flags & OPf_KIDS)
2302 return ck_fun(op);
2303
2304 if (op->op_flags & OPf_SPECIAL) {
2305 op_free(op);
2306 op = newUNOP(type, 0, newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE)));
2307 }
2308 return op;
2309}
2310
2311OP *
2312ck_eval(op)
2313OP *op;
2314{
2315 if (op->op_flags & OPf_KIDS) {
2316 SVOP *kid = (SVOP*)cUNOP->op_first;
2317
93a17b20
LW		 2318 if (!kid) {
2319 op->op_flags &= ~OPf_KIDS;
2320 op->op_type = OP_NULL;
2321 op->op_ppaddr = ppaddr[OP_NULL];
79072805
LW		 2322 }
2323 else if (kid->op_type == OP_LINESEQ) {
2324 LOGOP *enter;
2325
2326 kid->op_next = op->op_next;
2327 cUNOP->op_first = 0;
2328 op_free(op);
2329
2330 Newz(1101, enter, 1, LOGOP);
2331 enter->op_type = OP_ENTERTRY;
2332 enter->op_ppaddr = ppaddr[OP_ENTERTRY];
2333 enter->op_private = 0;
2334
2335 /* establish postfix order */
2336 enter->op_next = (OP*)enter;
2337
2338 op = prepend_elem(OP_LINESEQ, enter, kid);
2339 op->op_type = OP_LEAVETRY;
2340 op->op_ppaddr = ppaddr[OP_LEAVETRY];
2341 enter->op_other = op;
2342 return op;
2343 }
2344 }
2345 else {
2346 op_free(op);
2347 op = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
2348 }
2349 return op;
2350}
2351
2352OP *
2353ck_exec(op)
2354OP *op;
2355{
2356 OP *kid;
2357 op = ck_fun(op);
2358 if (op->op_flags & OPf_STACKED) {
2359 kid = cUNOP->op_first->op_sibling;
2360 if (kid->op_type == OP_RV2GV) {
2361 kid->op_type = OP_NULL;
2362 kid->op_ppaddr = ppaddr[OP_NULL];
2363 }
2364 }
2365 return op;
2366}
2367
2368OP *
2369ck_gvconst(o)
2370register OP *o;
2371{
2372 o = fold_constants(o);
2373 if (o->op_type == OP_CONST)
2374 o->op_type = OP_GV;
2375 return o;
2376}
2377
2378OP *
2379ck_rvconst(op)
2380register OP *op;
2381{
2382 SVOP *kid = (SVOP*)cUNOP->op_first;
2383 if (kid->op_type == OP_CONST) {
2384 kid->op_type = OP_GV;
2385 kid->op_sv = (SV*)gv_fetchpv(SvPVnx(kid->op_sv),
2386 1+(op->op_type==OP_RV2CV));
2387 }
2388 return op;
2389}
2390
2391OP *
2392ck_formline(op)
2393OP *op;
2394{
2395 return ck_fun(op);
2396}
2397
2398OP *
2399ck_ftst(op)
2400OP *op;
2401{
2402 I32 type = op->op_type;
2403
2404 if (op->op_flags & OPf_SPECIAL)
2405 return op;
2406
2407 if (op->op_flags & OPf_KIDS) {
2408 SVOP *kid = (SVOP*)cUNOP->op_first;
2409
2410 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
2411 OP *newop = newGVOP(type, OPf_SPECIAL,
2412 gv_fetchpv(SvPVnx(kid->op_sv), TRUE));
2413 op_free(op);
2414 return newop;
2415 }
2416 }
2417 else {
2418 op_free(op);
2419 if (type == OP_FTTTY)
2420 return newGVOP(type, OPf_SPECIAL, gv_fetchpv("main'STDIN", TRUE));
2421 else
2422 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
2423 }
2424 return op;
2425}
2426
2427OP *
2428ck_fun(op)
2429OP *op;
2430{
2431 register OP *kid;
2432 OP **tokid;
2433 OP *sibl;
2434 I32 numargs = 0;
2435 register I32 oa = opargs[op->op_type] >> 8;
2436
2437 if (op->op_flags & OPf_STACKED) {
2438 if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
2439 oa &= ~OA_OPTIONAL;
2440 else
2441 return no_fh_allowed(op);
2442 }
2443
2444 if (op->op_flags & OPf_KIDS) {
2445 tokid = &cLISTOP->op_first;
2446 kid = cLISTOP->op_first;
2447 if (kid->op_type == OP_PUSHMARK) {
2448 tokid = &kid->op_sibling;
2449 kid = kid->op_sibling;
2450 }
2451
2452 while (oa && kid) {
2453 numargs++;
2454 sibl = kid->op_sibling;
2455 switch (oa & 7) {
2456 case OA_SCALAR:
2457 scalar(kid);
2458 break;
2459 case OA_LIST:
2460 if (oa < 16) {
2461 kid = 0;
2462 continue;
2463 }
2464 else
2465 list(kid);
2466 break;
2467 case OA_AVREF:
2468 if (kid->op_type == OP_CONST &&
2469 (kid->op_private & OPpCONST_BARE)) {
2470 OP *newop = newAVREF(newGVOP(OP_GV, 0,
2471 gv_fetchpv(SvPVnx(((SVOP*)kid)->op_sv), TRUE) ));
2472 op_free(kid);
2473 kid = newop;
2474 kid->op_sibling = sibl;
2475 *tokid = kid;
2476 }
2477 ref(kid, op->op_type);
2478 break;
2479 case OA_HVREF:
2480 if (kid->op_type == OP_CONST &&
2481 (kid->op_private & OPpCONST_BARE)) {
2482 OP *newop = newHVREF(newGVOP(OP_GV, 0,
2483 gv_fetchpv(SvPVnx(((SVOP*)kid)->op_sv), TRUE) ));
2484 op_free(kid);
2485 kid = newop;
2486 kid->op_sibling = sibl;
2487 *tokid = kid;
2488 }
2489 ref(kid, op->op_type);
2490 break;
2491 case OA_CVREF:
2492 {
2493 OP *newop = newUNOP(OP_NULL, 0, scalar(kid));
2494 kid->op_sibling = 0;
2495 linklist(kid);
2496 newop->op_next = newop;
2497 kid = newop;
2498 kid->op_sibling = sibl;
2499 *tokid = kid;
2500 }
2501 break;
2502 case OA_FILEREF:
2503 if (kid->op_type != OP_GV) {
2504 if (kid->op_type == OP_CONST &&
2505 (kid->op_private & OPpCONST_BARE)) {
2506 OP *newop = newGVOP(OP_GV, 0,
2507 gv_fetchpv(SvPVnx(((SVOP*)kid)->op_sv), TRUE) );
2508 op_free(kid);
2509 kid = newop;
2510 }
2511 else {
2512 kid->op_sibling = 0;
2513 kid = newUNOP(OP_RV2GV, 0, scalar(kid));
2514 }
2515 kid->op_sibling = sibl;
2516 *tokid = kid;
2517 }
2518 scalar(kid);
2519 break;
2520 case OA_SCALARREF:
2521 ref(scalar(kid), op->op_type);
2522 break;
2523 }
2524 oa >>= 4;
2525 tokid = &kid->op_sibling;
2526 kid = kid->op_sibling;
2527 }
2528 op->op_private = numargs;
2529 if (kid)
2530 return too_many_arguments(op);
2531 listkids(op);
2532 }
2533 if (oa) {
2534 while (oa & OA_OPTIONAL)
2535 oa >>= 4;
2536 if (oa && oa != OA_LIST)
2537 return too_few_arguments(op);
2538 }
2539 return op;
2540}
2541
2542OP *
2543ck_glob(op)
2544OP *op;
2545{
2546 GV *gv = newGVgen();
2547 GvIOn(gv);
2548 append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
2549 scalarkids(op);
2550 return op;
2551}
2552
2553OP *
2554ck_grep(op)
2555OP *op;
2556{
2557 LOGOP *gwop;
2558 OP *kid;
2559
93a17b20
LW		 2560 if (op->op_flags & OPf_STACKED) {
2561 op = ck_sort(op);
2562 op->op_flags &= ~OPf_STACKED;
2563 }
79072805
LW		 2564 op = ck_fun(op);
2565 if (error_count)
2566 return op;
2567 kid = cLISTOP->op_first->op_sibling;
2568 if (kid->op_type != OP_NULL)
2569 fatal("panic: ck_grep");
2570 kid = kUNOP->op_first;
2571
2572 Newz(1101, gwop, 1, LOGOP);
2573 gwop->op_type = OP_GREPWHILE;
2574 gwop->op_ppaddr = ppaddr[OP_GREPWHILE];
2575 gwop->op_first = list(op);
2576 gwop->op_flags |= OPf_KIDS;
2577 gwop->op_private = 1;
2578 gwop->op_other = LINKLIST(kid);
2579 gwop->op_targ = pad_alloc(OP_GREPWHILE,'T');
2580 kid->op_next = (OP*)gwop;
2581
2582 return (OP*)gwop;
2583}
2584
2585OP *
2586ck_index(op)
2587OP *op;
2588{
2589 if (op->op_flags & OPf_KIDS) {
2590 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
2591 if (kid && kid->op_type == OP_CONST)
2592 fbm_compile(((SVOP*)kid)->op_sv, 0);
2593 }
2594 return ck_fun(op);
2595}
2596
2597OP *
2598ck_lengthconst(op)
2599OP *op;
2600{
2601 /* XXX length optimization goes here */
2602 return op;
2603}
2604
2605OP *
2606ck_lfun(op)
2607OP *op;
2608{
2609 return refkids(ck_fun(op), op->op_type);
2610}
2611
2612OP *
2613ck_listiob(op)
2614OP *op;
2615{
2616 register OP *kid;
2617
2618 kid = cLISTOP->op_first;
2619 if (!kid) {
93a17b20 2620 prepend_elem(op->op_type, newOP(OP_PUSHMARK, 0), op);
79072805
LW		 2621 kid = cLISTOP->op_first;
2622 }
2623 if (kid->op_type == OP_PUSHMARK)
2624 kid = kid->op_sibling;
2625 if (kid && op->op_flags & OPf_STACKED)
2626 kid = kid->op_sibling;
2627 else if (kid && !kid->op_sibling) { /* print HANDLE; */
2628 if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
2629 op->op_flags |= OPf_STACKED; /* make it a filehandle */
2630 kid = newUNOP(OP_RV2GV, 0, scalar(kid));
2631 cLISTOP->op_first->op_sibling = kid;
2632 cLISTOP->op_last = kid;
2633 kid = kid->op_sibling;
2634 }
2635 }
2636
2637 if (!kid)
2638 append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
2639
2640 return listkids(op);
2641}
2642
2643OP *
2644ck_match(op)
2645OP *op;
2646{
2647 cPMOP->op_pmflags |= PMf_RUNTIME;
2648 return op;
2649}
2650
2651OP *
2652ck_null(op)
2653OP *op;
2654{
2655 return op;
2656}
2657
2658OP *
2659ck_repeat(op)
2660OP *op;
2661{
2662 if (cBINOP->op_first->op_flags & OPf_PARENS) {
2663 op->op_private = OPpREPEAT_DOLIST;
2664 cBINOP->op_first =
2665 prepend_elem(OP_NULL, newOP(OP_PUSHMARK, 0), cBINOP->op_first);
2666 }
2667 else
2668 scalar(op);
2669 return op;
2670}
2671
2672OP *
2673ck_retarget(op)
2674OP *op;
2675{
2676 fatal("NOT IMPL LINE %d",__LINE__);
2677 /* STUB */
2678 return op;
2679}
2680
2681OP *
2682ck_select(op)
2683OP *op;
2684{
2685 if (op->op_flags & OPf_KIDS) {
2686 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
2687 if (kid) {
2688 op->op_type = OP_SSELECT;
2689 op->op_ppaddr = ppaddr[OP_SSELECT];
2690 op = ck_fun(op);
2691 return fold_constants(op);
2692 }
2693 }
2694 return ck_fun(op);
2695}
2696
2697OP *
2698ck_shift(op)
2699OP *op;
2700{
2701 I32 type = op->op_type;
2702
2703 if (!(op->op_flags & OPf_KIDS)) {
2704 op_free(op);
2705 return newUNOP(type, 0,
2706 scalar(newUNOP(OP_RV2AV, 0,
2707 scalar(newGVOP(OP_GV, 0,
2708 gv_fetchpv((subline ? "_" : "ARGV"), TRUE) )))));
2709 }
2710 return scalar(refkids(ck_fun(op), type));
2711}
2712
2713OP *
2714ck_sort(op)
2715OP *op;
2716{
2717 if (op->op_flags & OPf_STACKED) {
2718 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
2719 kid = kUNOP->op_first; /* get past sv2gv */
2720 if (kid->op_type == OP_LEAVE) {
2721 OP *k;
2722
2723 linklist(kid);
2724 kid->op_type = OP_NULL; /* wipe out leave */
2725 kid->op_ppaddr = ppaddr[OP_NULL];
2726 kid->op_next = kid;
2727
2728 for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
2729 if (k->op_next == kid)
2730 k->op_next = 0;
2731 }
2732 kid->op_type = OP_NULL; /* wipe out enter */
2733 kid->op_ppaddr = ppaddr[OP_NULL];
2734
2735 kid = cLISTOP->op_first->op_sibling;
2736 kid->op_type = OP_NULL; /* wipe out sv2gv */
2737 kid->op_ppaddr = ppaddr[OP_NULL];
2738 kid->op_next = kid;
2739
2740 op->op_flags |= OPf_SPECIAL;
2741 }
2742 }
2743 return op;
2744}
2745
2746OP *
2747ck_split(op)
2748OP *op;
2749{
2750 register OP *kid;
2751
2752 if (op->op_flags & OPf_STACKED)
2753 return no_fh_allowed(op);
2754
2755 if (!(op->op_flags & OPf_KIDS))
2756 op = prepend_elem(OP_SPLIT,
2757 pmruntime(
2758 newPMOP(OP_MATCH, OPf_SPECIAL),
2759 newSVOP(OP_CONST, 0, newSVpv(" ", 1)),
2760 Nullop),
2761 op);
2762
2763 kid = cLISTOP->op_first;
2764 if (kid->op_type == OP_PUSHMARK)
2765 fatal("panic: ck_split");
2766
2767 if (kid->op_type != OP_MATCH) {
2768 OP *sibl = kid->op_sibling;
2769 kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
2770 if (cLISTOP->op_first == cLISTOP->op_last)
2771 cLISTOP->op_last = kid;
2772 cLISTOP->op_first = kid;
2773 kid->op_sibling = sibl;
2774 }
2775
2776 kid->op_type = OP_PUSHRE;
2777 kid->op_ppaddr = ppaddr[OP_PUSHRE];
2778 scalar(kid);
2779
2780 if (!kid->op_sibling)
2781 append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
2782
2783 kid = kid->op_sibling;
2784 scalar(kid);
2785
2786 if (!kid->op_sibling)
2787 append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0)));
2788
2789 kid = kid->op_sibling;
2790 scalar(kid);
2791
2792 if (kid->op_sibling)
2793 return too_many_arguments(op);
2794
2795 return op;
2796}
2797
2798OP *
2799ck_subr(op)
2800OP *op;
2801{
93a17b20
LW		 2802 OP *o = ((cUNOP->op_first->op_sibling)
2803 ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first->op_sibling;
2804
2805 if (o->op_type == OP_RV2CV) {
2806 o->op_type = OP_NULL; /* disable rv2cv */
2807 o->op_ppaddr = ppaddr[OP_NULL];
2808 }
79072805 2809 op->op_private = 0;
93a17b20
LW		 2810 if (perldb)
2811 op->op_private |= OPpSUBR_DB;
79072805
LW		 2812 return op;
2813}
2814
2815OP *
2816ck_trunc(op)
2817OP *op;
2818{
2819 if (op->op_flags & OPf_KIDS) {
2820 SVOP *kid = (SVOP*)cUNOP->op_first;
2821
2822 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
2823 op->op_flags |= OPf_SPECIAL;
2824 }
2825 return ck_fun(op);
2826}
2827
2828void
2829peep(op)
2830register OP* op;
2831{
2832 register OP* oldop = 0;
2833 if (!op || op->op_seq)
2834 return;
2835 for (; op; op = op->op_next) {
2836 if (op->op_seq)
2837 return;
2838 switch (op->op_type) {
2839 case OP_NULL:
2840 case OP_SCALAR:
93a17b20 2841 case OP_LINESEQ:
79072805
LW		 2842 if (oldop) {
2843 oldop->op_next = op->op_next;
2844 continue;
2845 }
2846 op->op_seq = ++op_seq;
2847 break;
2848
2849 case OP_GV:
2850 if (op->op_next->op_type == OP_RV2SV) {
2851 op->op_next->op_type = OP_NULL;
2852 op->op_next->op_ppaddr = ppaddr[OP_NULL];
93a17b20 2853 op->op_flags |= op->op_next->op_flags & OPf_INTRO;
79072805
LW		 2854 op->op_next = op->op_next->op_next;
2855 op->op_type = OP_GVSV;
2856 op->op_ppaddr = ppaddr[OP_GVSV];
2857 }
2858 op->op_seq = ++op_seq;
2859 break;
2860
2861 case OP_GREPWHILE:
2862 case OP_AND:
2863 case OP_OR:
2864 op->op_seq = ++op_seq;
2865 peep(cLOGOP->op_other);
2866 break;
2867
2868 case OP_COND_EXPR:
2869 op->op_seq = ++op_seq;
2870 peep(cCONDOP->op_true);
2871 peep(cCONDOP->op_false);
2872 break;
2873
2874 case OP_ENTERLOOP:
2875 op->op_seq = ++op_seq;
2876 peep(cLOOP->op_redoop);
2877 peep(cLOOP->op_nextop);
2878 peep(cLOOP->op_lastop);
2879 break;
2880
2881 case OP_MATCH:
2882 case OP_SUBST:
2883 op->op_seq = ++op_seq;
2884 peep(cPMOP->op_pmreplroot);
2885 break;
2886
2887 default:
2888 op->op_seq = ++op_seq;
2889 break;
2890 }
2891 oldop = op;
2892 }
2893}
Unnamed repository; edit this file 'description' to name the repository.