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