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
perl5.000 patch.0o: [address] a few more Configure and build nits.
[perl5.git] / op.c
CommitLineData
a0d0e21e 1/* op.c
79072805 2 *
a0d0e21e 3 * Copyright (c) 1991-1994, Larry Wall
79072805
LW		 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 *
a0d0e21e
LW		 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
79072805
LW		 16 */
17
18#include "EXTERN.h"
19#include "perl.h"
20
a0d0e21e
LW		 21static I32 list_assignment _((OP *op));
22static OP *bad_type _((I32 n, char *t, OP *op, OP *kid));
23static OP *modkids _((OP *op, I32 type));
24static OP *no_fh_allowed _((OP *op));
25static OP *scalarboolean _((OP *op));
26static OP *too_few_arguments _((OP *op));
27static OP *too_many_arguments _((OP *op));
28static void null _((OP* op));
79072805 29
8990e307 30static OP *
79072805
LW		 31no_fh_allowed(op)
32OP *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
8990e307 40static OP *
79072805
LW		 41too_few_arguments(op)
42OP *op;
43{
44 sprintf(tokenbuf,"Not enough arguments for %s", op_name[op->op_type]);
45 yyerror(tokenbuf);
46 return op;
47}
48
8990e307 49static OP *
79072805
LW		 50too_many_arguments(op)
51OP *op;
52{
53 sprintf(tokenbuf,"Too many arguments for %s", op_name[op->op_type]);
54 yyerror(tokenbuf);
55 return op;
56}
57
8990e307
LW		 58static OP *
59bad_type(n, t, op, kid)
60I32 n;
61char *t;
62OP *op;
63OP *kid;
64{
65 sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)",
a0d0e21e 66 (int) n, op_name[op->op_type], t, op_name[kid->op_type]);
8990e307
LW		 67 yyerror(tokenbuf);
68 return op;
69}
70
a0d0e21e
LW		 71void
72assertref(op)
73OP *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
79072805
LW		 86/* "register" allocation */
87
88PADOFFSET
93a17b20
LW		 89pad_allocmy(name)
90char *name;
91{
a0d0e21e
LW		 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);
93a17b20
LW		 102 sv_upgrade(sv, SVt_PVNV);
103 sv_setpv(sv, name);
8990e307 104 av_store(comppad_name, off, sv);
463ee0b2 105 SvNVX(sv) = (double)cop_seqmax;
8990e307
LW		 106 SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */
107 if (!min_intro_pending)
108 min_intro_pending = off;
109 max_intro_pending = off;
93a17b20 110 if (*name == '@')
463ee0b2 111 av_store(comppad, off, (SV*)newAV());
93a17b20 112 else if (*name == '%')
463ee0b2 113 av_store(comppad, off, (SV*)newHV());
ed6116ce 114 SvPADMY_on(curpad[off]);
93a17b20
LW		 115 return off;
116}
117
118PADOFFSET
119pad_findmy(name)
120char *name;
121{
122 I32 off;
123 SV *sv;
8990e307 124 SV **svp = AvARRAY(comppad_name);
93a17b20
LW		 125 register I32 i;
126 register CONTEXT *cx;
a0d0e21e 127 int saweval;
93a17b20
LW		 128 AV *curlist;
129 AV *curname;
130 CV *cv;
463ee0b2 131 I32 seq = cop_seqmax;
93a17b20 132
8990e307
LW		 133 /* The one we're looking for is probably just before comppad_name_fill. */
134 for (off = comppad_name_fill; off > 0; off--) {
93a17b20 135 if ((sv = svp[off]) &&
a0d0e21e 136 sv != &sv_undef &&
463ee0b2
LW		 137 seq <= SvIVX(sv) &&
138 seq > (I32)SvNVX(sv) &&
139 strEQ(SvPVX(sv), name))
93a17b20
LW		 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
a0d0e21e 150 saweval = 0;
93a17b20
LW		 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:
a0d0e21e 157 saweval = i;
93a17b20
LW		 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;
a0d0e21e 165 seq = cxstack[saweval].blk_oldcop->cop_seq;
93a17b20
LW		 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]) &&
a0d0e21e 171 sv != &sv_undef &&
463ee0b2
LW		 172 seq <= SvIVX(sv) &&
173 seq > (I32)SvNVX(sv) &&
174 strEQ(SvPVX(sv), name))
93a17b20 175 {
ed6116ce 176 PADOFFSET newoff = pad_alloc(OP_PADSV, SVs_PADMY);
93a17b20
LW		 177 AV *oldpad = (AV*)*av_fetch(curlist, CvDEPTH(cv), FALSE);
178 SV *oldsv = *av_fetch(oldpad, off, TRUE);
a0d0e21e 179 SV *sv = NEWSV(1103,0);
93a17b20
LW		 180 sv_upgrade(sv, SVt_PVNV);
181 sv_setpv(sv, name);
8990e307 182 av_store(comppad_name, newoff, sv);
463ee0b2 183 SvNVX(sv) = (double)curcop->cop_seq;
8990e307
LW		 184 SvIVX(sv) = 999999999; /* A ref, intro immediately */
185 av_store(comppad, newoff, SvREFCNT_inc(oldsv));
93a17b20
LW		 186 return newoff;
187 }
188 }
189 return 0;
190 }
191 }
192
a0d0e21e
LW		 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 }
93a17b20
LW		 218 return 0;
219}
220
221void
222pad_leavemy(fill)
223I32 fill;
224{
225 I32 off;
8990e307 226 SV **svp = AvARRAY(comppad_name);
93a17b20 227 SV *sv;
8990e307
LW		 228 if (min_intro_pending && fill < min_intro_pending) {
229 for (off = max_intro_pending; off >= min_intro_pending; off--) {
a0d0e21e 230 if ((sv = svp[off]) && sv != &sv_undef)
8990e307
LW		 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--) {
a0d0e21e 236 if ((sv = svp[off]) && sv != &sv_undef)
463ee0b2 237 SvIVX(sv) = cop_seqmax;
93a17b20
LW		 238 }
239}
240
241PADOFFSET
79072805
LW		 242pad_alloc(optype,tmptype)
243I32 optype;
ed6116ce 244U32 tmptype;
79072805
LW		 245{
246 SV *sv;
247 I32 retval;
248
249 if (AvARRAY(comppad) != curpad)
463ee0b2 250 croak("panic: pad_alloc");
a0d0e21e
LW		 251 if (pad_reset_pending)
252 pad_reset();
ed6116ce 253 if (tmptype & SVs_PADMY) {
79072805
LW		 254 do {
255 sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE);
ed6116ce 256 } while (SvPADBUSY(sv)); /* need a fresh one */
79072805
LW		 257 retval = AvFILL(comppad);
258 }
259 else {
260 do {
261 sv = *av_fetch(comppad, ++padix, TRUE);
8990e307 262 } while (SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY));
79072805
LW		 263 retval = padix;
264 }
8990e307 265 SvFLAGS(sv) |= tmptype;
79072805 266 curpad = AvARRAY(comppad);
a0d0e21e 267 DEBUG_X(fprintf(stderr, "Pad alloc %ld for %s\n", (long) retval, op_name[optype]));
79072805
LW		 268 return (PADOFFSET)retval;
269}
270
271SV *
a0d0e21e 272#ifndef CAN_PROTOTYPE
79072805
LW		 273pad_sv(po)
274PADOFFSET po;
8990e307
LW		 275#else
276pad_sv(PADOFFSET po)
a0d0e21e 277#endif /* CAN_PROTOTYPE */
79072805
LW		 278{
279 if (!po)
463ee0b2 280 croak("panic: pad_sv po");
79072805
LW		 281 DEBUG_X(fprintf(stderr, "Pad sv %d\n", po));
282 return curpad[po]; /* eventually we'll turn this into a macro */
283}
284
285void
a0d0e21e 286#ifndef CAN_PROTOTYPE
79072805
LW		 287pad_free(po)
288PADOFFSET po;
8990e307
LW		 289#else
290pad_free(PADOFFSET po)
a0d0e21e 291#endif /* CAN_PROTOTYPE */
79072805 292{
a0d0e21e
LW		 293 if (!curpad)
294 return;
79072805 295 if (AvARRAY(comppad) != curpad)
463ee0b2 296 croak("panic: pad_free curpad");
79072805 297 if (!po)
463ee0b2 298 croak("panic: pad_free po");
79072805 299 DEBUG_X(fprintf(stderr, "Pad free %d\n", po));
a0d0e21e 300 if (curpad[po] && curpad[po] != &sv_undef)
ed6116ce 301 SvPADTMP_off(curpad[po]);
a0d0e21e 302 if ((I32)po < padix)
79072805
LW		 303 padix = po - 1;
304}
305
306void
a0d0e21e 307#ifndef CAN_PROTOTYPE
79072805
LW		 308pad_swipe(po)
309PADOFFSET po;
8990e307
LW		 310#else
311pad_swipe(PADOFFSET po)
a0d0e21e 312#endif /* CAN_PROTOTYPE */
79072805
LW		 313{
314 if (AvARRAY(comppad) != curpad)
463ee0b2 315 croak("panic: pad_swipe curpad");
79072805 316 if (!po)
463ee0b2 317 croak("panic: pad_swipe po");
79072805 318 DEBUG_X(fprintf(stderr, "Pad swipe %d\n", po));
ed6116ce 319 SvPADTMP_off(curpad[po]);
a0d0e21e
LW		 320 curpad[po] = NEWSV(1107,0);
321 SvPADTMP_on(curpad[po]);
322 if ((I32)po < padix)
79072805
LW		 323 padix = po - 1;
324}
325
326void
327pad_reset()
328{
329 register I32 po;
330
331 if (AvARRAY(comppad) != curpad)
463ee0b2 332 croak("panic: pad_reset curpad");
79072805 333 DEBUG_X(fprintf(stderr, "Pad reset\n"));
a0d0e21e
LW		 334 for (po = AvMAX(comppad); po > padix_floor; po--) {
335 if (curpad[po] && curpad[po] != &sv_undef)
ed6116ce 336 SvPADTMP_off(curpad[po]);
79072805 337 }
a0d0e21e
LW		 338 padix = padix_floor;
339 pad_reset_pending = FALSE;
79072805
LW		 340}
341
342/* Destructor */
343
344void
345op_free(op)
346OP *op;
347{
85e6fe83 348 register OP *kid, *nextkid;
79072805
LW		 349
350 if (!op)
351 return;
352
353 if (op->op_flags & OPf_KIDS) {
85e6fe83
LW		 354 for (kid = cUNOP->op_first; kid; kid = nextkid) {
355 nextkid = kid->op_sibling; /* Get before next freeing kid */
79072805 356 op_free(kid);
85e6fe83 357 }
79072805
LW		 358 }
359
79072805
LW		 360
361 switch (op->op_type) {
8990e307
LW		 362 case OP_NULL:
363 op->op_targ = 0; /* Was holding old type, if any. */
364 break;
a0d0e21e
LW		 365 case OP_ENTEREVAL:
366 op->op_targ = 0; /* Was holding hints. */
367 break;
463ee0b2 368 case OP_GVSV:
79072805 369 case OP_GV:
a0d0e21e 370 SvREFCNT_dec(cGVOP->op_gv);
8990e307
LW		 371 break;
372 case OP_NEXTSTATE:
373 case OP_DBSTATE:
374 SvREFCNT_dec(cCOP->cop_filegv);
79072805
LW		 375 break;
376 case OP_CONST:
8990e307 377 SvREFCNT_dec(cSVOP->op_sv);
79072805 378 break;
a0d0e21e
LW		 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;
79072805
LW		 390 }
391
8990e307
LW		 392 if (op->op_targ > 0)
393 pad_free(op->op_targ);
394
79072805
LW		 395 Safefree(op);
396}
397
8990e307
LW		 398static void
399null(op)
400OP* 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
79072805
LW		 409/* Contextualizers */
410
463ee0b2 411#define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
79072805
LW		 412
413OP *
414linklist(op)
415OP *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
438OP *
439scalarkids(op)
440OP *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
a0d0e21e 450static OP *
8990e307
LW		 451scalarboolean(op)
452OP *op;
453{
454 if (dowarn &&
a0d0e21e
LW		 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 }
8990e307
LW		 463 return scalar(op);
464}
465
466OP *
79072805
LW		 467scalar(op)
468OP *op;
469{
470 OP *kid;
471
a0d0e21e
LW		 472 /* assumes no premature commitment */
473 if (!op || (op->op_flags & OPf_KNOW) || error_count)
79072805
LW		 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);
8990e307 482 break;
79072805
LW		 483 case OP_OR:
484 case OP_AND:
485 case OP_COND_EXPR:
8990e307
LW		 486 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
487 scalar(kid);
79072805 488 break;
a0d0e21e
LW		 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 */
79072805
LW		 495 case OP_MATCH:
496 case OP_SUBST:
497 case OP_NULL:
8990e307
LW		 498 default:
499 if (op->op_flags & OPf_KIDS) {
500 for (kid = cUNOP->op_first; kid; kid = kid->op_sibling)
501 scalar(kid);
502 }
79072805 503 break;
463ee0b2 504 case OP_SCOPE:
79072805
LW		 505 case OP_LEAVE:
506 case OP_LEAVETRY:
507 case OP_LINESEQ:
8990e307 508 case OP_LIST:
79072805
LW		 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 }
93a17b20 515 curcop = &compiling;
79072805
LW		 516 break;
517 }
79072805
LW		 518 return op;
519}
520
521OP *
522scalarvoid(op)
523OP *op;
524{
525 OP *kid;
8990e307
LW		 526 char* useless = 0;
527 SV* sv;
79072805 528
a0d0e21e 529 if (!op || error_count)
79072805
LW		 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:
8990e307
LW		 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:
a0d0e21e
LW		 553 case OP_REFGEN:
554 case OP_SREFGEN:
8990e307
LW		 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:
8990e307
LW		 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:
a0d0e21e 614 if (!(op->op_private & OPpLVAL_INTRO))
8990e307
LW		 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:
a0d0e21e 622 if (!(op->op_private & OPpLVAL_INTRO) &&
85e6fe83 623 (!op->op_sibling || op->op_sibling->op_type != OP_READLINE))
8990e307
LW		 624 useless = "a variable";
625 break;
79072805 626
93a17b20 627 case OP_NEXTSTATE:
8990e307 628 case OP_DBSTATE:
93a17b20
LW		 629 curcop = ((COP*)op); /* for warning above */
630 break;
631
79072805 632 case OP_CONST:
8990e307
LW		 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) ||
a0d0e21e 640 strnEQ(SvPVX(sv), "ds", 2) ||
8990e307
LW		 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 */
79072805
LW		 647 break;
648
649 case OP_POSTINC:
8990e307 650 op->op_type = OP_PREINC; /* pre-increment is faster */
79072805
LW		 651 op->op_ppaddr = ppaddr[OP_PREINC];
652 break;
653
654 case OP_POSTDEC:
8990e307 655 op->op_type = OP_PREDEC; /* pre-decrement is faster */
79072805
LW		 656 op->op_ppaddr = ppaddr[OP_PREDEC];
657 break;
658
659 case OP_REPEAT:
660 scalarvoid(cBINOP->op_first);
8990e307 661 useless = op_name[op->op_type];
79072805 662 break;
8990e307 663
79072805
LW		 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;
a0d0e21e
LW		 670 case OP_NULL:
671 if (op->op_flags & OPf_STACKED)
672 break;
79072805
LW		 673 case OP_ENTERTRY:
674 case OP_ENTER:
675 case OP_SCALAR:
79072805
LW		 676 if (!(op->op_flags & OPf_KIDS))
677 break;
463ee0b2 678 case OP_SCOPE:
79072805
LW		 679 case OP_LEAVE:
680 case OP_LEAVETRY:
a0d0e21e
LW		 681 case OP_LEAVELOOP:
682 op->op_private |= OPpLEAVE_VOID;
79072805 683 case OP_LINESEQ:
79072805 684 case OP_LIST:
79072805
LW		 685 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
686 scalarvoid(kid);
687 break;
a0d0e21e
LW		 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;
79072805 694 }
8990e307
LW		 695 if (useless && dowarn)
696 warn("Useless use of %s in void context", useless);
79072805
LW		 697 return op;
698}
699
700OP *
701listkids(op)
702OP *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
712OP *
713list(op)
714OP *op;
715{
716 OP *kid;
717
a0d0e21e
LW		 718 /* assumes no premature commitment */
719 if (!op || (op->op_flags & OPf_KNOW) || error_count)
79072805
LW		 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;
463ee0b2 748 case OP_SCOPE:
79072805
LW		 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 }
93a17b20 758 curcop = &compiling;
79072805
LW		 759 break;
760 }
761 return op;
762}
763
764OP *
765scalarseq(op)
766OP *op;
767{
768 OP *kid;
769
463ee0b2
LW		 770 if (op) {
771 if (op->op_type == OP_LINESEQ ||
772 op->op_type == OP_SCOPE ||
79072805 773 op->op_type == OP_LEAVE ||
463ee0b2
LW		 774 op->op_type == OP_LEAVETRY)
775 {
776 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
ed6116ce 777 if (kid->op_sibling) {
463ee0b2 778 scalarvoid(kid);
ed6116ce 779 }
463ee0b2
LW		 780 }
781 curcop = &compiling;
79072805 782 }
463ee0b2 783 op->op_flags &= ~OPf_PARENS;
85e6fe83 784 if (hints & HINT_BLOCK_SCOPE)
463ee0b2 785 op->op_flags |= OPf_PARENS;
79072805 786 }
8990e307
LW		 787 else
788 op = newOP(OP_STUB, 0);
79072805
LW		 789 return op;
790}
791
a0d0e21e 792static OP *
463ee0b2 793modkids(op, type)
79072805
LW		 794OP *op;
795I32 type;
796{
797 OP *kid;
798 if (op && op->op_flags & OPf_KIDS) {
799 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
463ee0b2 800 mod(kid, type);
79072805
LW		 801 }
802 return op;
803}
804
463ee0b2 805static I32 modcount;
79072805
LW		 806
807OP *
463ee0b2 808mod(op, type)
79072805
LW		 809OP *op;
810I32 type;
811{
812 OP *kid;
813 SV *sv;
a0d0e21e 814 char mtype;
79072805 815
a0d0e21e 816 if (!op || error_count)
79072805
LW		 817 return op;
818
819 switch (op->op_type) {
a0d0e21e
LW		 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 */
93a17b20 839 op->op_ppaddr = ppaddr[OP_RV2CV];
85e6fe83
LW		 840 assert(cUNOP->op_first->op_type == OP_NULL);
841 null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */
79072805
LW		 842 break;
843 }
844 /* FALL THROUGH */
845 default:
a0d0e21e
LW		 846 nomod:
847 /* grep, foreach, subcalls, refgen */
848 if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
849 break;
8990e307 850 sprintf(tokenbuf, "Can't modify %s in %s",
79072805
LW		 851 op_name[op->op_type],
852 type ? op_name[type] : "local");
853 yyerror(tokenbuf);
854 return op;
855
a0d0e21e
LW		 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
79072805
LW		 881 case OP_COND_EXPR:
882 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
463ee0b2 883 mod(kid, type);
79072805
LW		 884 break;
885
886 case OP_RV2AV:
887 case OP_RV2HV:
888 case OP_RV2GV:
93a17b20 889 ref(cUNOP->op_first, op->op_type);
79072805 890 /* FALL THROUGH */
a0d0e21e
LW		 891 case OP_PADAV:
892 case OP_PADHV:
79072805
LW		 893 case OP_AASSIGN:
894 case OP_ASLICE:
895 case OP_HSLICE:
93a17b20
LW		 896 case OP_NEXTSTATE:
897 case OP_DBSTATE:
a0d0e21e
LW		 898 case OP_REFGEN:
899 case OP_CHOMP:
463ee0b2 900 modcount = 10000;
79072805 901 break;
463ee0b2 902 case OP_RV2SV:
8990e307 903 ref(cUNOP->op_first, op->op_type);
463ee0b2 904 /* FALL THROUGH */
93a17b20 905 case OP_PADSV:
79072805
LW		 906 case OP_UNDEF:
907 case OP_GV:
463ee0b2
LW		 908 case OP_AV2ARYLEN:
909 case OP_SASSIGN:
8990e307
LW		 910 case OP_AELEMFAST:
911 modcount++;
912 break;
913
463ee0b2
LW		 914 case OP_PUSHMARK:
915 break;
916
a0d0e21e
LW		 917
918 case OP_POS:
919 mtype = '.';
920 goto makelv;
463ee0b2 921 case OP_VEC:
a0d0e21e
LW		 922 mtype = 'v';
923 goto makelv;
924 case OP_SUBSTR:
925 mtype = 'x';
926 makelv:
8990e307 927 pad_free(op->op_targ);
ed6116ce 928 op->op_targ = pad_alloc(op->op_type, SVs_PADMY);
463ee0b2
LW		 929 sv = PAD_SV(op->op_targ);
930 sv_upgrade(sv, SVt_PVLV);
a0d0e21e 931 sv_magic(sv, Nullsv, mtype, Nullch, 0);
463ee0b2 932 curpad[op->op_targ] = sv;
8990e307
LW		 933 if (op->op_flags & OPf_KIDS)
934 mod(cBINOP->op_first, type);
463ee0b2 935 break;
a0d0e21e 936
463ee0b2
LW		 937 case OP_AELEM:
938 case OP_HELEM:
8990e307 939 ref(cBINOP->op_first, op->op_type);
a0d0e21e 940 modcount++;
463ee0b2
LW		 941 break;
942
943 case OP_SCOPE:
944 case OP_LEAVE:
945 case OP_ENTER:
a0d0e21e
LW		 946 if (op->op_flags & OPf_KIDS)
947 mod(cLISTOP->op_last, type);
948 break;
949
950 case OP_NULL:
463ee0b2
LW		 951 if (!(op->op_flags & OPf_KIDS))
952 break;
a0d0e21e
LW		 953 if (op->op_targ != OP_LIST) {
954 mod(cBINOP->op_first, type);
955 break;
956 }
957 /* FALL THROUGH */
463ee0b2
LW		 958 case OP_LIST:
959 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
960 mod(kid, type);
961 break;
962 }
a0d0e21e
LW		 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;
463ee0b2 969 op->op_flags &= ~OPf_SPECIAL;
463ee0b2 970 }
a0d0e21e
LW		 971 else if (type != OP_GREPSTART && type != OP_ENTERSUB)
972 op->op_flags |= OPf_REF;
463ee0b2
LW		 973 return op;
974}
975
976OP *
977refkids(op, type)
978OP *op;
979I32 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
989OP *
990ref(op, type)
991OP *op;
992I32 type;
993{
994 OP *kid;
463ee0b2 995
a0d0e21e 996 if (!op || error_count)
463ee0b2
LW		 997 return op;
998
999 switch (op->op_type) {
a0d0e21e
LW		 1000 case OP_ENTERSUB:
1001 if ((type == OP_DEFINED) &&
1002 !(op->op_flags & OPf_STACKED)) {
1003 op->op_type = OP_RV2CV; /* entersub => rv2cv */
8990e307 1004 op->op_ppaddr = ppaddr[OP_RV2CV];
85e6fe83
LW		 1005 assert(cUNOP->op_first->op_type == OP_NULL);
1006 null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */
8990e307
LW		 1007 }
1008 break;
1009
463ee0b2
LW		 1010 case OP_COND_EXPR:
1011 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
1012 ref(kid, type);
1013 break;
8990e307 1014 case OP_RV2SV:
8990e307 1015 ref(cUNOP->op_first, op->op_type);
a0d0e21e
LW		 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 }
8990e307
LW		 1020 break;
1021
463ee0b2
LW		 1022 case OP_RV2AV:
1023 case OP_RV2HV:
a0d0e21e 1024 op->op_flags |= OPf_REF;
8990e307 1025 /* FALL THROUGH */
463ee0b2
LW		 1026 case OP_RV2GV:
1027 ref(cUNOP->op_first, op->op_type);
463ee0b2 1028 break;
8990e307 1029
463ee0b2
LW		 1030 case OP_PADAV:
1031 case OP_PADHV:
a0d0e21e 1032 op->op_flags |= OPf_REF;
79072805 1033 break;
8990e307
LW		 1034
1035 case OP_SCALAR:
79072805
LW		 1036 case OP_NULL:
1037 if (!(op->op_flags & OPf_KIDS))
463ee0b2 1038 break;
8990e307 1039 ref(cBINOP->op_first, type);
79072805
LW		 1040 break;
1041 case OP_AELEM:
1042 case OP_HELEM:
8990e307 1043 ref(cBINOP->op_first, op->op_type);
a0d0e21e
LW		 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;
8990e307 1047 }
79072805
LW		 1048 break;
1049
463ee0b2 1050 case OP_SCOPE:
79072805
LW		 1051 case OP_LEAVE:
1052 case OP_ENTER:
8990e307 1053 case OP_LIST:
79072805
LW		 1054 if (!(op->op_flags & OPf_KIDS))
1055 break;
8990e307 1056 ref(cLISTOP->op_last, type);
79072805 1057 break;
a0d0e21e
LW		 1058 default:
1059 break;
79072805 1060 }
8990e307
LW		 1061 return scalar(op);
1062
79072805
LW		 1063}
1064
1065OP *
93a17b20
LW		 1066my(op)
1067OP *op;
1068{
1069 OP *kid;
93a17b20
LW		 1070 I32 type;
1071
a0d0e21e 1072 if (!op || error_count)
93a17b20
LW		 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 }
a0d0e21e
LW		 1089 op->op_flags |= OPf_MOD;
1090 op->op_private |= OPpLVAL_INTRO;
93a17b20
LW		 1091 return op;
1092}
1093
1094OP *
79072805
LW		 1095sawparens(o)
1096OP *o;
1097{
1098 if (o)
1099 o->op_flags |= OPf_PARENS;
1100 return o;
1101}
1102
1103OP *
1104bind_match(type, left, right)
1105I32 type;
1106OP *left;
1107OP *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)
463ee0b2 1116 left = mod(left, right->op_type);
79072805 1117 if (right->op_type == OP_TRANS)
a0d0e21e 1118 op = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
79072805
LW		 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
1130OP *
1131invert(op)
1132OP *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
1140OP *
1141scope(o)
1142OP *o;
1143{
1144 if (o) {
a0d0e21e 1145 if (o->op_flags & OPf_PARENS || perldb) {
463ee0b2
LW		 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;
8990e307
LW		 1156 if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
1157 null(kid);
463ee0b2
LW		 1158 }
1159 else
1160 o = newUNOP(OP_SCOPE, 0, o);
1161 }
79072805
LW		 1162 }
1163 return o;
1164}
1165
a0d0e21e
LW		 1166int
1167block_start()
79072805 1168{
a0d0e21e
LW		 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
1183OP*
1184block_end(line, floor, seq)
1185int line;
1186int floor;
1187OP* 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
1201void
1202newPROG(op)
1203OP *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);
79072805 1221 }
79072805
LW		 1222}
1223
1224OP *
93a17b20 1225localize(o, lex)
79072805 1226OP *o;
93a17b20 1227I32 lex;
79072805
LW		 1228{
1229 if (o->op_flags & OPf_PARENS)
1230 list(o);
8990e307 1231 else {
79072805 1232 scalar(o);
8990e307
LW		 1233 if (dowarn && bufptr > oldbufptr && bufptr[-1] == ',') {
1234 char *s;
1235 for (s = bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
a0d0e21e 1236 if (*s == ';' || *s == '=')
8990e307
LW		 1237 warn("Parens missing around \"%s\" list", lex ? "my" : "local");
1238 }
1239 }
93a17b20
LW		 1240 in_my = FALSE;
1241 if (lex)
1242 return my(o);
1243 else
463ee0b2 1244 return mod(o, OP_NULL); /* a bit kludgey */
79072805
LW		 1245}
1246
1247OP *
1248jmaybe(o)
1249OP *o;
1250{
1251 if (o->op_type == OP_LIST) {
1252 o = convert(OP_JOIN, 0,
1253 prepend_elem(OP_LIST,
85e6fe83 1254 newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
79072805
LW		 1255 o));
1256 }
1257 return o;
1258}
1259
1260OP *
1261fold_constants(o)
1262register OP *o;
1263{
1264 register OP *curop;
1265 I32 type = o->op_type;
79072805
LW		 1266
1267 if (opargs[type] & OA_RETSCALAR)
1268 scalar(o);
1269 if (opargs[type] & OA_TARGET)
ed6116ce 1270 o->op_targ = pad_alloc(type, SVs_PADTMP);
79072805 1271
85e6fe83 1272 if ((opargs[type] & OA_OTHERINT) && (hints & HINT_INTEGER))
a0d0e21e 1273 o->op_ppaddr = ppaddr[type = ++(o->op_type)];
85e6fe83 1274
79072805
LW		 1275 if (!(opargs[type] & OA_FOLDCONST))
1276 goto nope;
1277
a0d0e21e
LW		 1278 if (error_count)
1279 goto nope; /* Don't try to run w/ errors */
1280
79072805 1281 for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
93a17b20
LW		 1282 if (curop->op_type != OP_CONST &&
1283 curop->op_type != OP_LIST &&
1284 curop->op_type != OP_SCALAR &&
a0d0e21e 1285 curop->op_type != OP_NULL &&
93a17b20 1286 curop->op_type != OP_PUSHMARK) {
79072805
LW		 1287 goto nope;
1288 }
1289 }
1290
1291 curop = LINKLIST(o);
1292 o->op_next = 0;
1293 op = curop;
1294 run();
85e6fe83 1295 if (o->op_targ && *stack_sp == PAD_SV(o->op_targ)) /* grab pad temp? */
79072805 1296 pad_swipe(o->op_targ);
85e6fe83 1297 else if (SvTEMP(*stack_sp)) { /* grab mortal temp? */
a0d0e21e 1298 (void)SvREFCNT_inc(*stack_sp);
85e6fe83
LW		 1299 SvTEMP_off(*stack_sp);
1300 }
79072805
LW		 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;
79072805 1310
85e6fe83 1311 if (!(hints & HINT_INTEGER)) {
a0d0e21e 1312 if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS))
85e6fe83
LW		 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)
79072805
LW		 1322 continue;
1323 return o;
1324 }
a0d0e21e 1325 o->op_ppaddr = ppaddr[++(o->op_type)];
79072805
LW		 1326 }
1327
79072805
LW		 1328 return o;
1329}
1330
1331OP *
1332gen_constant_list(o)
1333register OP *o;
1334{
1335 register OP *curop;
79072805 1336 I32 oldtmps_floor = tmps_floor;
79072805 1337
a0d0e21e
LW		 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();
79072805 1345 run();
a0d0e21e
LW		 1346 op = curop;
1347 pp_anonlist();
79072805 1348 tmps_floor = oldtmps_floor;
79072805
LW		 1349
1350 o->op_type = OP_RV2AV;
1351 o->op_ppaddr = ppaddr[OP_RV2AV];
79072805 1352 curop = ((UNOP*)o)->op_first;
a0d0e21e 1353 ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*stack_sp--));
79072805 1354 op_free(curop);
79072805
LW		 1355 linklist(o);
1356 return list(o);
1357}
1358
1359OP *
1360convert(type, flags, op)
1361I32 type;
1362I32 flags;
1363OP* op;
1364{
1365 OP *kid;
a0d0e21e 1366 OP *last = 0;
79072805 1367
79072805
LW		 1368 if (!op || op->op_type != OP_LIST)
1369 op = newLISTOP(OP_LIST, 0, op, Nullop);
1370
8990e307
LW		 1371 if (!(opargs[type] & OA_MARK))
1372 null(cLISTOP->op_first);
1373
79072805
LW		 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
1394OP *
1395append_elem(type, first, last)
1396I32 type;
1397OP* first;
1398OP* last;
1399{
1400 if (!first)
1401 return last;
8990e307
LW		 1402
1403 if (!last)
79072805 1404 return first;
8990e307 1405
a0d0e21e
LW		 1406 if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS)
1407 return newLISTOP(type, 0, first, last);
79072805 1408
a0d0e21e
LW		 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;
79072805
LW		 1418}
1419
1420OP *
1421append_list(type, first, last)
1422I32 type;
1423LISTOP* first;
1424LISTOP* last;
1425{
1426 if (!first)
1427 return (OP*)last;
8990e307
LW		 1428
1429 if (!last)
79072805 1430 return (OP*)first;
8990e307
LW		 1431
1432 if (first->op_type != type)
79072805 1433 return prepend_elem(type, (OP*)first, (OP*)last);
8990e307
LW		 1434
1435 if (last->op_type != type)
79072805
LW		 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
1448OP *
1449prepend_elem(type, first, last)
1450I32 type;
1451OP* first;
1452OP* last;
1453{
1454 if (!first)
1455 return last;
8990e307
LW		 1456
1457 if (!last)
79072805 1458 return first;
8990e307
LW		 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;
79072805 1472 }
79072805
LW		 1473 ((LISTOP*)last)->op_children++;
1474 return last;
1475 }
1476
1477 return newLISTOP(type, 0, first, last);
1478}
1479
1480/* Constructors */
1481
1482OP *
1483newNULLLIST()
1484{
8990e307
LW		 1485 return newOP(OP_STUB, 0);
1486}
1487
1488OP *
1489force_list(op)
1490OP* op;
1491{
1492 if (!op || op->op_type != OP_LIST)
1493 op = newLISTOP(OP_LIST, 0, op, Nullop);
1494 null(op);
1495 return op;
79072805
LW		 1496}
1497
1498OP *
1499newLISTOP(type, flags, first, last)
1500I32 type;
1501I32 flags;
1502OP* first;
1503OP* 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;
79072805
LW		 1513
1514 if (!last && first)
1515 last = first;
1516 else if (!first && last)
1517 first = last;
8990e307
LW		 1518 else if (first)
1519 first->op_sibling = last;
79072805
LW		 1520 listop->op_first = first;
1521 listop->op_last = last;
8990e307
LW		 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;
79072805
LW		 1533
1534 return (OP*)listop;
1535}
1536
1537OP *
1538newOP(type, flags)
1539I32 type;
1540I32 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)
ed6116ce 1553 op->op_targ = pad_alloc(type, SVs_PADTMP);
79072805
LW		 1554 return (*check[type])(op);
1555}
1556
1557OP *
1558newUNOP(type, flags, first)
1559I32 type;
1560I32 flags;
1561OP* first;
1562{
1563 UNOP *unop;
1564
93a17b20
LW		 1565 if (!first)
1566 first = newOP(OP_STUB, 0);
8990e307
LW		 1567 if (opargs[type] & OA_MARK)
1568 first = force_list(first);
93a17b20 1569
79072805
LW		 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
a0d0e21e 1581 return fold_constants((OP *) unop);
79072805
LW		 1582}
1583
1584OP *
1585newBINOP(type, flags, first, last)
1586I32 type;
1587I32 flags;
1588OP* first;
1589OP* 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
a0d0e21e 1616 return fold_constants((OP *)binop);
79072805
LW		 1617}
1618
1619OP *
1620pmtrans(op, expr, repl)
1621OP *op;
1622OP *expr;
1623OP *repl;
1624{
79072805
LW		 1625 SV *tstr = ((SVOP*)expr)->op_sv;
1626 SV *rstr = ((SVOP*)repl)->op_sv;
463ee0b2
LW		 1627 STRLEN tlen;
1628 STRLEN rlen;
1629 register char *t = SvPV(tstr, tlen);
1630 register char *r = SvPV(rstr, rlen);
79072805
LW		 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
1687OP *
1688newPMOP(type, flags)
1689I32 type;
1690I32 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 */
a0d0e21e 1701 if (type != OP_TRANS && curstash) {
79072805
LW		 1702 pmop->op_pmnext = HvPMROOT(curstash);
1703 HvPMROOT(curstash) = pmop;
1704 }
1705
1706 return (OP*)pmop;
1707}
1708
1709OP *
1710pmruntime(op, expr, repl)
1711OP *op;
1712OP *expr;
1713OP *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) {
463ee0b2 1724 STRLEN plen;
79072805 1725 SV *pat = ((SVOP*)expr)->op_sv;
463ee0b2 1726 char *p = SvPV(pat, plen);
79072805 1727 if ((op->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
93a17b20 1728 sv_setpvn(pat, "\\s+", 3);
463ee0b2 1729 p = SvPV(pat, plen);
79072805
LW		 1730 pm->op_pmflags |= PMf_SKIPWHITE;
1731 }
a0d0e21e 1732#ifdef NOTDEF
463ee0b2 1733 scan_prefix(pm, p, plen);
79072805
LW		 1734 if (pm->op_pmshort && (pm->op_pmflags & PMf_SCANFIRST))
1735 fbm_compile(pm->op_pmshort, pm->op_pmflags & PMf_FOLD);
a0d0e21e
LW		 1736#endif
1737 pm->op_pmregexp = regcomp(p, p + plen, pm);
85e6fe83
LW		 1738 if (strEQ("\\s+", pm->op_pmregexp->precomp))
1739 pm->op_pmflags |= PMf_WHITE;
79072805
LW		 1740 hoistmust(pm);
1741 op_free(expr);
1742 }
1743 else {
463ee0b2
LW		 1744 if (pm->op_pmflags & PMf_KEEP)
1745 expr = newUNOP(OP_REGCMAYBE,0,expr);
1746
79072805
LW		 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 */
463ee0b2
LW		 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 }
79072805 1765
463ee0b2 1766 prepend_elem(op->op_type, scalar((OP*)rcop), op);
79072805
LW		 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;
93a17b20 1781 if (strchr("&`'123456789+", *GvENAME(gv)))
79072805
LW		 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
463ee0b2 1815 pm->op_pmreplroot = scalar((OP*)rcop);
79072805
LW		 1816 pm->op_pmreplstart = LINKLIST(rcop);
1817 rcop->op_next = 0;
1818 }
1819 }
1820 }
1821
1822 return (OP*)pm;
1823}
1824
1825OP *
1826newSVOP(type, flags, sv)
1827I32 type;
1828I32 flags;
1829SV *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)
463ee0b2 1839 scalar((OP*)svop);
79072805 1840 if (opargs[type] & OA_TARGET)
ed6116ce 1841 svop->op_targ = pad_alloc(type, SVs_PADTMP);
79072805
LW		 1842 return (*check[type])((OP*)svop);
1843}
1844
1845OP *
1846newGVOP(type, flags, gv)
1847I32 type;
1848I32 flags;
1849GV *gv;
1850{
1851 GVOP *gvop;
1852 Newz(1101, gvop, 1, GVOP);
1853 gvop->op_type = type;
1854 gvop->op_ppaddr = ppaddr[type];
8990e307 1855 gvop->op_gv = (GV*)SvREFCNT_inc(gv);
79072805
LW		 1856 gvop->op_next = (OP*)gvop;
1857 gvop->op_flags = flags;
1858 if (opargs[type] & OA_RETSCALAR)
463ee0b2 1859 scalar((OP*)gvop);
79072805 1860 if (opargs[type] & OA_TARGET)
ed6116ce 1861 gvop->op_targ = pad_alloc(type, SVs_PADTMP);
79072805
LW		 1862 return (*check[type])((OP*)gvop);
1863}
1864
1865OP *
1866newPVOP(type, flags, pv)
1867I32 type;
1868I32 flags;
1869char *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)
463ee0b2 1879 scalar((OP*)pvop);
79072805 1880 if (opargs[type] & OA_TARGET)
ed6116ce 1881 pvop->op_targ = pad_alloc(type, SVs_PADTMP);
79072805
LW		 1882 return (*check[type])((OP*)pvop);
1883}
1884
1885OP *
1886newCVOP(type, flags, cv, cont)
1887I32 type;
1888I32 flags;
1889CV *cv;
1890OP *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)
463ee0b2 1901 scalar((OP*)cvop);
79072805 1902 if (opargs[type] & OA_TARGET)
ed6116ce 1903 cvop->op_targ = pad_alloc(type, SVs_PADTMP);
79072805
LW		 1904 return (*check[type])((OP*)cvop);
1905}
1906
1907void
1908package(op)
1909OP *op;
1910{
93a17b20 1911 SV *sv;
79072805
LW		 1912
1913 save_hptr(&curstash);
1914 save_item(curstname);
93a17b20 1915 if (op) {
463ee0b2
LW		 1916 STRLEN len;
1917 char *name;
93a17b20 1918 sv = cSVOP->op_sv;
463ee0b2 1919 name = SvPV(sv, len);
a0d0e21e 1920 curstash = gv_stashpv(name,TRUE);
463ee0b2 1921 sv_setpvn(curstname, name, len);
93a17b20
LW		 1922 op_free(op);
1923 }
1924 else {
1925 sv_setpv(curstname,"<none>");
1926 curstash = Nullhv;
1927 }
79072805 1928 copline = NOLINE;
8990e307 1929 expect = XSTATE;
79072805
LW		 1930}
1931
85e6fe83 1932void
a0d0e21e 1933utilize(aver, id, arg)
85e6fe83
LW		 1934int aver;
1935OP *id;
1936OP *arg;
1937{
a0d0e21e
LW		 1938 OP *pack;
1939 OP *meth;
1940 OP *rqop;
1941 OP *imop;
85e6fe83 1942
a0d0e21e
LW		 1943 if (id->op_type != OP_CONST)
1944 croak("Module name must be constant");
85e6fe83 1945
a0d0e21e
LW		 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) ));
85e6fe83 1970
85e6fe83
LW		 1971 copline = NOLINE;
1972 expect = XSTATE;
1973}
1974
79072805
LW		 1975OP *
1976newSLICEOP(flags, subscript, listval)
1977I32 flags;
1978OP *subscript;
1979OP *listval;
1980{
1981 return newBINOP(OP_LSLICE, flags,
8990e307
LW		 1982 list(force_list(subscript)),
1983 list(force_list(listval)) );
79072805
LW		 1984}
1985
1986static I32
1987list_assignment(op)
1988register 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
93a17b20
LW		 2012 if (op->op_type == OP_PADAV || op->op_type == OP_PADHV)
2013 return TRUE;
2014
79072805
LW		 2015 if (op->op_type == OP_RV2SV)
2016 return FALSE;
2017
2018 return FALSE;
2019}
2020
2021OP *
a0d0e21e 2022newASSIGNOP(flags, left, optype, right)
79072805
LW		 2023I32 flags;
2024OP *left;
a0d0e21e 2025I32 optype;
79072805
LW		 2026OP *right;
2027{
2028 OP *op;
2029
a0d0e21e
LW		 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
79072805 2042 if (list_assignment(left)) {
463ee0b2 2043 modcount = 0;
a0d0e21e 2044 eval_start = right; /* Grandfathering $[ assignment here. Bletch. */
463ee0b2 2045 left = mod(left, OP_AASSIGN);
a0d0e21e
LW		 2046 if (!eval_start) {
2047 op_free(left);
2048 op_free(right);
2049 return Nullop;
2050 }
79072805
LW		 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;
a0d0e21e
LW		 2054 if (left->op_type == OP_RV2AV &&
2055 !(left->op_private & OPpLVAL_INTRO) )
2056 {
79072805
LW		 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 {
463ee0b2 2066 if (modcount < 10000) {
79072805 2067 SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
463ee0b2
LW		 2068 if (SvIVX(sv) == 0)
2069 sv_setiv(sv, modcount+1);
79072805
LW		 2070 }
2071 }
2072 }
2073 }
2074 op = newBINOP(OP_AASSIGN, flags,
8990e307
LW		 2075 list(force_list(right)),
2076 list(force_list(left)) );
79072805 2077 op->op_private = 0;
a0d0e21e 2078 if (!(left->op_private & OPpLVAL_INTRO)) {
79072805
LW		 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 }
79072805
LW		 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;
463ee0b2 2114 return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right));
79072805 2115 }
a0d0e21e
LW		 2116 else {
2117 eval_start = right; /* Grandfathering $[ assignment here. Bletch. */
79072805 2118 op = newBINOP(OP_SASSIGN, flags,
463ee0b2 2119 scalar(right), mod(scalar(left), OP_SASSIGN) );
a0d0e21e
LW		 2120 if (!eval_start) {
2121 op_free(op);
2122 return Nullop;
2123 }
2124 }
79072805
LW		 2125 return op;
2126}
2127
2128OP *
2129newSTATEOP(flags, label, op)
2130I32 flags;
2131char *label;
2132OP *op;
2133{
2134 register COP *cop;
2135
8990e307
LW		 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++) {
a0d0e21e 2142 if ((sv = svp[i]) && sv != &sv_undef)
8990e307
LW		 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 }
93a17b20 2148
79072805 2149 Newz(1101, cop, 1, COP);
8990e307
LW		 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 }
79072805
LW		 2158 cop->op_flags = flags;
2159 cop->op_private = 0;
2160 cop->op_next = (OP*)cop;
2161
463ee0b2
LW		 2162 if (label) {
2163 cop->cop_label = label;
85e6fe83 2164 hints |= HINT_BLOCK_SCOPE;
463ee0b2
LW		 2165 }
2166 cop->cop_seq = cop_seqmax++;
a0d0e21e 2167 cop->cop_arybase = curcop->cop_arybase;
79072805
LW		 2168
2169 if (copline == NOLINE)
2170 cop->cop_line = curcop->cop_line;
2171 else {
2172 cop->cop_line = copline;
2173 copline = NOLINE;
2174 }
8990e307 2175 cop->cop_filegv = SvREFCNT_inc(curcop->cop_filegv);
79072805
LW		 2176 cop->cop_stash = curstash;
2177
8990e307 2178 if (perldb && curstash != debstash) {
93a17b20
LW		 2179 SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE);
2180 if (svp && *svp != &sv_undef && !SvIOK(*svp)) {
463ee0b2 2181 SvIVX(*svp) = 1;
a0d0e21e 2182 (void)SvIOK_on(*svp);
93a17b20
LW		 2183 SvSTASH(*svp) = (HV*)cop;
2184 }
2185 }
2186
79072805
LW		 2187 return prepend_elem(OP_LINESEQ, (OP*)cop, op);
2188}
2189
2190OP *
2191newLOGOP(type, flags, first, other)
2192I32 type;
2193I32 flags;
2194OP* first;
2195OP* other;
2196{
2197 LOGOP *logop;
2198 OP *op;
2199
a0d0e21e
LW		 2200 if (type == OP_XOR) /* Not short circuit, but here by precedence. */
2201 return newBINOP(type, flags, scalar(first), scalar(other));
2202
8990e307 2203 scalarboolean(first);
79072805
LW		 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) {
93a17b20
LW		 2220 if (dowarn && (first->op_private & OPpCONST_BARE))
2221 warn("Probable precedence problem on %s", op_name[type]);
79072805
LW		 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
a0d0e21e
LW		 2241 if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
2242 other->op_private |= OPpASSIGN_BACKWARDS; /* other is an OP_SASSIGN */
2243
79072805
LW		 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
2264OP *
2265newCONDOP(flags, first, true, false)
2266I32 flags;
2267OP* first;
2268OP* true;
2269OP* false;
2270{
2271 CONDOP *condop;
2272 OP *op;
2273
2274 if (!false)
2275 return newLOGOP(OP_AND, 0, first, true);
463ee0b2
LW		 2276 if (!true)
2277 return newLOGOP(OP_OR, 0, first, false);
79072805 2278
8990e307 2279 scalarboolean(first);
79072805
LW		 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
2320OP *
2321newRANGE(flags, left, right)
2322I32 flags;
2323OP *left;
2324OP *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
ed6116ce 2352 condop->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
79072805 2353 sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV);
ed6116ce 2354 flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
79072805
LW		 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
2367OP *
2368newLOOPOP(flags, debuggable, expr, block)
2369I32 flags;
2370I32 debuggable;
2371OP *expr;
2372OP *block;
2373{
463ee0b2 2374 OP* listop;
93a17b20 2375 OP* op;
463ee0b2 2376 int once = block && block->op_flags & OPf_SPECIAL &&
a0d0e21e 2377 (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
93a17b20 2378
463ee0b2
LW		 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)
a0d0e21e 2383 expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr);
463ee0b2 2384 }
93a17b20 2385
8990e307 2386 listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
93a17b20 2387 op = newLOGOP(OP_AND, 0, expr, listop);
463ee0b2 2388
79072805
LW		 2389 ((LISTOP*)listop)->op_last->op_next = LINKLIST(op);
2390
463ee0b2 2391 if (once && op != listop)
79072805
LW		 2392 op->op_next = ((LOGOP*)cUNOP->op_first)->op_other;
2393
2394 op->op_flags |= flags;
a0d0e21e
LW		 2395 op = scope(op);
2396 op->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration */
2397 return op;
79072805
LW		 2398}
2399
2400OP *
2401newWHILEOP(flags, debuggable, loop, expr, block, cont)
2402I32 flags;
2403I32 debuggable;
2404LOOP *loop;
2405OP *expr;
2406OP *block;
2407OP *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))
a0d0e21e 2416 expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr);
79072805
LW		 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
463ee0b2 2426 listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
79072805
LW		 2427 redo = LINKLIST(listop);
2428
2429 if (expr) {
2430 op = newLOGOP(OP_AND, 0, expr, scalar(listop));
85e6fe83
LW		 2431 if (op == expr && op->op_type == OP_CONST && !SvTRUE(cSVOP->op_sv)) {
2432 op_free(expr); /* oops, it's a while (0) */
463ee0b2
LW		 2433 op_free((OP*)loop);
2434 return Nullop; /* (listop already freed by newLOGOP) */
2435 }
79072805
LW		 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
463ee0b2 2452 op = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, op);
79072805
LW		 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
2466OP *
a0d0e21e 2467#ifndef CAN_PROTOTYPE
79072805
LW		 2468newFOROP(flags,label,forline,sv,expr,block,cont)
2469I32 flags;
2470char *label;
2471line_t forline;
2472OP* sv;
2473OP* expr;
2474OP*block;
2475OP*cont;
8990e307
LW		 2476#else
2477newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
a0d0e21e 2478#endif /* CAN_PROTOTYPE */
79072805
LW		 2479{
2480 LOOP *loop;
85e6fe83 2481 int padoff = 0;
79072805
LW		 2482
2483 copline = forline;
2484 if (sv) {
85e6fe83 2485 if (sv->op_type == OP_RV2SV) { /* symbol table variable */
79072805
LW		 2486 OP *op = sv;
2487 sv = cUNOP->op_first;
2488 sv->op_next = sv;
2489 cUNOP->op_first = Nullop;
2490 op_free(op);
2491 }
85e6fe83
LW		 2492 else if (sv->op_type == OP_PADSV) { /* private variable */
2493 padoff = sv->op_targ;
2494 op_free(sv);
2495 sv = Nullop;
2496 }
79072805 2497 else
463ee0b2 2498 croak("Can't use %s for loop variable", op_name[sv->op_type]);
79072805
LW		 2499 }
2500 else {
2501 sv = newGVOP(OP_GV, 0, defgv);
2502 }
2503 loop = (LOOP*)list(convert(OP_ENTERITER, 0,
a0d0e21e
LW		 2504 append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART),
2505 scalar(sv))));
85e6fe83
LW		 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));
79072805
LW		 2511}
2512
8990e307
LW		 2513OP*
2514newLOOPEX(type, label)
2515I32 type;
2516OP* label;
2517{
2518 OP *op;
2519 if (type != OP_GOTO || label->op_type == OP_CONST) {
a0d0e21e
LW		 2520 op = newPVOP(type, 0, savepv(
2521 label->op_type == OP_CONST
2522 ? SvPVx(((SVOP*)label)->op_sv, na)
2523 : "" ));
8990e307
LW		 2524 op_free(label);
2525 }
2526 else {
a0d0e21e
LW		 2527 if (label->op_type == OP_ENTERSUB)
2528 label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
8990e307
LW		 2529 op = newUNOP(type, OPf_STACKED, label);
2530 }
85e6fe83 2531 hints |= HINT_BLOCK_SCOPE;
8990e307
LW		 2532 return op;
2533}
2534
79072805 2535void
85e6fe83 2536cv_undef(cv)
79072805
LW		 2537CV *cv;
2538{
a0d0e21e
LW		 2539 if (!CvXSUB(cv) && CvROOT(cv)) {
2540 if (CvDEPTH(cv))
2541 croak("Can't undef active subroutine");
8990e307 2542 ENTER;
a0d0e21e
LW		 2543
2544 SAVESPTR(curpad);
2545 curpad = 0;
2546
79072805
LW		 2547 op_free(CvROOT(cv));
2548 CvROOT(cv) = Nullop;
79072805
LW		 2549 if (CvPADLIST(cv)) {
2550 I32 i = AvFILL(CvPADLIST(cv));
a0d0e21e 2551 while (i >= 0) {
79072805
LW		 2552 SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
2553 if (svp)
a0d0e21e 2554 SvREFCNT_dec(*svp);
79072805 2555 }
a0d0e21e 2556 SvREFCNT_dec((SV*)CvPADLIST(cv));
79072805 2557 }
8990e307
LW		 2558 SvREFCNT_dec(CvGV(cv));
2559 LEAVE;
79072805 2560 }
79072805
LW		 2561}
2562
a0d0e21e 2563CV *
79072805
LW		 2564newSUB(floor,op,block)
2565I32 floor;
2566OP *op;
2567OP *block;
2568{
2569 register CV *cv;
a0d0e21e
LW		 2570 char *name = op ? SvPVx(cSVOP->op_sv, na) : "__ANON__";
2571 GV *gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV);
79072805 2572 AV* av;
8990e307 2573 char *s;
a0d0e21e 2574 I32 ix;
79072805 2575
a0d0e21e
LW		 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) {
79072805
LW		 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 }
8990e307 2589 SvREFCNT_dec(cv);
a0d0e21e 2590 cv = 0;
79072805
LW		 2591 }
2592 }
a0d0e21e
LW		 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 }
79072805 2601 GvCV(gv) = cv;
463ee0b2 2602 GvCVGEN(gv) = 0;
79072805 2603 CvFILEGV(cv) = curcop->cop_filegv;
8990e307
LW		 2604 CvGV(cv) = SvREFCNT_inc(gv);
2605 CvSTASH(cv) = curstash;
2606
a0d0e21e
LW		 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);
8990e307 2617 av_store(comppad, 0, (SV*)av);
a0d0e21e
LW		 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 }
79072805
LW		 2624
2625 av = newAV();
2626 AvREAL_off(av);
8990e307
LW		 2627 if (AvFILL(comppad_name) < AvFILL(comppad))
2628 av_store(comppad_name, AvFILL(comppad), Nullsv);
a0d0e21e
LW		 2629 av_store(av, 0, SvREFCNT_inc((SV*)comppad_name));
2630 av_store(av, 1, SvREFCNT_inc((SV*)comppad));
79072805
LW		 2631 AvFILL(av) = 1;
2632 CvPADLIST(cv) = av;
2633
a0d0e21e 2634 CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
79072805
LW		 2635 CvSTART(cv) = LINKLIST(CvROOT(cv));
2636 CvROOT(cv)->op_next = 0;
2637 peep(CvSTART(cv));
8990e307
LW		 2638 if (s = strrchr(name,':'))
2639 s++;
2640 else
2641 s = name;
2642 if (strEQ(s, "BEGIN")) {
2643 line_t oldline = compiling.cop_line;
93a17b20 2644
8990e307
LW		 2645 ENTER;
2646 SAVESPTR(compiling.cop_filegv);
2647 SAVEI32(perldb);
93a17b20
LW		 2648 if (!beginav)
2649 beginav = newAV();
85e6fe83 2650 av_push(beginav, (SV *)cv);
93a17b20
LW		 2651 DEBUG_x( dump_sub(gv) );
2652 rs = nrs;
2653 rslen = nrslen;
2654 rschar = nrschar;
2655 rspara = (nrslen == 2);
8990e307 2656 GvCV(gv) = 0;
93a17b20 2657 calllist(beginav);
93a17b20
LW		 2658 rs = "\n";
2659 rslen = 1;
2660 rschar = '\n';
2661 rspara = 0;
93a17b20 2662 curcop = &compiling;
8990e307
LW		 2663 curcop->cop_line = oldline; /* might have recursed to yylex */
2664 LEAVE;
93a17b20 2665 }
8990e307 2666 else if (strEQ(s, "END")) {
93a17b20
LW		 2667 if (!endav)
2668 endav = newAV();
2669 av_unshift(endav, 1);
8990e307 2670 av_store(endav, 0, SvREFCNT_inc(cv));
93a17b20 2671 }
8990e307 2672 if (perldb && curstash != debstash) {
79072805 2673 SV *sv;
8990e307 2674 SV *tmpstr = sv_newmortal();
79072805 2675
a0d0e21e 2676 sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
79072805
LW		 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);
463ee0b2 2682 hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
79072805
LW		 2683 }
2684 op_free(op);
2685 copline = NOLINE;
8990e307 2686 LEAVE_SCOPE(floor);
a0d0e21e
LW		 2687 if (!op)
2688 GvCV(gv) = 0; /* Will remember in SVOP instead. */
2689 return cv;
79072805
LW		 2690}
2691
a0d0e21e
LW		 2692#ifdef DEPRECATED
2693CV *
463ee0b2 2694newXSUB(name, ix, subaddr, filename)
79072805
LW		 2695char *name;
2696I32 ix;
2697I32 (*subaddr)();
2698char *filename;
2699{
a0d0e21e
LW		 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
2707CV *
2708newXS(name, subaddr, filename)
2709char *name;
2710void (*subaddr) _((CV*));
2711char *filename;
2712{
79072805 2713 register CV *cv;
a0d0e21e 2714 GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV);
8990e307 2715 char *s;
79072805 2716
a0d0e21e
LW		 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;
79072805 2732 }
79072805 2733 }
a0d0e21e
LW		 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 }
79072805 2742 GvCV(gv) = cv;
8990e307 2743 CvGV(cv) = SvREFCNT_inc(gv);
463ee0b2 2744 GvCVGEN(gv) = 0;
79072805 2745 CvFILEGV(cv) = gv_fetchfile(filename);
a0d0e21e
LW		 2746 CvXSUB(cv) = subaddr;
2747 if (!name)
2748 s = "__ANON__";
2749 else if (s = strrchr(name,':'))
8990e307
LW		 2750 s++;
2751 else
2752 s = name;
2753 if (strEQ(s, "BEGIN")) {
93a17b20
LW		 2754 if (!beginav)
2755 beginav = newAV();
8990e307 2756 av_push(beginav, SvREFCNT_inc(gv));
93a17b20 2757 }
8990e307 2758 else if (strEQ(s, "END")) {
93a17b20
LW		 2759 if (!endav)
2760 endav = newAV();
2761 av_unshift(endav, 1);
8990e307 2762 av_store(endav, 0, SvREFCNT_inc(gv));
93a17b20 2763 }
a0d0e21e
LW		 2764 if (!name)
2765 GvCV(gv) = 0; /* Will remember elsewhere instead. */
2766 return cv;
79072805
LW		 2767}
2768
2769void
2770newFORM(floor,op,block)
2771I32 floor;
2772OP *op;
2773OP *block;
2774{
2775 register CV *cv;
2776 char *name;
2777 GV *gv;
2778 AV* av;
a0d0e21e 2779 I32 ix;
79072805
LW		 2780
2781 if (op)
463ee0b2 2782 name = SvPVx(cSVOP->op_sv, na);
79072805
LW		 2783 else
2784 name = "STDOUT";
85e6fe83 2785 gv = gv_fetchpv(name,TRUE, SVt_PVFM);
a0d0e21e 2786 SvMULTI_on(gv);
79072805
LW		 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 }
8990e307 2795 SvREFCNT_dec(cv);
79072805 2796 }
a0d0e21e
LW		 2797 cv = (CV*)NEWSV(1106,0);
2798 sv_upgrade((SV *)cv, SVt_PVFM);
79072805 2799 GvFORM(gv) = cv;
8990e307 2800 CvGV(cv) = SvREFCNT_inc(gv);
79072805
LW		 2801 CvFILEGV(cv) = curcop->cop_filegv;
2802
a0d0e21e
LW		 2803 for (ix = AvFILL(comppad); ix > 0; ix--) {
2804 if (!SvPADMY(curpad[ix]))
2805 SvPADTMP_on(curpad[ix]);
2806 }
2807
79072805
LW		 2808 CvPADLIST(cv) = av = newAV();
2809 AvREAL_off(av);
a0d0e21e 2810 av_store(av, 1, SvREFCNT_inc((SV*)comppad));
79072805
LW		 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));
79072805
LW		 2817 FmLINES(cv) = 0;
2818 op_free(op);
2819 copline = NOLINE;
8990e307 2820 LEAVE_SCOPE(floor);
79072805
LW		 2821}
2822
2823OP *
2824newMETHOD(ref,name)
2825OP *ref;
2826OP *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);
ed6116ce 2836 mop->op_targ = pad_alloc(OP_METHOD, SVs_PADTMP);
79072805
LW		 2837 mop->op_next = LINKLIST(ref);
2838 ref->op_next = (OP*)mop;
8990e307 2839 return scalar((OP*)mop);
79072805
LW		 2840}
2841
2842OP *
2843newANONLIST(op)
2844OP* op;
2845{
93a17b20 2846 return newUNOP(OP_REFGEN, 0,
a0d0e21e 2847 mod(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN));
79072805
LW		 2848}
2849
2850OP *
2851newANONHASH(op)
2852OP* op;
2853{
93a17b20 2854 return newUNOP(OP_REFGEN, 0,
a0d0e21e
LW		 2855 mod(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN));
2856}
2857
2858OP *
2859newANONSUB(floor, block)
2860I32 floor;
2861OP *block;
2862{
2863 return newUNOP(OP_REFGEN, 0,
2864 newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, block)));
79072805
LW		 2865}
2866
2867OP *
2868oopsAV(o)
2869OP *o;
2870{
ed6116ce
LW		 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:
79072805
LW		 2878 o->op_type = OP_RV2AV;
2879 o->op_ppaddr = ppaddr[OP_RV2AV];
2880 ref(o, OP_RV2AV);
ed6116ce
LW		 2881 break;
2882
2883 default:
79072805 2884 warn("oops: oopsAV");
ed6116ce
LW		 2885 break;
2886 }
79072805
LW		 2887 return o;
2888}
2889
2890OP *
2891oopsHV(o)
2892OP *o;
2893{
ed6116ce
LW		 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:
79072805
LW		 2903 o->op_type = OP_RV2HV;
2904 o->op_ppaddr = ppaddr[OP_RV2HV];
2905 ref(o, OP_RV2HV);
ed6116ce
LW		 2906 break;
2907
2908 default:
79072805 2909 warn("oops: oopsHV");
ed6116ce
LW		 2910 break;
2911 }
79072805
LW		 2912 return o;
2913}
2914
2915OP *
2916newAVREF(o)
2917OP *o;
2918{
ed6116ce
LW		 2919 if (o->op_type == OP_PADANY) {
2920 o->op_type = OP_PADAV;
2921 o->op_ppaddr = ppaddr[OP_PADAV];
93a17b20 2922 return o;
ed6116ce 2923 }
79072805
LW		 2924 return newUNOP(OP_RV2AV, 0, scalar(o));
2925}
2926
2927OP *
a0d0e21e
LW		 2928newGVREF(type,o)
2929I32 type;
79072805
LW		 2930OP *o;
2931{
a0d0e21e
LW		 2932 if (type == OP_MAPSTART)
2933 return newUNOP(OP_NULL, 0, o);
2934 return newUNOP(OP_RV2GV, 0, o);
79072805
LW		 2935}
2936
2937OP *
2938newHVREF(o)
2939OP *o;
2940{
ed6116ce
LW		 2941 if (o->op_type == OP_PADANY) {
2942 o->op_type = OP_PADHV;
2943 o->op_ppaddr = ppaddr[OP_PADHV];
93a17b20 2944 return o;
ed6116ce 2945 }
79072805
LW		 2946 return newUNOP(OP_RV2HV, 0, scalar(o));
2947}
2948
2949OP *
2950oopsCV(o)
2951OP *o;
2952{
463ee0b2 2953 croak("NOT IMPL LINE %d",__LINE__);
79072805
LW		 2954 /* STUB */
2955 return o;
2956}
2957
2958OP *
2959newCVREF(o)
2960OP *o;
2961{
2962 return newUNOP(OP_RV2CV, 0, scalar(o));
2963}
2964
2965OP *
2966newSVREF(o)
2967OP *o;
2968{
ed6116ce
LW		 2969 if (o->op_type == OP_PADANY) {
2970 o->op_type = OP_PADSV;
2971 o->op_ppaddr = ppaddr[OP_PADSV];
93a17b20 2972 return o;
ed6116ce 2973 }
79072805
LW		 2974 return newUNOP(OP_RV2SV, 0, scalar(o));
2975}
2976
2977/* Check routines. */
2978
2979OP *
79072805
LW		 2980ck_concat(op)
2981OP *op;
2982{
2983 if (cUNOP->op_first->op_type == OP_CONCAT)
2984 op->op_flags |= OPf_STACKED;
2985 return op;
2986}
2987
2988OP *
a0d0e21e 2989ck_spair(op)
79072805
LW		 2990OP *op;
2991{
2992 if (op->op_flags & OPf_KIDS) {
2993 OP* newop;
a0d0e21e 2994 OP* kid;
463ee0b2 2995 op = modkids(ck_fun(op), op->op_type);
a0d0e21e
LW		 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
79072805 3004 return op;
a0d0e21e
LW		 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
3013OP *
3014ck_delete(op)
3015OP *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);
79072805 3023 }
79072805
LW		 3024 return op;
3025}
3026
3027OP *
3028ck_eof(op)
3029OP *op;
3030{
3031 I32 type = op->op_type;
3032
8990e307
LW		 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,
85e6fe83 3037 newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV)));
8990e307 3038 }
79072805 3039 return ck_fun(op);
79072805
LW		 3040 }
3041 return op;
3042}
3043
3044OP *
3045ck_eval(op)
3046OP *op;
3047{
85e6fe83 3048 hints |= HINT_BLOCK_SCOPE;
79072805
LW		 3049 if (op->op_flags & OPf_KIDS) {
3050 SVOP *kid = (SVOP*)cUNOP->op_first;
3051
93a17b20
LW		 3052 if (!kid) {
3053 op->op_flags &= ~OPf_KIDS;
8990e307 3054 null(op);
79072805
LW		 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
463ee0b2 3071 op = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
79072805
LW		 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 }
a0d0e21e 3082 op->op_targ = (PADOFFSET)hints;
79072805
LW		 3083 return op;
3084}
3085
3086OP *
3087ck_exec(op)
3088OP *op;
3089{
3090 OP *kid;
79072805 3091 if (op->op_flags & OPf_STACKED) {
463ee0b2 3092 op = ck_fun(op);
79072805 3093 kid = cUNOP->op_first->op_sibling;
8990e307
LW		 3094 if (kid->op_type == OP_RV2GV)
3095 null(kid);
79072805 3096 }
463ee0b2
LW		 3097 else
3098 op = listkids(op);
79072805
LW		 3099 return op;
3100}
3101
3102OP *
3103ck_gvconst(o)
3104register 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
3112OP *
3113ck_rvconst(op)
3114register OP *op;
3115{
3116 SVOP *kid = (SVOP*)cUNOP->op_first;
a0d0e21e 3117 int iscv = (op->op_type==OP_RV2CV)*2;
85e6fe83 3118
a0d0e21e 3119 op->op_private = (hints & HINT_STRICT_REFS);
79072805 3120 if (kid->op_type == OP_CONST) {
a0d0e21e 3121 GV *gv = 0;
79072805 3122 kid->op_type = OP_GV;
a0d0e21e
LW		 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 }
adbc6bb1 3136 SvREFCNT_dec(kid->op_sv);
a0d0e21e 3137 kid->op_sv = SvREFCNT_inc(gv);
79072805
LW		 3138 }
3139 return op;
3140}
3141
3142OP *
3143ck_formline(op)
3144OP *op;
3145{
3146 return ck_fun(op);
3147}
3148
3149OP *
3150ck_ftst(op)
3151OP *op;
3152{
3153 I32 type = op->op_type;
3154
a0d0e21e 3155 if (op->op_flags & OPf_REF)
79072805
LW		 3156 return op;
3157
3158 if (op->op_flags & OPf_KIDS) {
3159 SVOP *kid = (SVOP*)cUNOP->op_first;
3160
3161 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
a0d0e21e 3162 OP *newop = newGVOP(type, OPf_REF,
85e6fe83 3163 gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
79072805
LW		 3164 op_free(op);
3165 return newop;
3166 }
3167 }
3168 else {
3169 op_free(op);
3170 if (type == OP_FTTTY)
a0d0e21e 3171 return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
85e6fe83 3172 SVt_PVIO));
79072805
LW		 3173 else
3174 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3175 }
3176 return op;
3177}
3178
3179OP *
3180ck_fun(op)
3181OP *op;
3182{
3183 register OP *kid;
3184 OP **tokid;
3185 OP *sibl;
3186 I32 numargs = 0;
a0d0e21e
LW		 3187 int type = op->op_type;
3188 register I32 oa = opargs[type] >> OASHIFT;
79072805
LW		 3189
3190 if (op->op_flags & OPf_STACKED) {
3191 if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
3192 oa &= ~OA_OPTIONAL;
3193 else
3194 return no_fh_allowed(op);
3195 }
3196
3197 if (op->op_flags & OPf_KIDS) {
3198 tokid = &cLISTOP->op_first;
3199 kid = cLISTOP->op_first;
8990e307
LW		 3200 if (kid->op_type == OP_PUSHMARK ||
3201 kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
3202 {
79072805
LW		 3203 tokid = &kid->op_sibling;
3204 kid = kid->op_sibling;
3205 }
a0d0e21e
LW		 3206 if (!kid && opargs[type] & OA_DEFGV)
3207 *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
79072805
LW		 3208
3209 while (oa && kid) {
3210 numargs++;
3211 sibl = kid->op_sibling;
3212 switch (oa & 7) {
3213 case OA_SCALAR:
3214 scalar(kid);
3215 break;
3216 case OA_LIST:
3217 if (oa < 16) {
3218 kid = 0;
3219 continue;
3220 }
3221 else
3222 list(kid);
3223 break;
3224 case OA_AVREF:
3225 if (kid->op_type == OP_CONST &&
3226 (kid->op_private & OPpCONST_BARE)) {
463ee0b2 3227 char *name = SvPVx(((SVOP*)kid)->op_sv, na);
79072805 3228 OP *newop = newAVREF(newGVOP(OP_GV, 0,
85e6fe83 3229 gv_fetchpv(name, TRUE, SVt_PVAV) ));
463ee0b2
LW		 3230 if (dowarn)
3231 warn("Array @%s missing the @ in argument %d of %s()",
a0d0e21e 3232 name, numargs, op_name[type]);
79072805
LW		 3233 op_free(kid);
3234 kid = newop;
3235 kid->op_sibling = sibl;
3236 *tokid = kid;
3237 }
8990e307
LW		 3238 else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
3239 bad_type(numargs, "array", op, kid);
a0d0e21e 3240 mod(kid, type);
79072805
LW		 3241 break;
3242 case OA_HVREF:
3243 if (kid->op_type == OP_CONST &&
3244 (kid->op_private & OPpCONST_BARE)) {
463ee0b2 3245 char *name = SvPVx(((SVOP*)kid)->op_sv, na);
79072805 3246 OP *newop = newHVREF(newGVOP(OP_GV, 0,
85e6fe83 3247 gv_fetchpv(name, TRUE, SVt_PVHV) ));
463ee0b2
LW		 3248 if (dowarn)
3249 warn("Hash %%%s missing the %% in argument %d of %s()",
a0d0e21e 3250 name, numargs, op_name[type]);
79072805
LW		 3251 op_free(kid);
3252 kid = newop;
3253 kid->op_sibling = sibl;
3254 *tokid = kid;
3255 }
8990e307
LW		 3256 else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
3257 bad_type(numargs, "hash", op, kid);
a0d0e21e 3258 mod(kid, type);
79072805
LW		 3259 break;
3260 case OA_CVREF:
3261 {
a0d0e21e 3262 OP *newop = newUNOP(OP_NULL, 0, kid);
79072805
LW		 3263 kid->op_sibling = 0;
3264 linklist(kid);
3265 newop->op_next = newop;
3266 kid = newop;
3267 kid->op_sibling = sibl;
3268 *tokid = kid;
3269 }
3270 break;
3271 case OA_FILEREF:
3272 if (kid->op_type != OP_GV) {
3273 if (kid->op_type == OP_CONST &&
3274 (kid->op_private & OPpCONST_BARE)) {
3275 OP *newop = newGVOP(OP_GV, 0,
85e6fe83
LW		 3276 gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE,
3277 SVt_PVIO) );
79072805
LW		 3278 op_free(kid);
3279 kid = newop;
3280 }
3281 else {
3282 kid->op_sibling = 0;
3283 kid = newUNOP(OP_RV2GV, 0, scalar(kid));
3284 }
3285 kid->op_sibling = sibl;
3286 *tokid = kid;
3287 }
3288 scalar(kid);
3289 break;
3290 case OA_SCALARREF:
a0d0e21e 3291 mod(scalar(kid), type);
79072805
LW		 3292 break;
3293 }
3294 oa >>= 4;
3295 tokid = &kid->op_sibling;
3296 kid = kid->op_sibling;
3297 }
3298 op->op_private = numargs;
3299 if (kid)
3300 return too_many_arguments(op);
3301 listkids(op);
3302 }
a0d0e21e
LW		 3303 else if (opargs[type] & OA_DEFGV) {
3304 op_free(op);
3305 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3306 }
3307
79072805
LW		 3308 if (oa) {
3309 while (oa & OA_OPTIONAL)
3310 oa >>= 4;
3311 if (oa && oa != OA_LIST)
3312 return too_few_arguments(op);
3313 }
3314 return op;
3315}
3316
3317OP *
3318ck_glob(op)
3319OP *op;
3320{
a0d0e21e
LW		 3321 GV *gv = newGVgen("main");
3322 gv_IOadd(gv);
79072805
LW		 3323 append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
3324 scalarkids(op);
a0d0e21e 3325 return ck_fun(op);
79072805
LW		 3326}
3327
3328OP *
3329ck_grep(op)
3330OP *op;
3331{
3332 LOGOP *gwop;
3333 OP *kid;
a0d0e21e 3334 OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
79072805 3335
a0d0e21e
LW		 3336 op->op_ppaddr = ppaddr[OP_GREPSTART];
3337 Newz(1101, gwop, 1, LOGOP);
3338
93a17b20 3339 if (op->op_flags & OPf_STACKED) {
a0d0e21e 3340 OP* k;
93a17b20 3341 op = ck_sort(op);
a0d0e21e
LW		 3342 for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) {
3343 kid = k;
3344 }
3345 kid->op_next = (OP*)gwop;
93a17b20
LW		 3346 op->op_flags &= ~OPf_STACKED;
3347 }
a0d0e21e
LW		 3348 kid = cLISTOP->op_first->op_sibling;
3349 if (type == OP_MAPWHILE)
3350 list(kid);
3351 else
3352 scalar(kid);
79072805
LW		 3353 op = ck_fun(op);
3354 if (error_count)
3355 return op;
a0d0e21e 3356 kid = cLISTOP->op_first->op_sibling;
79072805 3357 if (kid->op_type != OP_NULL)
463ee0b2 3358 croak("panic: ck_grep");
79072805
LW		 3359 kid = kUNOP->op_first;
3360
a0d0e21e
LW		 3361 gwop->op_type = type;
3362 gwop->op_ppaddr = ppaddr[type];
3363 gwop->op_first = listkids(op);
79072805
LW		 3364 gwop->op_flags |= OPf_KIDS;
3365 gwop->op_private = 1;
3366 gwop->op_other = LINKLIST(kid);
a0d0e21e 3367 gwop->op_targ = pad_alloc(type, SVs_PADTMP);
79072805
LW		 3368 kid->op_next = (OP*)gwop;
3369
a0d0e21e
LW		 3370 kid = cLISTOP->op_first->op_sibling;
3371 if (!kid || !kid->op_sibling)
3372 return too_few_arguments(op);
3373 for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
3374 mod(kid, OP_GREPSTART);
3375
79072805
LW		 3376 return (OP*)gwop;
3377}
3378
3379OP *
3380ck_index(op)
3381OP *op;
3382{
3383 if (op->op_flags & OPf_KIDS) {
3384 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
3385 if (kid && kid->op_type == OP_CONST)
3386 fbm_compile(((SVOP*)kid)->op_sv, 0);
3387 }
3388 return ck_fun(op);
3389}
3390
3391OP *
3392ck_lengthconst(op)
3393OP *op;
3394{
3395 /* XXX length optimization goes here */
a0d0e21e 3396 return ck_fun(op);
79072805
LW		 3397}
3398
3399OP *
3400ck_lfun(op)
3401OP *op;
3402{
463ee0b2 3403 return modkids(ck_fun(op), op->op_type);
79072805
LW		 3404}
3405
3406OP *
8990e307
LW		 3407ck_rfun(op)
3408OP *op;
3409{
3410 return refkids(ck_fun(op), op->op_type);
3411}
3412
3413OP *
79072805
LW		 3414ck_listiob(op)
3415OP *op;
3416{
3417 register OP *kid;
3418
3419 kid = cLISTOP->op_first;
3420 if (!kid) {
8990e307 3421 op = force_list(op);
79072805
LW		 3422 kid = cLISTOP->op_first;
3423 }
3424 if (kid->op_type == OP_PUSHMARK)
3425 kid = kid->op_sibling;
3426 if (kid && op->op_flags & OPf_STACKED)
3427 kid = kid->op_sibling;
3428 else if (kid && !kid->op_sibling) { /* print HANDLE; */
3429 if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
3430 op->op_flags |= OPf_STACKED; /* make it a filehandle */
3431 kid = newUNOP(OP_RV2GV, 0, scalar(kid));
3432 cLISTOP->op_first->op_sibling = kid;
3433 cLISTOP->op_last = kid;
3434 kid = kid->op_sibling;
3435 }
3436 }
3437
3438 if (!kid)
3439 append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3440
3441 return listkids(op);
3442}
3443
3444OP *
3445ck_match(op)
3446OP *op;
3447{
3448 cPMOP->op_pmflags |= PMf_RUNTIME;
3449 return op;
3450}
3451
3452OP *
3453ck_null(op)
3454OP *op;
3455{
3456 return op;
3457}
3458
3459OP *
3460ck_repeat(op)
3461OP *op;
3462{
3463 if (cBINOP->op_first->op_flags & OPf_PARENS) {
3464 op->op_private = OPpREPEAT_DOLIST;
8990e307 3465 cBINOP->op_first = force_list(cBINOP->op_first);
79072805
LW		 3466 }
3467 else
3468 scalar(op);
3469 return op;
3470}
3471
3472OP *
8990e307
LW		 3473ck_require(op)
3474OP *op;
3475{
a0d0e21e 3476 if (op->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */
8990e307
LW		 3477 SVOP *kid = (SVOP*)cUNOP->op_first;
3478
3479 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
8990e307 3480 char *s;
a0d0e21e
LW		 3481 for (s = SvPVX(kid->op_sv); *s; s++) {
3482 if (*s == ':' && s[1] == ':') {
3483 *s = '/';
1aef975c 3484 Move(s+2, s+1, strlen(s+2)+1, char);
a0d0e21e
LW		 3485 --SvCUR(kid->op_sv);
3486 }
8990e307 3487 }
a0d0e21e 3488 sv_catpvn(kid->op_sv, ".pm", 3);
8990e307
LW		 3489 }
3490 }
3491 return ck_fun(op);
3492}
3493
3494OP *
79072805
LW		 3495ck_retarget(op)
3496OP *op;
3497{
463ee0b2 3498 croak("NOT IMPL LINE %d",__LINE__);
79072805
LW		 3499 /* STUB */
3500 return op;
3501}
3502
3503OP *
3504ck_select(op)
3505OP *op;
3506{
3507 if (op->op_flags & OPf_KIDS) {
3508 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
2304df62 3509 if (kid && kid->op_sibling) {
79072805
LW		 3510 op->op_type = OP_SSELECT;
3511 op->op_ppaddr = ppaddr[OP_SSELECT];
3512 op = ck_fun(op);
3513 return fold_constants(op);
3514 }
3515 }
3516 return ck_fun(op);
3517}
3518
3519OP *
3520ck_shift(op)
3521OP *op;
3522{
3523 I32 type = op->op_type;
3524
3525 if (!(op->op_flags & OPf_KIDS)) {
3526 op_free(op);
3527 return newUNOP(type, 0,
3528 scalar(newUNOP(OP_RV2AV, 0,
3529 scalar(newGVOP(OP_GV, 0,
85e6fe83 3530 gv_fetchpv((subline ? "_" : "ARGV"), TRUE, SVt_PVAV) )))));
79072805 3531 }
463ee0b2 3532 return scalar(modkids(ck_fun(op), type));
79072805
LW		 3533}
3534
3535OP *
3536ck_sort(op)
3537OP *op;
3538{
3539 if (op->op_flags & OPf_STACKED) {
3540 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
463ee0b2
LW		 3541 OP *k;
3542 kid = kUNOP->op_first; /* get past rv2gv */
79072805 3543
463ee0b2 3544 if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
79072805 3545 linklist(kid);
463ee0b2
LW		 3546 if (kid->op_type == OP_SCOPE) {
3547 k = kid->op_next;
3548 kid->op_next = 0;
79072805 3549 }
463ee0b2 3550 else if (kid->op_type == OP_LEAVE) {
8990e307 3551 null(kid); /* wipe out leave */
463ee0b2
LW		 3552 kid->op_next = kid;
3553
3554 for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
3555 if (k->op_next == kid)
3556 k->op_next = 0;
3557 }
a0d0e21e 3558 k = kLISTOP->op_first;
463ee0b2 3559 }
a0d0e21e
LW		 3560 peep(k);
3561
463ee0b2 3562 kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
8990e307 3563 null(kid); /* wipe out rv2gv */
a0d0e21e
LW		 3564 if (op->op_type == OP_SORT)
3565 kid->op_next = kid;
3566 else
3567 kid->op_next = k;
79072805
LW		 3568 op->op_flags |= OPf_SPECIAL;
3569 }
3570 }
3571 return op;
3572}
3573
3574OP *
3575ck_split(op)
3576OP *op;
3577{
3578 register OP *kid;
ed6116ce 3579 PMOP* pm;
79072805
LW		 3580
3581 if (op->op_flags & OPf_STACKED)
3582 return no_fh_allowed(op);
3583
79072805 3584 kid = cLISTOP->op_first;
8990e307 3585 if (kid->op_type != OP_NULL)
463ee0b2 3586 croak("panic: ck_split");
8990e307
LW		 3587 kid = kid->op_sibling;
3588 op_free(cLISTOP->op_first);
3589 cLISTOP->op_first = kid;
85e6fe83 3590 if (!kid) {
8990e307 3591 cLISTOP->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
85e6fe83
LW		 3592 cLISTOP->op_last = kid; /* There was only one element previously */
3593 }
79072805
LW		 3594
3595 if (kid->op_type != OP_MATCH) {
3596 OP *sibl = kid->op_sibling;
463ee0b2 3597 kid->op_sibling = 0;
79072805
LW		 3598 kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
3599 if (cLISTOP->op_first == cLISTOP->op_last)
3600 cLISTOP->op_last = kid;
3601 cLISTOP->op_first = kid;
3602 kid->op_sibling = sibl;
3603 }
ed6116ce
LW		 3604 pm = (PMOP*)kid;
3605 if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
8990e307 3606 SvREFCNT_dec(pm->op_pmshort); /* can't use substring to optimize */
ed6116ce
LW		 3607 pm->op_pmshort = 0;
3608 }
79072805
LW		 3609
3610 kid->op_type = OP_PUSHRE;
3611 kid->op_ppaddr = ppaddr[OP_PUSHRE];
3612 scalar(kid);
3613
3614 if (!kid->op_sibling)
3615 append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3616
3617 kid = kid->op_sibling;
3618 scalar(kid);
3619
3620 if (!kid->op_sibling)
3621 append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0)));
3622
3623 kid = kid->op_sibling;
3624 scalar(kid);
3625
3626 if (kid->op_sibling)
3627 return too_many_arguments(op);
3628
3629 return op;
3630}
3631
3632OP *
3633ck_subr(op)
3634OP *op;
3635{
93a17b20
LW		 3636 OP *o = ((cUNOP->op_first->op_sibling)
3637 ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first->op_sibling;
3638
8990e307
LW		 3639 if (o->op_type == OP_RV2CV)
3640 null(o); /* disable rv2cv */
85e6fe83 3641 op->op_private = (hints & HINT_STRICT_REFS);
8990e307 3642 if (perldb && curstash != debstash)
85e6fe83 3643 op->op_private |= OPpDEREF_DB;
a0d0e21e
LW		 3644 while (o = o->op_sibling)
3645 mod(o, OP_ENTERSUB);
79072805
LW		 3646 return op;
3647}
3648
3649OP *
8990e307
LW		 3650ck_svconst(op)
3651OP *op;
3652{
3653 SvREADONLY_on(cSVOP->op_sv);
3654 return op;
3655}
3656
3657OP *
79072805
LW		 3658ck_trunc(op)
3659OP *op;
3660{
3661 if (op->op_flags & OPf_KIDS) {
3662 SVOP *kid = (SVOP*)cUNOP->op_first;
3663
a0d0e21e
LW		 3664 if (kid->op_type == OP_NULL)
3665 kid = (SVOP*)kid->op_sibling;
3666 if (kid &&
3667 kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
79072805
LW		 3668 op->op_flags |= OPf_SPECIAL;
3669 }
3670 return ck_fun(op);
3671}
3672
463ee0b2
LW		 3673/* A peephole optimizer. We visit the ops in the order they're to execute. */
3674
79072805 3675void
a0d0e21e
LW		 3676peep(o)
3677register OP* o;
79072805
LW		 3678{
3679 register OP* oldop = 0;
a0d0e21e 3680 if (!o || o->op_seq)
79072805 3681 return;
a0d0e21e
LW		 3682 ENTER;
3683 SAVESPTR(op);
3684 SAVESPTR(curcop);
3685 for (; o; o = o->op_next) {
3686 if (o->op_seq)
3687 break;
3688 op = o;
3689 switch (o->op_type) {
3690 case OP_NEXTSTATE:
3691 case OP_DBSTATE:
3692 curcop = ((COP*)o); /* for warnings */
3693 break;
3694
3695 case OP_CONCAT:
3696 case OP_CONST:
3697 case OP_JOIN:
3698 case OP_UC:
3699 case OP_UCFIRST:
3700 case OP_LC:
3701 case OP_LCFIRST:
3702 case OP_QUOTEMETA:
3703 if (o->op_next->op_type == OP_STRINGIFY)
3704 null(o->op_next);
3705 o->op_seq = ++op_seqmax;
3706 break;
8990e307 3707 case OP_STUB:
a0d0e21e
LW		 3708 if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) {
3709 o->op_seq = ++op_seqmax;
8990e307
LW		 3710 break; /* Scalar stub must produce undef. List stub is noop */
3711 }
3712 /* FALL THROUGH */
79072805
LW		 3713 case OP_NULL:
3714 case OP_SCALAR:
93a17b20 3715 case OP_LINESEQ:
463ee0b2 3716 case OP_SCOPE:
a0d0e21e
LW		 3717 if (oldop && o->op_next) {
3718 oldop->op_next = o->op_next;
79072805
LW		 3719 continue;
3720 }
a0d0e21e 3721 o->op_seq = ++op_seqmax;
79072805
LW		 3722 break;
3723
3724 case OP_GV:
a0d0e21e
LW		 3725 if (o->op_next->op_type == OP_RV2SV) {
3726 if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) {
3727 null(o->op_next);
3728 o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
3729 o->op_next = o->op_next->op_next;
3730 o->op_type = OP_GVSV;
3731 o->op_ppaddr = ppaddr[OP_GVSV];
8990e307
LW		 3732 }
3733 }
a0d0e21e
LW		 3734 else if (o->op_next->op_type == OP_RV2AV) {
3735 OP* pop = o->op_next->op_next;
3736 IV i;
8990e307 3737 if (pop->op_type == OP_CONST &&
a0d0e21e 3738 (op = pop->op_next) &&
8990e307 3739 pop->op_next->op_type == OP_AELEM &&
a0d0e21e
LW		 3740 !(pop->op_next->op_private &
3741 (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) &&
3742 (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
3743 <= 255 &&
8990e307
LW		 3744 i >= 0)
3745 {
a0d0e21e 3746 null(o->op_next);
8990e307
LW		 3747 null(pop->op_next);
3748 null(pop);
a0d0e21e
LW		 3749 o->op_flags |= pop->op_next->op_flags & OPf_MOD;
3750 o->op_next = pop->op_next->op_next;
3751 o->op_type = OP_AELEMFAST;
3752 o->op_ppaddr = ppaddr[OP_AELEMFAST];
3753 o->op_private = (U8)i;
3754 GvAVn((GV*)(((SVOP*)o)->op_sv));
8990e307 3755 }
79072805 3756 }
a0d0e21e 3757 o->op_seq = ++op_seqmax;
79072805
LW		 3758 break;
3759
a0d0e21e 3760 case OP_MAPWHILE:
79072805
LW		 3761 case OP_GREPWHILE:
3762 case OP_AND:
3763 case OP_OR:
a0d0e21e 3764 o->op_seq = ++op_seqmax;
79072805
LW		 3765 peep(cLOGOP->op_other);
3766 break;
3767
3768 case OP_COND_EXPR:
a0d0e21e 3769 o->op_seq = ++op_seqmax;
79072805
LW		 3770 peep(cCONDOP->op_true);
3771 peep(cCONDOP->op_false);
3772 break;
3773
3774 case OP_ENTERLOOP:
a0d0e21e 3775 o->op_seq = ++op_seqmax;
79072805
LW		 3776 peep(cLOOP->op_redoop);
3777 peep(cLOOP->op_nextop);
3778 peep(cLOOP->op_lastop);
3779 break;
3780
3781 case OP_MATCH:
3782 case OP_SUBST:
a0d0e21e
LW		 3783 o->op_seq = ++op_seqmax;
3784 peep(cPMOP->op_pmreplstart);
79072805
LW		 3785 break;
3786
a0d0e21e
LW		 3787 case OP_EXEC:
3788 o->op_seq = ++op_seqmax;
3789 if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
3790 if (o->op_next->op_sibling &&
3791 o->op_next->op_sibling->op_type != OP_DIE) {
3792 line_t oldline = curcop->cop_line;
3793
3794 curcop->cop_line = ((COP*)o->op_next)->cop_line;
3795 warn("Statement unlikely to be reached");
3796 warn("(Maybe you meant system() when you said exec()?)\n");
3797 curcop->cop_line = oldline;
3798 }
3799 }
3800 break;
79072805 3801 default:
a0d0e21e 3802 o->op_seq = ++op_seqmax;
79072805
LW		 3803 break;
3804 }
a0d0e21e 3805 oldop = o;
79072805 3806 }
a0d0e21e 3807 LEAVE;
79072805 3808}
Unnamed repository; edit this file 'description' to name the repository.