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.1m 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);
2176 SV *sv = svp[curop->op_targ];;
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++) {
a0d0e21e 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;
8990e307
LW		 2237 }
2238 min_intro_pending = 0;
2239 comppad_name_fill = max_intro_pending; /* Needn't search higher */
2240 }
93a17b20 2241
79072805 2242 Newz(1101, cop, 1, COP);
8990e307
LW		 2243 if (perldb && curcop->cop_line && curstash != debstash) {
2244 cop->op_type = OP_DBSTATE;
2245 cop->op_ppaddr = ppaddr[ OP_DBSTATE ];
2246 }
2247 else {
2248 cop->op_type = OP_NEXTSTATE;
2249 cop->op_ppaddr = ppaddr[ OP_NEXTSTATE ];
2250 }
79072805
LW		 2251 cop->op_flags = flags;
2252 cop->op_private = 0;
2253 cop->op_next = (OP*)cop;
2254
463ee0b2
LW		 2255 if (label) {
2256 cop->cop_label = label;
85e6fe83 2257 hints |= HINT_BLOCK_SCOPE;
463ee0b2
LW		 2258 }
2259 cop->cop_seq = cop_seqmax++;
a0d0e21e 2260 cop->cop_arybase = curcop->cop_arybase;
79072805
LW		 2261
2262 if (copline == NOLINE)
2263 cop->cop_line = curcop->cop_line;
2264 else {
2265 cop->cop_line = copline;
2266 copline = NOLINE;
2267 }
8990e307 2268 cop->cop_filegv = SvREFCNT_inc(curcop->cop_filegv);
79072805
LW		 2269 cop->cop_stash = curstash;
2270
8990e307 2271 if (perldb && curstash != debstash) {
93a17b20
LW		 2272 SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE);
2273 if (svp && *svp != &sv_undef && !SvIOK(*svp)) {
463ee0b2 2274 SvIVX(*svp) = 1;
a0d0e21e 2275 (void)SvIOK_on(*svp);
93a17b20
LW		 2276 SvSTASH(*svp) = (HV*)cop;
2277 }
2278 }
2279
79072805
LW		 2280 return prepend_elem(OP_LINESEQ, (OP*)cop, op);
2281}
2282
2283OP *
2284newLOGOP(type, flags, first, other)
2285I32 type;
2286I32 flags;
2287OP* first;
2288OP* other;
2289{
2290 LOGOP *logop;
2291 OP *op;
2292
a0d0e21e
LW		 2293 if (type == OP_XOR) /* Not short circuit, but here by precedence. */
2294 return newBINOP(type, flags, scalar(first), scalar(other));
2295
8990e307 2296 scalarboolean(first);
79072805
LW		 2297 /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
2298 if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) {
2299 if (type == OP_AND || type == OP_OR) {
2300 if (type == OP_AND)
2301 type = OP_OR;
2302 else
2303 type = OP_AND;
2304 op = first;
2305 first = cUNOP->op_first;
2306 if (op->op_next)
2307 first->op_next = op->op_next;
2308 cUNOP->op_first = Nullop;
2309 op_free(op);
2310 }
2311 }
2312 if (first->op_type == OP_CONST) {
93a17b20
LW		 2313 if (dowarn && (first->op_private & OPpCONST_BARE))
2314 warn("Probable precedence problem on %s", op_name[type]);
79072805
LW		 2315 if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
2316 op_free(first);
2317 return other;
2318 }
2319 else {
2320 op_free(other);
2321 return first;
2322 }
2323 }
2324 else if (first->op_type == OP_WANTARRAY) {
2325 if (type == OP_AND)
2326 list(other);
2327 else
2328 scalar(other);
2329 }
2330
2331 if (!other)
2332 return first;
2333
a0d0e21e
LW		 2334 if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
2335 other->op_private |= OPpASSIGN_BACKWARDS; /* other is an OP_SASSIGN */
2336
79072805
LW		 2337 Newz(1101, logop, 1, LOGOP);
2338
2339 logop->op_type = type;
2340 logop->op_ppaddr = ppaddr[type];
2341 logop->op_first = first;
2342 logop->op_flags = flags | OPf_KIDS;
2343 logop->op_other = LINKLIST(other);
2344 logop->op_private = 1;
2345
2346 /* establish postfix order */
2347 logop->op_next = LINKLIST(first);
2348 first->op_next = (OP*)logop;
2349 first->op_sibling = other;
2350
2351 op = newUNOP(OP_NULL, 0, (OP*)logop);
2352 other->op_next = op;
2353
2354 return op;
2355}
2356
2357OP *
2358newCONDOP(flags, first, true, false)
2359I32 flags;
2360OP* first;
2361OP* true;
2362OP* false;
2363{
2364 CONDOP *condop;
2365 OP *op;
2366
2367 if (!false)
2368 return newLOGOP(OP_AND, 0, first, true);
463ee0b2
LW		 2369 if (!true)
2370 return newLOGOP(OP_OR, 0, first, false);
79072805 2371
8990e307 2372 scalarboolean(first);
79072805
LW		 2373 if (first->op_type == OP_CONST) {
2374 if (SvTRUE(((SVOP*)first)->op_sv)) {
2375 op_free(first);
2376 op_free(false);
2377 return true;
2378 }
2379 else {
2380 op_free(first);
2381 op_free(true);
2382 return false;
2383 }
2384 }
2385 else if (first->op_type == OP_WANTARRAY) {
2386 list(true);
2387 scalar(false);
2388 }
2389 Newz(1101, condop, 1, CONDOP);
2390
2391 condop->op_type = OP_COND_EXPR;
2392 condop->op_ppaddr = ppaddr[OP_COND_EXPR];
2393 condop->op_first = first;
2394 condop->op_flags = flags | OPf_KIDS;
2395 condop->op_true = LINKLIST(true);
2396 condop->op_false = LINKLIST(false);
2397 condop->op_private = 1;
2398
2399 /* establish postfix order */
2400 condop->op_next = LINKLIST(first);
2401 first->op_next = (OP*)condop;
2402
2403 first->op_sibling = true;
2404 true->op_sibling = false;
2405 op = newUNOP(OP_NULL, 0, (OP*)condop);
2406
2407 true->op_next = op;
2408 false->op_next = op;
2409
2410 return op;
2411}
2412
2413OP *
2414newRANGE(flags, left, right)
2415I32 flags;
2416OP *left;
2417OP *right;
2418{
2419 CONDOP *condop;
2420 OP *flip;
2421 OP *flop;
2422 OP *op;
2423
2424 Newz(1101, condop, 1, CONDOP);
2425
2426 condop->op_type = OP_RANGE;
2427 condop->op_ppaddr = ppaddr[OP_RANGE];
2428 condop->op_first = left;
2429 condop->op_flags = OPf_KIDS;
2430 condop->op_true = LINKLIST(left);
2431 condop->op_false = LINKLIST(right);
2432 condop->op_private = 1;
2433
2434 left->op_sibling = right;
2435
2436 condop->op_next = (OP*)condop;
2437 flip = newUNOP(OP_FLIP, flags, (OP*)condop);
2438 flop = newUNOP(OP_FLOP, 0, flip);
2439 op = newUNOP(OP_NULL, 0, flop);
2440 linklist(flop);
2441
2442 left->op_next = flip;
2443 right->op_next = flop;
2444
ed6116ce 2445 condop->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
79072805 2446 sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV);
ed6116ce 2447 flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
79072805
LW		 2448 sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
2449
2450 flip->op_private = left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
2451 flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
2452
2453 flip->op_next = op;
2454 if (!flip->op_private || !flop->op_private)
2455 linklist(op); /* blow off optimizer unless constant */
2456
2457 return op;
2458}
2459
2460OP *
2461newLOOPOP(flags, debuggable, expr, block)
2462I32 flags;
2463I32 debuggable;
2464OP *expr;
2465OP *block;
2466{
463ee0b2 2467 OP* listop;
93a17b20 2468 OP* op;
463ee0b2 2469 int once = block && block->op_flags & OPf_SPECIAL &&
a0d0e21e 2470 (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
93a17b20 2471
463ee0b2
LW		 2472 if (expr) {
2473 if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
2474 return block; /* do {} while 0 does once */
2475 else if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)
a0d0e21e 2476 expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr);
463ee0b2 2477 }
93a17b20 2478
8990e307 2479 listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
93a17b20 2480 op = newLOGOP(OP_AND, 0, expr, listop);
463ee0b2 2481
79072805
LW		 2482 ((LISTOP*)listop)->op_last->op_next = LINKLIST(op);
2483
463ee0b2 2484 if (once && op != listop)
79072805
LW		 2485 op->op_next = ((LOGOP*)cUNOP->op_first)->op_other;
2486
748a9306
LW		 2487 if (op == listop)
2488 op = newUNOP(OP_NULL, 0, op); /* or do {} while 1 loses outer block */
2489
79072805 2490 op->op_flags |= flags;
a0d0e21e 2491 op = scope(op);
748a9306 2492 op->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/
a0d0e21e 2493 return op;
79072805
LW		 2494}
2495
2496OP *
2497newWHILEOP(flags, debuggable, loop, expr, block, cont)
2498I32 flags;
2499I32 debuggable;
2500LOOP *loop;
2501OP *expr;
2502OP *block;
2503OP *cont;
2504{
2505 OP *redo;
2506 OP *next = 0;
2507 OP *listop;
2508 OP *op;
2509 OP *condop;
2510
748a9306
LW		 2511 if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) {
2512 expr = newUNOP(OP_DEFINED, 0,
2513 newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
2514 }
79072805
LW		 2515
2516 if (!block)
2517 block = newOP(OP_NULL, 0);
2518
2519 if (cont)
2520 next = LINKLIST(cont);
2521 if (expr)
2522 cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
2523
463ee0b2 2524 listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
79072805
LW		 2525 redo = LINKLIST(listop);
2526
2527 if (expr) {
2528 op = newLOGOP(OP_AND, 0, expr, scalar(listop));
85e6fe83
LW		 2529 if (op == expr && op->op_type == OP_CONST && !SvTRUE(cSVOP->op_sv)) {
2530 op_free(expr); /* oops, it's a while (0) */
463ee0b2
LW		 2531 op_free((OP*)loop);
2532 return Nullop; /* (listop already freed by newLOGOP) */
2533 }
79072805
LW		 2534 ((LISTOP*)listop)->op_last->op_next = condop =
2535 (op == listop ? redo : LINKLIST(op));
2536 if (!next)
2537 next = condop;
2538 }
2539 else
2540 op = listop;
2541
2542 if (!loop) {
2543 Newz(1101,loop,1,LOOP);
2544 loop->op_type = OP_ENTERLOOP;
2545 loop->op_ppaddr = ppaddr[OP_ENTERLOOP];
2546 loop->op_private = 0;
2547 loop->op_next = (OP*)loop;
2548 }
2549
463ee0b2 2550 op = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, op);
79072805
LW		 2551
2552 loop->op_redoop = redo;
2553 loop->op_lastop = op;
2554
2555 if (next)
2556 loop->op_nextop = next;
2557 else
2558 loop->op_nextop = op;
2559
2560 op->op_flags |= flags;
2561 return op;
2562}
2563
2564OP *
a0d0e21e 2565#ifndef CAN_PROTOTYPE
79072805
LW		 2566newFOROP(flags,label,forline,sv,expr,block,cont)
2567I32 flags;
2568char *label;
2569line_t forline;
2570OP* sv;
2571OP* expr;
2572OP*block;
2573OP*cont;
8990e307
LW		 2574#else
2575newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
a0d0e21e 2576#endif /* CAN_PROTOTYPE */
79072805
LW		 2577{
2578 LOOP *loop;
85e6fe83 2579 int padoff = 0;
79072805
LW		 2580
2581 copline = forline;
2582 if (sv) {
85e6fe83 2583 if (sv->op_type == OP_RV2SV) { /* symbol table variable */
748a9306
LW		 2584 sv->op_type = OP_RV2GV;
2585 sv->op_ppaddr = ppaddr[OP_RV2GV];
79072805 2586 }
85e6fe83
LW		 2587 else if (sv->op_type == OP_PADSV) { /* private variable */
2588 padoff = sv->op_targ;
2589 op_free(sv);
2590 sv = Nullop;
2591 }
79072805 2592 else
463ee0b2 2593 croak("Can't use %s for loop variable", op_name[sv->op_type]);
79072805
LW		 2594 }
2595 else {
2596 sv = newGVOP(OP_GV, 0, defgv);
2597 }
2598 loop = (LOOP*)list(convert(OP_ENTERITER, 0,
a0d0e21e
LW		 2599 append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART),
2600 scalar(sv))));
85e6fe83
LW		 2601 assert(!loop->op_next);
2602 Renew(loop, 1, LOOP);
2603 loop->op_targ = padoff;
2604 return newSTATEOP(0, label, newWHILEOP(flags, 1, loop,
2605 newOP(OP_ITER, 0), block, cont));
79072805
LW		 2606}
2607
8990e307
LW		 2608OP*
2609newLOOPEX(type, label)
2610I32 type;
2611OP* label;
2612{
2613 OP *op;
2614 if (type != OP_GOTO || label->op_type == OP_CONST) {
a0d0e21e
LW		 2615 op = newPVOP(type, 0, savepv(
2616 label->op_type == OP_CONST
2617 ? SvPVx(((SVOP*)label)->op_sv, na)
2618 : "" ));
8990e307
LW		 2619 op_free(label);
2620 }
2621 else {
a0d0e21e
LW		 2622 if (label->op_type == OP_ENTERSUB)
2623 label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
8990e307
LW		 2624 op = newUNOP(type, OPf_STACKED, label);
2625 }
85e6fe83 2626 hints |= HINT_BLOCK_SCOPE;
8990e307
LW		 2627 return op;
2628}
2629
79072805 2630void
85e6fe83 2631cv_undef(cv)
79072805
LW		 2632CV *cv;
2633{
a0d0e21e
LW		 2634 if (!CvXSUB(cv) && CvROOT(cv)) {
2635 if (CvDEPTH(cv))
2636 croak("Can't undef active subroutine");
8990e307 2637 ENTER;
a0d0e21e
LW		 2638
2639 SAVESPTR(curpad);
2640 curpad = 0;
2641
4aa0a1f7 2642 if (!(SvFLAGS(cv) & SVpcv_CLONED))
748a9306 2643 op_free(CvROOT(cv));
79072805 2644 CvROOT(cv) = Nullop;
79072805
LW		 2645 if (CvPADLIST(cv)) {
2646 I32 i = AvFILL(CvPADLIST(cv));
a0d0e21e 2647 while (i >= 0) {
79072805
LW		 2648 SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
2649 if (svp)
a0d0e21e 2650 SvREFCNT_dec(*svp);
79072805 2651 }
a0d0e21e 2652 SvREFCNT_dec((SV*)CvPADLIST(cv));
748a9306 2653 CvPADLIST(cv) = Nullav;
79072805 2654 }
8990e307 2655 SvREFCNT_dec(CvGV(cv));
748a9306 2656 CvGV(cv) = Nullgv;
e9a444f0
LW		 2657 SvREFCNT_dec(CvOUTSIDE(cv));
2658 CvOUTSIDE(cv) = Nullcv;
8990e307 2659 LEAVE;
79072805 2660 }
79072805
LW		 2661}
2662
a0d0e21e 2663CV *
748a9306
LW		 2664cv_clone(proto)
2665CV* proto;
2666{
2667 AV* av;
2668 I32 ix;
2669 AV* protopadlist = CvPADLIST(proto);
2670 AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
2671 AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
2672 SV** svp = AvARRAY(protopad);
2673 AV* comppadlist;
2674 CV* cv;
2675
2676 ENTER;
2677 SAVESPTR(curpad);
2678 SAVESPTR(comppad);
2679 SAVESPTR(compcv);
2680
2681 cv = compcv = (CV*)NEWSV(1104,0);
2682 sv_upgrade((SV *)cv, SVt_PVCV);
2683 SvFLAGS(cv) |= SVpcv_CLONED;
2684
2685 CvFILEGV(cv) = CvFILEGV(proto);
2686 CvGV(cv) = SvREFCNT_inc(CvGV(proto));
2687 CvSTASH(cv) = CvSTASH(proto);
2688 CvROOT(cv) = CvROOT(proto);
2689 CvSTART(cv) = CvSTART(proto);
e9a444f0
LW		 2690 if (CvOUTSIDE(proto))
2691 CvOUTSIDE(cv) = (CV*)SvREFCNT_inc((SV*)CvOUTSIDE(proto));
748a9306
LW		 2692
2693 comppad = newAV();
2694
2695 comppadlist = newAV();
2696 AvREAL_off(comppadlist);
2697 av_store(comppadlist, 0, SvREFCNT_inc((SV*)protopad_name));
b355b4e0 2698 av_store(comppadlist, 1, (SV*)comppad);
748a9306
LW		 2699 CvPADLIST(cv) = comppadlist;
2700 av_extend(comppad, AvFILL(protopad));
2701 curpad = AvARRAY(comppad);
2702
2703 av = newAV(); /* will be @_ */
2704 av_extend(av, 0);
2705 av_store(comppad, 0, (SV*)av);
2706 AvFLAGS(av) = AVf_REIFY;
2707
2708 svp = AvARRAY(protopad_name);
2709 for ( ix = AvFILL(protopad); ix > 0; ix--) {
2710 SV *sv;
2711 if (svp[ix] != &sv_undef) {
2712 char *name = SvPVX(svp[ix]); /* XXX */
2713 if (SvFLAGS(svp[ix]) & SVf_FAKE) { /* lexical from outside? */
2714 I32 off = pad_findlex(name,ix,curcop->cop_seq, CvOUTSIDE(proto), cxstack_ix);
2715 if (off != ix)
2716 croak("panic: cv_clone: %s", name);
2717 }
2718 else { /* our own lexical */
2719 if (*name == '@')
2720 av_store(comppad, ix, sv = (SV*)newAV());
2721 else if (*name == '%')
2722 av_store(comppad, ix, sv = (SV*)newHV());
2723 else
2724 av_store(comppad, ix, sv = NEWSV(0,0));
2725 SvPADMY_on(sv);
2726 }
2727 }
2728 else {
2729 av_store(comppad, ix, sv = NEWSV(0,0));
2730 SvPADTMP_on(sv);
2731 }
2732 }
2733
2734 LEAVE;
2735 return cv;
2736}
2737
2738CV *
79072805
LW		 2739newSUB(floor,op,block)
2740I32 floor;
2741OP *op;
2742OP *block;
2743{
2744 register CV *cv;
a0d0e21e
LW		 2745 char *name = op ? SvPVx(cSVOP->op_sv, na) : "__ANON__";
2746 GV *gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV);
79072805 2747 AV* av;
8990e307 2748 char *s;
a0d0e21e 2749 I32 ix;
79072805 2750
a0d0e21e
LW		 2751 if (op)
2752 sub_generation++;
2753 if (cv = GvCV(gv)) {
2754 if (GvCVGEN(gv))
2755 cv = 0; /* just a cached method */
748a9306
LW		 2756 else if (CvROOT(cv) || CvXSUB(cv) || GvFLAGS(gv) & GVf_IMPORTED) {
2757 if (dowarn) { /* already defined (or promised)? */
79072805
LW		 2758 line_t oldline = curcop->cop_line;
2759
2760 curcop->cop_line = copline;
2761 warn("Subroutine %s redefined",name);
2762 curcop->cop_line = oldline;
2763 }
8990e307 2764 SvREFCNT_dec(cv);
a0d0e21e 2765 cv = 0;
79072805
LW		 2766 }
2767 }
a0d0e21e 2768 if (cv) { /* must reuse cv if autoloaded */
748a9306
LW		 2769 if (CvGV(cv)) {
2770 assert(SvREFCNT(CvGV(cv)) > 1);
2771 SvREFCNT_dec(CvGV(cv));
2772 }
2773 CvOUTSIDE(cv) = CvOUTSIDE(compcv);
e9a444f0 2774 CvOUTSIDE(compcv) = 0;
748a9306 2775 CvPADLIST(cv) = CvPADLIST(compcv);
4aa0a1f7 2776 CvPADLIST(compcv) = 0;
748a9306 2777 SvREFCNT_dec(compcv);
a0d0e21e
LW		 2778 }
2779 else {
748a9306 2780 cv = compcv;
a0d0e21e 2781 }
79072805 2782 GvCV(gv) = cv;
463ee0b2 2783 GvCVGEN(gv) = 0;
79072805 2784 CvFILEGV(cv) = curcop->cop_filegv;
8990e307
LW		 2785 CvGV(cv) = SvREFCNT_inc(gv);
2786 CvSTASH(cv) = curstash;
2787
a0d0e21e
LW		 2788 if (!block) {
2789 CvROOT(cv) = 0;
2790 op_free(op);
2791 copline = NOLINE;
2792 LEAVE_SCOPE(floor);
2793 return cv;
2794 }
2795
2796 av = newAV(); /* Will be @_ */
2797 av_extend(av, 0);
8990e307 2798 av_store(comppad, 0, (SV*)av);
a0d0e21e
LW		 2799 AvFLAGS(av) = AVf_REIFY;
2800
2801 for (ix = AvFILL(comppad); ix > 0; ix--) {
2802 if (!SvPADMY(curpad[ix]))
2803 SvPADTMP_on(curpad[ix]);
2804 }
79072805 2805
8990e307
LW		 2806 if (AvFILL(comppad_name) < AvFILL(comppad))
2807 av_store(comppad_name, AvFILL(comppad), Nullsv);
79072805 2808
a0d0e21e 2809 CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
79072805
LW		 2810 CvSTART(cv) = LINKLIST(CvROOT(cv));
2811 CvROOT(cv)->op_next = 0;
2812 peep(CvSTART(cv));
8990e307
LW		 2813 if (s = strrchr(name,':'))
2814 s++;
2815 else
2816 s = name;
2817 if (strEQ(s, "BEGIN")) {
2818 line_t oldline = compiling.cop_line;
93a17b20 2819
8990e307
LW		 2820 ENTER;
2821 SAVESPTR(compiling.cop_filegv);
2822 SAVEI32(perldb);
93a17b20
LW		 2823 if (!beginav)
2824 beginav = newAV();
85e6fe83 2825 av_push(beginav, (SV *)cv);
93a17b20
LW		 2826 DEBUG_x( dump_sub(gv) );
2827 rs = nrs;
2828 rslen = nrslen;
2829 rschar = nrschar;
2830 rspara = (nrslen == 2);
8990e307 2831 GvCV(gv) = 0;
93a17b20 2832 calllist(beginav);
93a17b20
LW		 2833 rs = "\n";
2834 rslen = 1;
2835 rschar = '\n';
2836 rspara = 0;
93a17b20 2837 curcop = &compiling;
8990e307
LW		 2838 curcop->cop_line = oldline; /* might have recursed to yylex */
2839 LEAVE;
93a17b20 2840 }
8990e307 2841 else if (strEQ(s, "END")) {
93a17b20
LW		 2842 if (!endav)
2843 endav = newAV();
2844 av_unshift(endav, 1);
8990e307 2845 av_store(endav, 0, SvREFCNT_inc(cv));
93a17b20 2846 }
8990e307 2847 if (perldb && curstash != debstash) {
79072805 2848 SV *sv;
8990e307 2849 SV *tmpstr = sv_newmortal();
79072805 2850
a0d0e21e 2851 sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
79072805
LW		 2852 sv = newSVpv(buf,0);
2853 sv_catpv(sv,"-");
2854 sprintf(buf,"%ld",(long)curcop->cop_line);
2855 sv_catpv(sv,buf);
2856 gv_efullname(tmpstr,gv);
463ee0b2 2857 hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
79072805
LW		 2858 }
2859 op_free(op);
2860 copline = NOLINE;
8990e307 2861 LEAVE_SCOPE(floor);
748a9306 2862 if (!op) {
a0d0e21e 2863 GvCV(gv) = 0; /* Will remember in SVOP instead. */
748a9306
LW		 2864 SvFLAGS(cv) |= SVpcv_ANON;
2865 }
a0d0e21e 2866 return cv;
79072805
LW		 2867}
2868
a0d0e21e
LW		 2869#ifdef DEPRECATED
2870CV *
463ee0b2 2871newXSUB(name, ix, subaddr, filename)
79072805
LW		 2872char *name;
2873I32 ix;
2874I32 (*subaddr)();
2875char *filename;
2876{
a0d0e21e
LW		 2877 CV* cv = newXS(name, (void(*)())subaddr, filename);
2878 CvOLDSTYLE(cv) = TRUE;
2879 CvXSUBANY(cv).any_i32 = ix;
2880 return cv;
2881}
2882#endif
2883
2884CV *
2885newXS(name, subaddr, filename)
2886char *name;
2887void (*subaddr) _((CV*));
2888char *filename;
2889{
79072805 2890 register CV *cv;
a0d0e21e 2891 GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV);
8990e307 2892 char *s;
79072805 2893
a0d0e21e
LW		 2894 if (name)
2895 sub_generation++;
2896 if (cv = GvCV(gv)) {
2897 if (GvCVGEN(gv))
2898 cv = 0; /* just a cached method */
748a9306 2899 else if (CvROOT(cv) || CvXSUB(cv)) { /* already defined? */
a0d0e21e
LW		 2900 if (dowarn) {
2901 line_t oldline = curcop->cop_line;
2902
2903 curcop->cop_line = copline;
2904 warn("Subroutine %s redefined",name);
2905 curcop->cop_line = oldline;
2906 }
2907 SvREFCNT_dec(cv);
2908 cv = 0;
79072805 2909 }
79072805 2910 }
a0d0e21e
LW		 2911 if (cv) { /* must reuse cv if autoloaded */
2912 assert(SvREFCNT(CvGV(cv)) > 1);
2913 SvREFCNT_dec(CvGV(cv));
2914 }
2915 else {
2916 cv = (CV*)NEWSV(1105,0);
2917 sv_upgrade((SV *)cv, SVt_PVCV);
2918 }
79072805 2919 GvCV(gv) = cv;
8990e307 2920 CvGV(cv) = SvREFCNT_inc(gv);
463ee0b2 2921 GvCVGEN(gv) = 0;
79072805 2922 CvFILEGV(cv) = gv_fetchfile(filename);
a0d0e21e
LW		 2923 CvXSUB(cv) = subaddr;
2924 if (!name)
2925 s = "__ANON__";
2926 else if (s = strrchr(name,':'))
8990e307
LW		 2927 s++;
2928 else
2929 s = name;
2930 if (strEQ(s, "BEGIN")) {
93a17b20
LW		 2931 if (!beginav)
2932 beginav = newAV();
8990e307 2933 av_push(beginav, SvREFCNT_inc(gv));
93a17b20 2934 }
8990e307 2935 else if (strEQ(s, "END")) {
93a17b20
LW		 2936 if (!endav)
2937 endav = newAV();
2938 av_unshift(endav, 1);
8990e307 2939 av_store(endav, 0, SvREFCNT_inc(gv));
93a17b20 2940 }
748a9306 2941 if (!name) {
a0d0e21e 2942 GvCV(gv) = 0; /* Will remember elsewhere instead. */
748a9306
LW		 2943 SvFLAGS(cv) |= SVpcv_ANON;
2944 }
a0d0e21e 2945 return cv;
79072805
LW		 2946}
2947
2948void
2949newFORM(floor,op,block)
2950I32 floor;
2951OP *op;
2952OP *block;
2953{
2954 register CV *cv;
2955 char *name;
2956 GV *gv;
2957 AV* av;
a0d0e21e 2958 I32 ix;
79072805
LW		 2959
2960 if (op)
463ee0b2 2961 name = SvPVx(cSVOP->op_sv, na);
79072805
LW		 2962 else
2963 name = "STDOUT";
85e6fe83 2964 gv = gv_fetchpv(name,TRUE, SVt_PVFM);
a0d0e21e 2965 SvMULTI_on(gv);
79072805
LW		 2966 if (cv = GvFORM(gv)) {
2967 if (dowarn) {
2968 line_t oldline = curcop->cop_line;
2969
2970 curcop->cop_line = copline;
2971 warn("Format %s redefined",name);
2972 curcop->cop_line = oldline;
2973 }
8990e307 2974 SvREFCNT_dec(cv);
79072805 2975 }
748a9306 2976 cv = compcv;
79072805 2977 GvFORM(gv) = cv;
8990e307 2978 CvGV(cv) = SvREFCNT_inc(gv);
79072805
LW		 2979 CvFILEGV(cv) = curcop->cop_filegv;
2980
a0d0e21e
LW		 2981 for (ix = AvFILL(comppad); ix > 0; ix--) {
2982 if (!SvPADMY(curpad[ix]))
2983 SvPADTMP_on(curpad[ix]);
2984 }
2985
79072805
LW		 2986 CvPADLIST(cv) = av = newAV();
2987 AvREAL_off(av);
a0d0e21e 2988 av_store(av, 1, SvREFCNT_inc((SV*)comppad));
79072805
LW		 2989 AvFILL(av) = 1;
2990
2991 CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
2992 CvSTART(cv) = LINKLIST(CvROOT(cv));
2993 CvROOT(cv)->op_next = 0;
2994 peep(CvSTART(cv));
79072805
LW		 2995 FmLINES(cv) = 0;
2996 op_free(op);
2997 copline = NOLINE;
8990e307 2998 LEAVE_SCOPE(floor);
79072805
LW		 2999}
3000
3001OP *
3002newMETHOD(ref,name)
3003OP *ref;
3004OP *name;
3005{
3006 LOGOP* mop;
3007 Newz(1101, mop, 1, LOGOP);
3008 mop->op_type = OP_METHOD;
3009 mop->op_ppaddr = ppaddr[OP_METHOD];
3010 mop->op_first = scalar(ref);
3011 mop->op_flags |= OPf_KIDS;
3012 mop->op_private = 1;
3013 mop->op_other = LINKLIST(name);
ed6116ce 3014 mop->op_targ = pad_alloc(OP_METHOD, SVs_PADTMP);
79072805
LW		 3015 mop->op_next = LINKLIST(ref);
3016 ref->op_next = (OP*)mop;
8990e307 3017 return scalar((OP*)mop);
79072805
LW		 3018}
3019
3020OP *
3021newANONLIST(op)
3022OP* op;
3023{
93a17b20 3024 return newUNOP(OP_REFGEN, 0,
a0d0e21e 3025 mod(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN));
79072805
LW		 3026}
3027
3028OP *
3029newANONHASH(op)
3030OP* op;
3031{
93a17b20 3032 return newUNOP(OP_REFGEN, 0,
a0d0e21e
LW		 3033 mod(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN));
3034}
3035
3036OP *
3037newANONSUB(floor, block)
3038I32 floor;
3039OP *block;
3040{
3041 return newUNOP(OP_REFGEN, 0,
3042 newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, block)));
79072805
LW		 3043}
3044
3045OP *
3046oopsAV(o)
3047OP *o;
3048{
ed6116ce
LW		 3049 switch (o->op_type) {
3050 case OP_PADSV:
3051 o->op_type = OP_PADAV;
3052 o->op_ppaddr = ppaddr[OP_PADAV];
3053 return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV);
3054
3055 case OP_RV2SV:
79072805
LW		 3056 o->op_type = OP_RV2AV;
3057 o->op_ppaddr = ppaddr[OP_RV2AV];
3058 ref(o, OP_RV2AV);
ed6116ce
LW		 3059 break;
3060
3061 default:
79072805 3062 warn("oops: oopsAV");
ed6116ce
LW		 3063 break;
3064 }
79072805
LW		 3065 return o;
3066}
3067
3068OP *
3069oopsHV(o)
3070OP *o;
3071{
ed6116ce
LW		 3072 switch (o->op_type) {
3073 case OP_PADSV:
3074 case OP_PADAV:
3075 o->op_type = OP_PADHV;
3076 o->op_ppaddr = ppaddr[OP_PADHV];
3077 return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV);
3078
3079 case OP_RV2SV:
3080 case OP_RV2AV:
79072805
LW		 3081 o->op_type = OP_RV2HV;
3082 o->op_ppaddr = ppaddr[OP_RV2HV];
3083 ref(o, OP_RV2HV);
ed6116ce
LW		 3084 break;
3085
3086 default:
79072805 3087 warn("oops: oopsHV");
ed6116ce
LW		 3088 break;
3089 }
79072805
LW		 3090 return o;
3091}
3092
3093OP *
3094newAVREF(o)
3095OP *o;
3096{
ed6116ce
LW		 3097 if (o->op_type == OP_PADANY) {
3098 o->op_type = OP_PADAV;
3099 o->op_ppaddr = ppaddr[OP_PADAV];
93a17b20 3100 return o;
ed6116ce 3101 }
79072805
LW		 3102 return newUNOP(OP_RV2AV, 0, scalar(o));
3103}
3104
3105OP *
a0d0e21e
LW		 3106newGVREF(type,o)
3107I32 type;
79072805
LW		 3108OP *o;
3109{
a0d0e21e
LW		 3110 if (type == OP_MAPSTART)
3111 return newUNOP(OP_NULL, 0, o);
748a9306 3112 return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
79072805
LW		 3113}
3114
3115OP *
3116newHVREF(o)
3117OP *o;
3118{
ed6116ce
LW		 3119 if (o->op_type == OP_PADANY) {
3120 o->op_type = OP_PADHV;
3121 o->op_ppaddr = ppaddr[OP_PADHV];
93a17b20 3122 return o;
ed6116ce 3123 }
79072805
LW		 3124 return newUNOP(OP_RV2HV, 0, scalar(o));
3125}
3126
3127OP *
3128oopsCV(o)
3129OP *o;
3130{
463ee0b2 3131 croak("NOT IMPL LINE %d",__LINE__);
79072805
LW		 3132 /* STUB */
3133 return o;
3134}
3135
3136OP *
3137newCVREF(o)
3138OP *o;
3139{
3140 return newUNOP(OP_RV2CV, 0, scalar(o));
3141}
3142
3143OP *
3144newSVREF(o)
3145OP *o;
3146{
ed6116ce
LW		 3147 if (o->op_type == OP_PADANY) {
3148 o->op_type = OP_PADSV;
3149 o->op_ppaddr = ppaddr[OP_PADSV];
93a17b20 3150 return o;
ed6116ce 3151 }
79072805
LW		 3152 return newUNOP(OP_RV2SV, 0, scalar(o));
3153}
3154
3155/* Check routines. */
3156
3157OP *
79072805
LW		 3158ck_concat(op)
3159OP *op;
3160{
3161 if (cUNOP->op_first->op_type == OP_CONCAT)
3162 op->op_flags |= OPf_STACKED;
3163 return op;
3164}
3165
3166OP *
a0d0e21e 3167ck_spair(op)
79072805
LW		 3168OP *op;
3169{
3170 if (op->op_flags & OPf_KIDS) {
3171 OP* newop;
a0d0e21e 3172 OP* kid;
463ee0b2 3173 op = modkids(ck_fun(op), op->op_type);
a0d0e21e
LW		 3174 kid = cUNOP->op_first;
3175 newop = kUNOP->op_first->op_sibling;
3176 if (newop &&
3177 (newop->op_sibling ||
3178 !(opargs[newop->op_type] & OA_RETSCALAR) ||
3179 newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
3180 newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
3181
79072805 3182 return op;
a0d0e21e
LW		 3183 }
3184 op_free(kUNOP->op_first);
3185 kUNOP->op_first = newop;
3186 }
3187 op->op_ppaddr = ppaddr[++op->op_type];
3188 return ck_fun(op);
3189}
3190
3191OP *
3192ck_delete(op)
3193OP *op;
3194{
3195 op = ck_fun(op);
3196 if (op->op_flags & OPf_KIDS) {
3197 OP *kid = cUNOP->op_first;
3198 if (kid->op_type != OP_HELEM)
3199 croak("%s argument is not a HASH element", op_name[op->op_type]);
3200 null(kid);
79072805 3201 }
79072805
LW		 3202 return op;
3203}
3204
3205OP *
3206ck_eof(op)
3207OP *op;
3208{
3209 I32 type = op->op_type;
3210
8990e307
LW		 3211 if (op->op_flags & OPf_KIDS) {
3212 if (cLISTOP->op_first->op_type == OP_STUB) {
3213 op_free(op);
3214 op = newUNOP(type, OPf_SPECIAL,
85e6fe83 3215 newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV)));
8990e307 3216 }
79072805 3217 return ck_fun(op);
79072805
LW		 3218 }
3219 return op;
3220}
3221
3222OP *
3223ck_eval(op)
3224OP *op;
3225{
85e6fe83 3226 hints |= HINT_BLOCK_SCOPE;
79072805
LW		 3227 if (op->op_flags & OPf_KIDS) {
3228 SVOP *kid = (SVOP*)cUNOP->op_first;
3229
93a17b20
LW		 3230 if (!kid) {
3231 op->op_flags &= ~OPf_KIDS;
8990e307 3232 null(op);
79072805
LW		 3233 }
3234 else if (kid->op_type == OP_LINESEQ) {
3235 LOGOP *enter;
3236
3237 kid->op_next = op->op_next;
3238 cUNOP->op_first = 0;
3239 op_free(op);
3240
3241 Newz(1101, enter, 1, LOGOP);
3242 enter->op_type = OP_ENTERTRY;
3243 enter->op_ppaddr = ppaddr[OP_ENTERTRY];
3244 enter->op_private = 0;
3245
3246 /* establish postfix order */
3247 enter->op_next = (OP*)enter;
3248
463ee0b2 3249 op = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
79072805
LW		 3250 op->op_type = OP_LEAVETRY;
3251 op->op_ppaddr = ppaddr[OP_LEAVETRY];
3252 enter->op_other = op;
3253 return op;
3254 }
3255 }
3256 else {
3257 op_free(op);
3258 op = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3259 }
a0d0e21e 3260 op->op_targ = (PADOFFSET)hints;
79072805
LW		 3261 return op;
3262}
3263
3264OP *
3265ck_exec(op)
3266OP *op;
3267{
3268 OP *kid;
79072805 3269 if (op->op_flags & OPf_STACKED) {
463ee0b2 3270 op = ck_fun(op);
79072805 3271 kid = cUNOP->op_first->op_sibling;
8990e307
LW		 3272 if (kid->op_type == OP_RV2GV)
3273 null(kid);
79072805 3274 }
463ee0b2
LW		 3275 else
3276 op = listkids(op);
79072805
LW		 3277 return op;
3278}
3279
3280OP *
3281ck_gvconst(o)
3282register OP *o;
3283{
3284 o = fold_constants(o);
3285 if (o->op_type == OP_CONST)
3286 o->op_type = OP_GV;
3287 return o;
3288}
3289
3290OP *
3291ck_rvconst(op)
3292register OP *op;
3293{
3294 SVOP *kid = (SVOP*)cUNOP->op_first;
85e6fe83 3295
a0d0e21e 3296 op->op_private = (hints & HINT_STRICT_REFS);
79072805 3297 if (kid->op_type == OP_CONST) {
748a9306 3298 int iscv = (op->op_type==OP_RV2CV)*2;
a0d0e21e 3299 GV *gv = 0;
79072805 3300 kid->op_type = OP_GV;
a0d0e21e 3301 for (gv = 0; !gv; iscv++) {
748a9306
LW		 3302 /*
3303 * This is a little tricky. We only want to add the symbol if we
3304 * didn't add it in the lexer. Otherwise we get duplicate strict
3305 * warnings. But if we didn't add it in the lexer, we must at
3306 * least pretend like we wanted to add it even if it existed before,
3307 * or we get possible typo warnings. OPpCONST_ENTERED says
3308 * whether the lexer already added THIS instance of this symbol.
3309 */
a0d0e21e 3310 gv = gv_fetchpv(SvPVx(kid->op_sv, na),
748a9306 3311 iscv | !(kid->op_private & OPpCONST_ENTERED),
a0d0e21e
LW		 3312 iscv
3313 ? SVt_PVCV
3314 : op->op_type == OP_RV2SV
3315 ? SVt_PV
3316 : op->op_type == OP_RV2AV
3317 ? SVt_PVAV
3318 : op->op_type == OP_RV2HV
3319 ? SVt_PVHV
3320 : SVt_PVGV);
3321 }
adbc6bb1 3322 SvREFCNT_dec(kid->op_sv);
a0d0e21e 3323 kid->op_sv = SvREFCNT_inc(gv);
79072805
LW		 3324 }
3325 return op;
3326}
3327
3328OP *
3329ck_formline(op)
3330OP *op;
3331{
3332 return ck_fun(op);
3333}
3334
3335OP *
3336ck_ftst(op)
3337OP *op;
3338{
3339 I32 type = op->op_type;
3340
a0d0e21e 3341 if (op->op_flags & OPf_REF)
79072805
LW		 3342 return op;
3343
3344 if (op->op_flags & OPf_KIDS) {
3345 SVOP *kid = (SVOP*)cUNOP->op_first;
3346
3347 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
a0d0e21e 3348 OP *newop = newGVOP(type, OPf_REF,
85e6fe83 3349 gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
79072805
LW		 3350 op_free(op);
3351 return newop;
3352 }
3353 }
3354 else {
3355 op_free(op);
3356 if (type == OP_FTTTY)
a0d0e21e 3357 return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
85e6fe83 3358 SVt_PVIO));
79072805
LW		 3359 else
3360 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3361 }
3362 return op;
3363}
3364
3365OP *
3366ck_fun(op)
3367OP *op;
3368{
3369 register OP *kid;
3370 OP **tokid;
3371 OP *sibl;
3372 I32 numargs = 0;
a0d0e21e
LW		 3373 int type = op->op_type;
3374 register I32 oa = opargs[type] >> OASHIFT;
79072805
LW		 3375
3376 if (op->op_flags & OPf_STACKED) {
3377 if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
3378 oa &= ~OA_OPTIONAL;
3379 else
3380 return no_fh_allowed(op);
3381 }
3382
3383 if (op->op_flags & OPf_KIDS) {
3384 tokid = &cLISTOP->op_first;
3385 kid = cLISTOP->op_first;
8990e307
LW		 3386 if (kid->op_type == OP_PUSHMARK ||
3387 kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
3388 {
79072805
LW		 3389 tokid = &kid->op_sibling;
3390 kid = kid->op_sibling;
3391 }
a0d0e21e
LW		 3392 if (!kid && opargs[type] & OA_DEFGV)
3393 *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
79072805
LW		 3394
3395 while (oa && kid) {
3396 numargs++;
3397 sibl = kid->op_sibling;
3398 switch (oa & 7) {
3399 case OA_SCALAR:
3400 scalar(kid);
3401 break;
3402 case OA_LIST:
3403 if (oa < 16) {
3404 kid = 0;
3405 continue;
3406 }
3407 else
3408 list(kid);
3409 break;
3410 case OA_AVREF:
3411 if (kid->op_type == OP_CONST &&
3412 (kid->op_private & OPpCONST_BARE)) {
463ee0b2 3413 char *name = SvPVx(((SVOP*)kid)->op_sv, na);
79072805 3414 OP *newop = newAVREF(newGVOP(OP_GV, 0,
85e6fe83 3415 gv_fetchpv(name, TRUE, SVt_PVAV) ));
463ee0b2
LW		 3416 if (dowarn)
3417 warn("Array @%s missing the @ in argument %d of %s()",
a0d0e21e 3418 name, numargs, op_name[type]);
79072805
LW		 3419 op_free(kid);
3420 kid = newop;
3421 kid->op_sibling = sibl;
3422 *tokid = kid;
3423 }
8990e307
LW		 3424 else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
3425 bad_type(numargs, "array", op, kid);
a0d0e21e 3426 mod(kid, type);
79072805
LW		 3427 break;
3428 case OA_HVREF:
3429 if (kid->op_type == OP_CONST &&
3430 (kid->op_private & OPpCONST_BARE)) {
463ee0b2 3431 char *name = SvPVx(((SVOP*)kid)->op_sv, na);
79072805 3432 OP *newop = newHVREF(newGVOP(OP_GV, 0,
85e6fe83 3433 gv_fetchpv(name, TRUE, SVt_PVHV) ));
463ee0b2
LW		 3434 if (dowarn)
3435 warn("Hash %%%s missing the %% in argument %d of %s()",
a0d0e21e 3436 name, numargs, op_name[type]);
79072805
LW		 3437 op_free(kid);
3438 kid = newop;
3439 kid->op_sibling = sibl;
3440 *tokid = kid;
3441 }
8990e307
LW		 3442 else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
3443 bad_type(numargs, "hash", op, kid);
a0d0e21e 3444 mod(kid, type);
79072805
LW		 3445 break;
3446 case OA_CVREF:
3447 {
a0d0e21e 3448 OP *newop = newUNOP(OP_NULL, 0, kid);
79072805
LW		 3449 kid->op_sibling = 0;
3450 linklist(kid);
3451 newop->op_next = newop;
3452 kid = newop;
3453 kid->op_sibling = sibl;
3454 *tokid = kid;
3455 }
3456 break;
3457 case OA_FILEREF:
3458 if (kid->op_type != OP_GV) {
3459 if (kid->op_type == OP_CONST &&
3460 (kid->op_private & OPpCONST_BARE)) {
3461 OP *newop = newGVOP(OP_GV, 0,
85e6fe83
LW		 3462 gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE,
3463 SVt_PVIO) );
79072805
LW		 3464 op_free(kid);
3465 kid = newop;
3466 }
3467 else {
3468 kid->op_sibling = 0;
3469 kid = newUNOP(OP_RV2GV, 0, scalar(kid));
3470 }
3471 kid->op_sibling = sibl;
3472 *tokid = kid;
3473 }
3474 scalar(kid);
3475 break;
3476 case OA_SCALARREF:
a0d0e21e 3477 mod(scalar(kid), type);
79072805
LW		 3478 break;
3479 }
3480 oa >>= 4;
3481 tokid = &kid->op_sibling;
3482 kid = kid->op_sibling;
3483 }
3484 op->op_private = numargs;
3485 if (kid)
3486 return too_many_arguments(op);
3487 listkids(op);
3488 }
a0d0e21e
LW		 3489 else if (opargs[type] & OA_DEFGV) {
3490 op_free(op);
3491 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3492 }
3493
79072805
LW		 3494 if (oa) {
3495 while (oa & OA_OPTIONAL)
3496 oa >>= 4;
3497 if (oa && oa != OA_LIST)
3498 return too_few_arguments(op);
3499 }
3500 return op;
3501}
3502
3503OP *
3504ck_glob(op)
3505OP *op;
3506{
a0d0e21e
LW		 3507 GV *gv = newGVgen("main");
3508 gv_IOadd(gv);
79072805
LW		 3509 append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
3510 scalarkids(op);
a0d0e21e 3511 return ck_fun(op);
79072805
LW		 3512}
3513
3514OP *
3515ck_grep(op)
3516OP *op;
3517{
3518 LOGOP *gwop;
3519 OP *kid;
a0d0e21e 3520 OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
79072805 3521
a0d0e21e
LW		 3522 op->op_ppaddr = ppaddr[OP_GREPSTART];
3523 Newz(1101, gwop, 1, LOGOP);
3524
93a17b20 3525 if (op->op_flags & OPf_STACKED) {
a0d0e21e 3526 OP* k;
93a17b20 3527 op = ck_sort(op);
a0d0e21e
LW		 3528 for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) {
3529 kid = k;
3530 }
3531 kid->op_next = (OP*)gwop;
93a17b20
LW		 3532 op->op_flags &= ~OPf_STACKED;
3533 }
a0d0e21e
LW		 3534 kid = cLISTOP->op_first->op_sibling;
3535 if (type == OP_MAPWHILE)
3536 list(kid);
3537 else
3538 scalar(kid);
79072805
LW		 3539 op = ck_fun(op);
3540 if (error_count)
3541 return op;
a0d0e21e 3542 kid = cLISTOP->op_first->op_sibling;
79072805 3543 if (kid->op_type != OP_NULL)
463ee0b2 3544 croak("panic: ck_grep");
79072805
LW		 3545 kid = kUNOP->op_first;
3546
a0d0e21e
LW		 3547 gwop->op_type = type;
3548 gwop->op_ppaddr = ppaddr[type];
3549 gwop->op_first = listkids(op);
79072805
LW		 3550 gwop->op_flags |= OPf_KIDS;
3551 gwop->op_private = 1;
3552 gwop->op_other = LINKLIST(kid);
a0d0e21e 3553 gwop->op_targ = pad_alloc(type, SVs_PADTMP);
79072805
LW		 3554 kid->op_next = (OP*)gwop;
3555
a0d0e21e
LW		 3556 kid = cLISTOP->op_first->op_sibling;
3557 if (!kid || !kid->op_sibling)
3558 return too_few_arguments(op);
3559 for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
3560 mod(kid, OP_GREPSTART);
3561
79072805
LW		 3562 return (OP*)gwop;
3563}
3564
3565OP *
3566ck_index(op)
3567OP *op;
3568{
3569 if (op->op_flags & OPf_KIDS) {
3570 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
3571 if (kid && kid->op_type == OP_CONST)
3572 fbm_compile(((SVOP*)kid)->op_sv, 0);
3573 }
3574 return ck_fun(op);
3575}
3576
3577OP *
3578ck_lengthconst(op)
3579OP *op;
3580{
3581 /* XXX length optimization goes here */
a0d0e21e 3582 return ck_fun(op);
79072805
LW		 3583}
3584
3585OP *
3586ck_lfun(op)
3587OP *op;
3588{
463ee0b2 3589 return modkids(ck_fun(op), op->op_type);
79072805
LW		 3590}
3591
3592OP *
8990e307
LW		 3593ck_rfun(op)
3594OP *op;
3595{
3596 return refkids(ck_fun(op), op->op_type);
3597}
3598
3599OP *
79072805
LW		 3600ck_listiob(op)
3601OP *op;
3602{
3603 register OP *kid;
3604
3605 kid = cLISTOP->op_first;
3606 if (!kid) {
8990e307 3607 op = force_list(op);
79072805
LW		 3608 kid = cLISTOP->op_first;
3609 }
3610 if (kid->op_type == OP_PUSHMARK)
3611 kid = kid->op_sibling;
3612 if (kid && op->op_flags & OPf_STACKED)
3613 kid = kid->op_sibling;
3614 else if (kid && !kid->op_sibling) { /* print HANDLE; */
3615 if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
3616 op->op_flags |= OPf_STACKED; /* make it a filehandle */
748a9306 3617 kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
79072805
LW		 3618 cLISTOP->op_first->op_sibling = kid;
3619 cLISTOP->op_last = kid;
3620 kid = kid->op_sibling;
3621 }
3622 }
3623
3624 if (!kid)
3625 append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3626
3627 return listkids(op);
3628}
3629
3630OP *
3631ck_match(op)
3632OP *op;
3633{
3634 cPMOP->op_pmflags |= PMf_RUNTIME;
3635 return op;
3636}
3637
3638OP *
3639ck_null(op)
3640OP *op;
3641{
3642 return op;
3643}
3644
3645OP *
3646ck_repeat(op)
3647OP *op;
3648{
3649 if (cBINOP->op_first->op_flags & OPf_PARENS) {
3650 op->op_private = OPpREPEAT_DOLIST;
8990e307 3651 cBINOP->op_first = force_list(cBINOP->op_first);
79072805
LW		 3652 }
3653 else
3654 scalar(op);
3655 return op;
3656}
3657
3658OP *
8990e307
LW		 3659ck_require(op)
3660OP *op;
3661{
a0d0e21e 3662 if (op->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */
8990e307
LW		 3663 SVOP *kid = (SVOP*)cUNOP->op_first;
3664
3665 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
8990e307 3666 char *s;
a0d0e21e
LW		 3667 for (s = SvPVX(kid->op_sv); *s; s++) {
3668 if (*s == ':' && s[1] == ':') {
3669 *s = '/';
1aef975c 3670 Move(s+2, s+1, strlen(s+2)+1, char);
a0d0e21e
LW		 3671 --SvCUR(kid->op_sv);
3672 }
8990e307 3673 }
a0d0e21e 3674 sv_catpvn(kid->op_sv, ".pm", 3);
8990e307
LW		 3675 }
3676 }
3677 return ck_fun(op);
3678}
3679
3680OP *
79072805
LW		 3681ck_retarget(op)
3682OP *op;
3683{
463ee0b2 3684 croak("NOT IMPL LINE %d",__LINE__);
79072805
LW		 3685 /* STUB */
3686 return op;
3687}
3688
3689OP *
3690ck_select(op)
3691OP *op;
3692{
3693 if (op->op_flags & OPf_KIDS) {
3694 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
2304df62 3695 if (kid && kid->op_sibling) {
79072805
LW		 3696 op->op_type = OP_SSELECT;
3697 op->op_ppaddr = ppaddr[OP_SSELECT];
3698 op = ck_fun(op);
3699 return fold_constants(op);
3700 }
3701 }
3702 return ck_fun(op);
3703}
3704
3705OP *
3706ck_shift(op)
3707OP *op;
3708{
3709 I32 type = op->op_type;
3710
3711 if (!(op->op_flags & OPf_KIDS)) {
3712 op_free(op);
3713 return newUNOP(type, 0,
3714 scalar(newUNOP(OP_RV2AV, 0,
3715 scalar(newGVOP(OP_GV, 0,
85e6fe83 3716 gv_fetchpv((subline ? "_" : "ARGV"), TRUE, SVt_PVAV) )))));
79072805 3717 }
463ee0b2 3718 return scalar(modkids(ck_fun(op), type));
79072805
LW		 3719}
3720
3721OP *
3722ck_sort(op)
3723OP *op;
3724{
3725 if (op->op_flags & OPf_STACKED) {
3726 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
463ee0b2
LW		 3727 OP *k;
3728 kid = kUNOP->op_first; /* get past rv2gv */
79072805 3729
463ee0b2 3730 if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
79072805 3731 linklist(kid);
463ee0b2
LW		 3732 if (kid->op_type == OP_SCOPE) {
3733 k = kid->op_next;
3734 kid->op_next = 0;
79072805 3735 }
463ee0b2 3736 else if (kid->op_type == OP_LEAVE) {
748a9306
LW		 3737 if (op->op_type == OP_SORT) {
3738 null(kid); /* wipe out leave */
3739 kid->op_next = kid;
463ee0b2 3740
748a9306
LW		 3741 for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
3742 if (k->op_next == kid)
3743 k->op_next = 0;
3744 }
463ee0b2 3745 }
748a9306
LW		 3746 else
3747 kid->op_next = 0; /* just disconnect the leave */
a0d0e21e 3748 k = kLISTOP->op_first;
463ee0b2 3749 }
a0d0e21e
LW		 3750 peep(k);
3751
463ee0b2 3752 kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
8990e307 3753 null(kid); /* wipe out rv2gv */
a0d0e21e
LW		 3754 if (op->op_type == OP_SORT)
3755 kid->op_next = kid;
3756 else
3757 kid->op_next = k;
79072805
LW		 3758 op->op_flags |= OPf_SPECIAL;
3759 }
3760 }
3761 return op;
3762}
3763
3764OP *
3765ck_split(op)
3766OP *op;
3767{
3768 register OP *kid;
ed6116ce 3769 PMOP* pm;
79072805
LW		 3770
3771 if (op->op_flags & OPf_STACKED)
3772 return no_fh_allowed(op);
3773
79072805 3774 kid = cLISTOP->op_first;
8990e307 3775 if (kid->op_type != OP_NULL)
463ee0b2 3776 croak("panic: ck_split");
8990e307
LW		 3777 kid = kid->op_sibling;
3778 op_free(cLISTOP->op_first);
3779 cLISTOP->op_first = kid;
85e6fe83 3780 if (!kid) {
8990e307 3781 cLISTOP->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
85e6fe83
LW		 3782 cLISTOP->op_last = kid; /* There was only one element previously */
3783 }
79072805
LW		 3784
3785 if (kid->op_type != OP_MATCH) {
3786 OP *sibl = kid->op_sibling;
463ee0b2 3787 kid->op_sibling = 0;
79072805
LW		 3788 kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
3789 if (cLISTOP->op_first == cLISTOP->op_last)
3790 cLISTOP->op_last = kid;
3791 cLISTOP->op_first = kid;
3792 kid->op_sibling = sibl;
3793 }
ed6116ce
LW		 3794 pm = (PMOP*)kid;
3795 if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
8990e307 3796 SvREFCNT_dec(pm->op_pmshort); /* can't use substring to optimize */
ed6116ce
LW		 3797 pm->op_pmshort = 0;
3798 }
79072805
LW		 3799
3800 kid->op_type = OP_PUSHRE;
3801 kid->op_ppaddr = ppaddr[OP_PUSHRE];
3802 scalar(kid);
3803
3804 if (!kid->op_sibling)
3805 append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3806
3807 kid = kid->op_sibling;
3808 scalar(kid);
3809
3810 if (!kid->op_sibling)
3811 append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0)));
3812
3813 kid = kid->op_sibling;
3814 scalar(kid);
3815
3816 if (kid->op_sibling)
3817 return too_many_arguments(op);
3818
3819 return op;
3820}
3821
3822OP *
3823ck_subr(op)
3824OP *op;
3825{
93a17b20
LW		 3826 OP *o = ((cUNOP->op_first->op_sibling)
3827 ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first->op_sibling;
3828
8990e307
LW		 3829 if (o->op_type == OP_RV2CV)
3830 null(o); /* disable rv2cv */
85e6fe83 3831 op->op_private = (hints & HINT_STRICT_REFS);
8990e307 3832 if (perldb && curstash != debstash)
85e6fe83 3833 op->op_private |= OPpDEREF_DB;
a0d0e21e
LW		 3834 while (o = o->op_sibling)
3835 mod(o, OP_ENTERSUB);
79072805
LW		 3836 return op;
3837}
3838
3839OP *
8990e307
LW		 3840ck_svconst(op)
3841OP *op;
3842{
3843 SvREADONLY_on(cSVOP->op_sv);
3844 return op;
3845}
3846
3847OP *
79072805
LW		 3848ck_trunc(op)
3849OP *op;
3850{
3851 if (op->op_flags & OPf_KIDS) {
3852 SVOP *kid = (SVOP*)cUNOP->op_first;
3853
a0d0e21e
LW		 3854 if (kid->op_type == OP_NULL)
3855 kid = (SVOP*)kid->op_sibling;
3856 if (kid &&
3857 kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
79072805
LW		 3858 op->op_flags |= OPf_SPECIAL;
3859 }
3860 return ck_fun(op);
3861}
3862
463ee0b2
LW		 3863/* A peephole optimizer. We visit the ops in the order they're to execute. */
3864
79072805 3865void
a0d0e21e
LW		 3866peep(o)
3867register OP* o;
79072805
LW		 3868{
3869 register OP* oldop = 0;
a0d0e21e 3870 if (!o || o->op_seq)
79072805 3871 return;
a0d0e21e
LW		 3872 ENTER;
3873 SAVESPTR(op);
3874 SAVESPTR(curcop);
3875 for (; o; o = o->op_next) {
3876 if (o->op_seq)
3877 break;
3878 op = o;
3879 switch (o->op_type) {
3880 case OP_NEXTSTATE:
3881 case OP_DBSTATE:
3882 curcop = ((COP*)o); /* for warnings */
748a9306 3883 o->op_seq = ++op_seqmax;
a0d0e21e
LW		 3884 break;
3885
3886 case OP_CONCAT:
3887 case OP_CONST:
3888 case OP_JOIN:
3889 case OP_UC:
3890 case OP_UCFIRST:
3891 case OP_LC:
3892 case OP_LCFIRST:
3893 case OP_QUOTEMETA:
3894 if (o->op_next->op_type == OP_STRINGIFY)
3895 null(o->op_next);
3896 o->op_seq = ++op_seqmax;
3897 break;
8990e307 3898 case OP_STUB:
a0d0e21e
LW		 3899 if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) {
3900 o->op_seq = ++op_seqmax;
8990e307
LW		 3901 break; /* Scalar stub must produce undef. List stub is noop */
3902 }
748a9306 3903 goto nothin;
79072805 3904 case OP_NULL:
748a9306
LW		 3905 if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
3906 curcop = ((COP*)op);
3907 goto nothin;
79072805 3908 case OP_SCALAR:
93a17b20 3909 case OP_LINESEQ:
463ee0b2 3910 case OP_SCOPE:
748a9306 3911 nothin:
a0d0e21e
LW		 3912 if (oldop && o->op_next) {
3913 oldop->op_next = o->op_next;
79072805
LW		 3914 continue;
3915 }
a0d0e21e 3916 o->op_seq = ++op_seqmax;
79072805
LW		 3917 break;
3918
3919 case OP_GV:
a0d0e21e
LW		 3920 if (o->op_next->op_type == OP_RV2SV) {
3921 if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) {
3922 null(o->op_next);
3923 o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
3924 o->op_next = o->op_next->op_next;
3925 o->op_type = OP_GVSV;
3926 o->op_ppaddr = ppaddr[OP_GVSV];
8990e307
LW		 3927 }
3928 }
a0d0e21e
LW		 3929 else if (o->op_next->op_type == OP_RV2AV) {
3930 OP* pop = o->op_next->op_next;
3931 IV i;
8990e307 3932 if (pop->op_type == OP_CONST &&
a0d0e21e 3933 (op = pop->op_next) &&
8990e307 3934 pop->op_next->op_type == OP_AELEM &&
a0d0e21e
LW		 3935 !(pop->op_next->op_private &
3936 (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) &&
3937 (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
3938 <= 255 &&
8990e307
LW		 3939 i >= 0)
3940 {
748a9306 3941 SvREFCNT_dec(((SVOP*)pop)->op_sv);
a0d0e21e 3942 null(o->op_next);
8990e307
LW		 3943 null(pop->op_next);
3944 null(pop);
a0d0e21e
LW		 3945 o->op_flags |= pop->op_next->op_flags & OPf_MOD;
3946 o->op_next = pop->op_next->op_next;
3947 o->op_type = OP_AELEMFAST;
3948 o->op_ppaddr = ppaddr[OP_AELEMFAST];
3949 o->op_private = (U8)i;
3950 GvAVn((GV*)(((SVOP*)o)->op_sv));
8990e307 3951 }
79072805 3952 }
a0d0e21e 3953 o->op_seq = ++op_seqmax;
79072805
LW		 3954 break;
3955
a0d0e21e 3956 case OP_MAPWHILE:
79072805
LW		 3957 case OP_GREPWHILE:
3958 case OP_AND:
3959 case OP_OR:
a0d0e21e 3960 o->op_seq = ++op_seqmax;
79072805
LW		 3961 peep(cLOGOP->op_other);
3962 break;
3963
3964 case OP_COND_EXPR:
a0d0e21e 3965 o->op_seq = ++op_seqmax;
79072805
LW		 3966 peep(cCONDOP->op_true);
3967 peep(cCONDOP->op_false);
3968 break;
3969
3970 case OP_ENTERLOOP:
a0d0e21e 3971 o->op_seq = ++op_seqmax;
79072805
LW		 3972 peep(cLOOP->op_redoop);
3973 peep(cLOOP->op_nextop);
3974 peep(cLOOP->op_lastop);
3975 break;
3976
3977 case OP_MATCH:
3978 case OP_SUBST:
a0d0e21e
LW		 3979 o->op_seq = ++op_seqmax;
3980 peep(cPMOP->op_pmreplstart);
79072805
LW		 3981 break;
3982
a0d0e21e
LW		 3983 case OP_EXEC:
3984 o->op_seq = ++op_seqmax;
3985 if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
3986 if (o->op_next->op_sibling &&
3987 o->op_next->op_sibling->op_type != OP_DIE) {
3988 line_t oldline = curcop->cop_line;
3989
3990 curcop->cop_line = ((COP*)o->op_next)->cop_line;
3991 warn("Statement unlikely to be reached");
3992 warn("(Maybe you meant system() when you said exec()?)\n");
3993 curcop->cop_line = oldline;
3994 }
3995 }
3996 break;
79072805 3997 default:
a0d0e21e 3998 o->op_seq = ++op_seqmax;
79072805
LW		 3999 break;
4000 }
a0d0e21e 4001 oldop = o;
79072805 4002 }
a0d0e21e 4003 LEAVE;
79072805 4004}
Unnamed repository; edit this file 'description' to name the repository.