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