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