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
perl 5.002gamma: utils/h2xs.PL
[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;
6f45a1d4
CS		 1427 if ((o->op_type == OP_LT && curop == ((BINOP*)o)->op_first) ||
1428 (o->op_type == OP_GT && curop == ((BINOP*)o)->op_last))
1429 {
1430 /* Allow "$i < 100" and "100 > $i" to integerize */
1431 continue;
1432 }
c07a80fd 1433 }
79072805
LW		 1434 return o;
1435 }
a0d0e21e 1436 o->op_ppaddr = ppaddr[++(o->op_type)];
79072805
LW		 1437 }
1438
79072805
LW		 1439 return o;
1440}
1441
1442OP *
1443gen_constant_list(o)
1444register OP *o;
1445{
1446 register OP *curop;
79072805 1447 I32 oldtmps_floor = tmps_floor;
79072805 1448
a0d0e21e
LW		 1449 list(o);
1450 if (error_count)
1451 return o; /* Don't attempt to run with errors */
1452
1453 op = curop = LINKLIST(o);
1454 o->op_next = 0;
1455 pp_pushmark();
79072805 1456 run();
a0d0e21e
LW		 1457 op = curop;
1458 pp_anonlist();
79072805 1459 tmps_floor = oldtmps_floor;
79072805
LW		 1460
1461 o->op_type = OP_RV2AV;
1462 o->op_ppaddr = ppaddr[OP_RV2AV];
79072805 1463 curop = ((UNOP*)o)->op_first;
a0d0e21e 1464 ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*stack_sp--));
79072805 1465 op_free(curop);
79072805
LW		 1466 linklist(o);
1467 return list(o);
1468}
1469
1470OP *
1471convert(type, flags, op)
1472I32 type;
1473I32 flags;
1474OP* op;
1475{
1476 OP *kid;
a0d0e21e 1477 OP *last = 0;
79072805 1478
79072805
LW		 1479 if (!op || op->op_type != OP_LIST)
1480 op = newLISTOP(OP_LIST, 0, op, Nullop);
748a9306
LW		 1481 else
1482 op->op_flags &= ~(OPf_KNOW|OPf_LIST);
79072805 1483
8990e307
LW		 1484 if (!(opargs[type] & OA_MARK))
1485 null(cLISTOP->op_first);
1486
79072805
LW		 1487 op->op_type = type;
1488 op->op_ppaddr = ppaddr[type];
1489 op->op_flags |= flags;
1490
e50aee73 1491 op = CHECKOP(type, op);
79072805
LW		 1492 if (op->op_type != type)
1493 return op;
1494
1495 if (cLISTOP->op_children < 7) {
1496 /* XXX do we really need to do this if we're done appending?? */
1497 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
1498 last = kid;
1499 cLISTOP->op_last = last; /* in case check substituted last arg */
1500 }
1501
1502 return fold_constants(op);
1503}
1504
1505/* List constructors */
1506
1507OP *
1508append_elem(type, first, last)
1509I32 type;
1510OP* first;
1511OP* last;
1512{
1513 if (!first)
1514 return last;
8990e307
LW		 1515
1516 if (!last)
79072805 1517 return first;
8990e307 1518
a0d0e21e
LW		 1519 if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS)
1520 return newLISTOP(type, 0, first, last);
79072805 1521
a0d0e21e
LW		 1522 if (first->op_flags & OPf_KIDS)
1523 ((LISTOP*)first)->op_last->op_sibling = last;
1524 else {
1525 first->op_flags |= OPf_KIDS;
1526 ((LISTOP*)first)->op_first = last;
1527 }
1528 ((LISTOP*)first)->op_last = last;
1529 ((LISTOP*)first)->op_children++;
1530 return first;
79072805
LW		 1531}
1532
1533OP *
1534append_list(type, first, last)
1535I32 type;
1536LISTOP* first;
1537LISTOP* last;
1538{
1539 if (!first)
1540 return (OP*)last;
8990e307
LW		 1541
1542 if (!last)
79072805 1543 return (OP*)first;
8990e307
LW		 1544
1545 if (first->op_type != type)
79072805 1546 return prepend_elem(type, (OP*)first, (OP*)last);
8990e307
LW		 1547
1548 if (last->op_type != type)
79072805
LW		 1549 return append_elem(type, (OP*)first, (OP*)last);
1550
1551 first->op_last->op_sibling = last->op_first;
1552 first->op_last = last->op_last;
1553 first->op_children += last->op_children;
1554 if (first->op_children)
1555 last->op_flags |= OPf_KIDS;
1556
1557 Safefree(last);
1558 return (OP*)first;
1559}
1560
1561OP *
1562prepend_elem(type, first, last)
1563I32 type;
1564OP* first;
1565OP* last;
1566{
1567 if (!first)
1568 return last;
8990e307
LW		 1569
1570 if (!last)
79072805 1571 return first;
8990e307
LW		 1572
1573 if (last->op_type == type) {
1574 if (type == OP_LIST) { /* already a PUSHMARK there */
1575 first->op_sibling = ((LISTOP*)last)->op_first->op_sibling;
1576 ((LISTOP*)last)->op_first->op_sibling = first;
1577 }
1578 else {
1579 if (!(last->op_flags & OPf_KIDS)) {
1580 ((LISTOP*)last)->op_last = first;
1581 last->op_flags |= OPf_KIDS;
1582 }
1583 first->op_sibling = ((LISTOP*)last)->op_first;
1584 ((LISTOP*)last)->op_first = first;
79072805 1585 }
79072805
LW		 1586 ((LISTOP*)last)->op_children++;
1587 return last;
1588 }
1589
1590 return newLISTOP(type, 0, first, last);
1591}
1592
1593/* Constructors */
1594
1595OP *
1596newNULLLIST()
1597{
8990e307
LW		 1598 return newOP(OP_STUB, 0);
1599}
1600
1601OP *
1602force_list(op)
1603OP* op;
1604{
1605 if (!op || op->op_type != OP_LIST)
1606 op = newLISTOP(OP_LIST, 0, op, Nullop);
1607 null(op);
1608 return op;
79072805
LW		 1609}
1610
1611OP *
1612newLISTOP(type, flags, first, last)
1613I32 type;
1614I32 flags;
1615OP* first;
1616OP* last;
1617{
1618 LISTOP *listop;
1619
1620 Newz(1101, listop, 1, LISTOP);
1621
1622 listop->op_type = type;
1623 listop->op_ppaddr = ppaddr[type];
1624 listop->op_children = (first != 0) + (last != 0);
1625 listop->op_flags = flags;
79072805
LW		 1626
1627 if (!last && first)
1628 last = first;
1629 else if (!first && last)
1630 first = last;
8990e307
LW		 1631 else if (first)
1632 first->op_sibling = last;
79072805
LW		 1633 listop->op_first = first;
1634 listop->op_last = last;
8990e307
LW		 1635 if (type == OP_LIST) {
1636 OP* pushop;
1637 pushop = newOP(OP_PUSHMARK, 0);
1638 pushop->op_sibling = first;
1639 listop->op_first = pushop;
1640 listop->op_flags |= OPf_KIDS;
1641 if (!last)
1642 listop->op_last = pushop;
1643 }
1644 else if (listop->op_children)
1645 listop->op_flags |= OPf_KIDS;
79072805
LW		 1646
1647 return (OP*)listop;
1648}
1649
1650OP *
1651newOP(type, flags)
1652I32 type;
1653I32 flags;
1654{
1655 OP *op;
1656 Newz(1101, op, 1, OP);
1657 op->op_type = type;
1658 op->op_ppaddr = ppaddr[type];
1659 op->op_flags = flags;
1660
1661 op->op_next = op;
c07a80fd 1662 op->op_private = 0 + (flags >> 8);
79072805
LW		 1663 if (opargs[type] & OA_RETSCALAR)
1664 scalar(op);
1665 if (opargs[type] & OA_TARGET)
ed6116ce 1666 op->op_targ = pad_alloc(type, SVs_PADTMP);
e50aee73 1667 return CHECKOP(type, op);
79072805
LW		 1668}
1669
1670OP *
1671newUNOP(type, flags, first)
1672I32 type;
1673I32 flags;
1674OP* first;
1675{
1676 UNOP *unop;
1677
93a17b20
LW		 1678 if (!first)
1679 first = newOP(OP_STUB, 0);
8990e307
LW		 1680 if (opargs[type] & OA_MARK)
1681 first = force_list(first);
93a17b20 1682
79072805
LW		 1683 Newz(1101, unop, 1, UNOP);
1684 unop->op_type = type;
1685 unop->op_ppaddr = ppaddr[type];
1686 unop->op_first = first;
1687 unop->op_flags = flags | OPf_KIDS;
c07a80fd 1688 unop->op_private = 1 | (flags >> 8);
79072805 1689
e50aee73 1690 unop = (UNOP*) CHECKOP(type, unop);
79072805
LW		 1691 if (unop->op_next)
1692 return (OP*)unop;
1693
a0d0e21e 1694 return fold_constants((OP *) unop);
79072805
LW		 1695}
1696
1697OP *
1698newBINOP(type, flags, first, last)
1699I32 type;
1700I32 flags;
1701OP* first;
1702OP* last;
1703{
1704 BINOP *binop;
1705 Newz(1101, binop, 1, BINOP);
1706
1707 if (!first)
1708 first = newOP(OP_NULL, 0);
1709
1710 binop->op_type = type;
1711 binop->op_ppaddr = ppaddr[type];
1712 binop->op_first = first;
1713 binop->op_flags = flags | OPf_KIDS;
1714 if (!last) {
1715 last = first;
c07a80fd 1716 binop->op_private = 1 | (flags >> 8);
79072805
LW		 1717 }
1718 else {
c07a80fd 1719 binop->op_private = 2 | (flags >> 8);
79072805
LW		 1720 first->op_sibling = last;
1721 }
1722
e50aee73 1723 binop = (BINOP*)CHECKOP(type, binop);
79072805
LW		 1724 if (binop->op_next)
1725 return (OP*)binop;
1726
1727 binop->op_last = last = binop->op_first->op_sibling;
1728
a0d0e21e 1729 return fold_constants((OP *)binop);
79072805
LW		 1730}
1731
1732OP *
1733pmtrans(op, expr, repl)
1734OP *op;
1735OP *expr;
1736OP *repl;
1737{
79072805
LW		 1738 SV *tstr = ((SVOP*)expr)->op_sv;
1739 SV *rstr = ((SVOP*)repl)->op_sv;
463ee0b2
LW		 1740 STRLEN tlen;
1741 STRLEN rlen;
ec49126f 1742 register U8 *t = (U8*)SvPV(tstr, tlen);
1743 register U8 *r = (U8*)SvPV(rstr, rlen);
79072805
LW		 1744 register I32 i;
1745 register I32 j;
79072805
LW		 1746 I32 delete;
1747 I32 complement;
1748 register short *tbl;
1749
1750 tbl = (short*)cPVOP->op_pv;
1751 complement = op->op_private & OPpTRANS_COMPLEMENT;
1752 delete = op->op_private & OPpTRANS_DELETE;
748a9306 1753 /* squash = op->op_private & OPpTRANS_SQUASH; */
79072805
LW		 1754
1755 if (complement) {
1756 Zero(tbl, 256, short);
1757 for (i = 0; i < tlen; i++)
ec49126f 1758 tbl[t[i]] = -1;
79072805
LW		 1759 for (i = 0, j = 0; i < 256; i++) {
1760 if (!tbl[i]) {
1761 if (j >= rlen) {
1762 if (delete)
1763 tbl[i] = -2;
1764 else if (rlen)
ec49126f 1765 tbl[i] = r[j-1];
79072805
LW		 1766 else
1767 tbl[i] = i;
1768 }
1769 else
ec49126f 1770 tbl[i] = r[j++];
79072805
LW		 1771 }
1772 }
1773 }
1774 else {
1775 if (!rlen && !delete) {
1776 r = t; rlen = tlen;
1777 }
1778 for (i = 0; i < 256; i++)
1779 tbl[i] = -1;
1780 for (i = 0, j = 0; i < tlen; i++,j++) {
1781 if (j >= rlen) {
1782 if (delete) {
ec49126f 1783 if (tbl[t[i]] == -1)
1784 tbl[t[i]] = -2;
79072805
LW		 1785 continue;
1786 }
1787 --j;
1788 }
ec49126f 1789 if (tbl[t[i]] == -1)
1790 tbl[t[i]] = r[j];
79072805
LW		 1791 }
1792 }
1793 op_free(expr);
1794 op_free(repl);
1795
1796 return op;
1797}
1798
1799OP *
1800newPMOP(type, flags)
1801I32 type;
1802I32 flags;
1803{
1804 PMOP *pmop;
1805
1806 Newz(1101, pmop, 1, PMOP);
1807 pmop->op_type = type;
1808 pmop->op_ppaddr = ppaddr[type];
1809 pmop->op_flags = flags;
c07a80fd 1810 pmop->op_private = 0 | (flags >> 8);
79072805
LW		 1811
1812 /* link into pm list */
a0d0e21e 1813 if (type != OP_TRANS && curstash) {
79072805
LW		 1814 pmop->op_pmnext = HvPMROOT(curstash);
1815 HvPMROOT(curstash) = pmop;
1816 }
1817
1818 return (OP*)pmop;
1819}
1820
1821OP *
1822pmruntime(op, expr, repl)
1823OP *op;
1824OP *expr;
1825OP *repl;
1826{
1827 PMOP *pm;
1828 LOGOP *rcop;
1829
1830 if (op->op_type == OP_TRANS)
1831 return pmtrans(op, expr, repl);
1832
1833 pm = (PMOP*)op;
1834
1835 if (expr->op_type == OP_CONST) {
463ee0b2 1836 STRLEN plen;
79072805 1837 SV *pat = ((SVOP*)expr)->op_sv;
463ee0b2 1838 char *p = SvPV(pat, plen);
79072805 1839 if ((op->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
93a17b20 1840 sv_setpvn(pat, "\\s+", 3);
463ee0b2 1841 p = SvPV(pat, plen);
79072805
LW		 1842 pm->op_pmflags |= PMf_SKIPWHITE;
1843 }
e50aee73 1844 pm->op_pmregexp = pregcomp(p, p + plen, pm);
85e6fe83
LW		 1845 if (strEQ("\\s+", pm->op_pmregexp->precomp))
1846 pm->op_pmflags |= PMf_WHITE;
79072805
LW		 1847 hoistmust(pm);
1848 op_free(expr);
1849 }
1850 else {
463ee0b2
LW		 1851 if (pm->op_pmflags & PMf_KEEP)
1852 expr = newUNOP(OP_REGCMAYBE,0,expr);
1853
79072805
LW		 1854 Newz(1101, rcop, 1, LOGOP);
1855 rcop->op_type = OP_REGCOMP;
1856 rcop->op_ppaddr = ppaddr[OP_REGCOMP];
1857 rcop->op_first = scalar(expr);
1858 rcop->op_flags |= OPf_KIDS;
1859 rcop->op_private = 1;
1860 rcop->op_other = op;
1861
1862 /* establish postfix order */
463ee0b2
LW		 1863 if (pm->op_pmflags & PMf_KEEP) {
1864 LINKLIST(expr);
1865 rcop->op_next = expr;
1866 ((UNOP*)expr)->op_first->op_next = (OP*)rcop;
1867 }
1868 else {
1869 rcop->op_next = LINKLIST(expr);
1870 expr->op_next = (OP*)rcop;
1871 }
79072805 1872
463ee0b2 1873 prepend_elem(op->op_type, scalar((OP*)rcop), op);
79072805
LW		 1874 }
1875
1876 if (repl) {
748a9306
LW		 1877 OP *curop;
1878 if (pm->op_pmflags & PMf_EVAL)
1879 curop = 0;
1880 else if (repl->op_type == OP_CONST)
1881 curop = repl;
79072805 1882 else {
79072805
LW		 1883 OP *lastop = 0;
1884 for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
1885 if (opargs[curop->op_type] & OA_DANGEROUS) {
1886 if (curop->op_type == OP_GV) {
1887 GV *gv = ((GVOP*)curop)->op_gv;
93a17b20 1888 if (strchr("&`'123456789+", *GvENAME(gv)))
79072805
LW		 1889 break;
1890 }
1891 else if (curop->op_type == OP_RV2CV)
1892 break;
1893 else if (curop->op_type == OP_RV2SV ||
1894 curop->op_type == OP_RV2AV ||
1895 curop->op_type == OP_RV2HV ||
1896 curop->op_type == OP_RV2GV) {
1897 if (lastop && lastop->op_type != OP_GV) /*funny deref?*/
1898 break;
1899 }
748a9306
LW		 1900 else if (curop->op_type == OP_PADSV ||
1901 curop->op_type == OP_PADAV ||
1902 curop->op_type == OP_PADHV ||
1903 curop->op_type == OP_PADANY) {
1904 /* is okay */
1905 }
79072805
LW		 1906 else
1907 break;
1908 }
1909 lastop = curop;
1910 }
748a9306
LW		 1911 }
1912 if (curop == repl) {
1913 pm->op_pmflags |= PMf_CONST; /* const for long enough */
4633a7c4 1914 pm->op_pmpermflags |= PMf_CONST; /* const for long enough */
748a9306
LW		 1915 prepend_elem(op->op_type, scalar(repl), op);
1916 }
1917 else {
1918 Newz(1101, rcop, 1, LOGOP);
1919 rcop->op_type = OP_SUBSTCONT;
1920 rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
1921 rcop->op_first = scalar(repl);
1922 rcop->op_flags |= OPf_KIDS;
1923 rcop->op_private = 1;
1924 rcop->op_other = op;
1925
1926 /* establish postfix order */
1927 rcop->op_next = LINKLIST(repl);
1928 repl->op_next = (OP*)rcop;
1929
1930 pm->op_pmreplroot = scalar((OP*)rcop);
1931 pm->op_pmreplstart = LINKLIST(rcop);
1932 rcop->op_next = 0;
79072805
LW		 1933 }
1934 }
1935
1936 return (OP*)pm;
1937}
1938
1939OP *
1940newSVOP(type, flags, sv)
1941I32 type;
1942I32 flags;
1943SV *sv;
1944{
1945 SVOP *svop;
1946 Newz(1101, svop, 1, SVOP);
1947 svop->op_type = type;
1948 svop->op_ppaddr = ppaddr[type];
1949 svop->op_sv = sv;
1950 svop->op_next = (OP*)svop;
1951 svop->op_flags = flags;
1952 if (opargs[type] & OA_RETSCALAR)
463ee0b2 1953 scalar((OP*)svop);
79072805 1954 if (opargs[type] & OA_TARGET)
ed6116ce 1955 svop->op_targ = pad_alloc(type, SVs_PADTMP);
e50aee73 1956 return CHECKOP(type, svop);
79072805
LW		 1957}
1958
1959OP *
1960newGVOP(type, flags, gv)
1961I32 type;
1962I32 flags;
1963GV *gv;
1964{
1965 GVOP *gvop;
1966 Newz(1101, gvop, 1, GVOP);
1967 gvop->op_type = type;
1968 gvop->op_ppaddr = ppaddr[type];
8990e307 1969 gvop->op_gv = (GV*)SvREFCNT_inc(gv);
79072805
LW		 1970 gvop->op_next = (OP*)gvop;
1971 gvop->op_flags = flags;
1972 if (opargs[type] & OA_RETSCALAR)
463ee0b2 1973 scalar((OP*)gvop);
79072805 1974 if (opargs[type] & OA_TARGET)
ed6116ce 1975 gvop->op_targ = pad_alloc(type, SVs_PADTMP);
e50aee73 1976 return CHECKOP(type, gvop);
79072805
LW		 1977}
1978
1979OP *
1980newPVOP(type, flags, pv)
1981I32 type;
1982I32 flags;
1983char *pv;
1984{
1985 PVOP *pvop;
1986 Newz(1101, pvop, 1, PVOP);
1987 pvop->op_type = type;
1988 pvop->op_ppaddr = ppaddr[type];
1989 pvop->op_pv = pv;
1990 pvop->op_next = (OP*)pvop;
1991 pvop->op_flags = flags;
1992 if (opargs[type] & OA_RETSCALAR)
463ee0b2 1993 scalar((OP*)pvop);
79072805 1994 if (opargs[type] & OA_TARGET)
ed6116ce 1995 pvop->op_targ = pad_alloc(type, SVs_PADTMP);
e50aee73 1996 return CHECKOP(type, pvop);
79072805
LW		 1997}
1998
79072805
LW		 1999void
2000package(op)
2001OP *op;
2002{
93a17b20 2003 SV *sv;
79072805
LW		 2004
2005 save_hptr(&curstash);
2006 save_item(curstname);
93a17b20 2007 if (op) {
463ee0b2
LW		 2008 STRLEN len;
2009 char *name;
93a17b20 2010 sv = cSVOP->op_sv;
463ee0b2 2011 name = SvPV(sv, len);
a0d0e21e 2012 curstash = gv_stashpv(name,TRUE);
463ee0b2 2013 sv_setpvn(curstname, name, len);
93a17b20
LW		 2014 op_free(op);
2015 }
2016 else {
2017 sv_setpv(curstname,"<none>");
2018 curstash = Nullhv;
2019 }
79072805 2020 copline = NOLINE;
8990e307 2021 expect = XSTATE;
79072805
LW		 2022}
2023
85e6fe83 2024void
c07a80fd 2025utilize(aver, floor, id, arg)
85e6fe83 2026int aver;
c07a80fd 2027I32 floor;
85e6fe83
LW		 2028OP *id;
2029OP *arg;
2030{
a0d0e21e
LW		 2031 OP *pack;
2032 OP *meth;
2033 OP *rqop;
2034 OP *imop;
85e6fe83 2035
a0d0e21e
LW		 2036 if (id->op_type != OP_CONST)
2037 croak("Module name must be constant");
85e6fe83 2038
a0d0e21e 2039 /* Fake up an import/unimport */
4633a7c4
LW		 2040 if (arg && arg->op_type == OP_STUB)
2041 imop = arg; /* no import on explicit () */
2042 else {
2043 /* Make copy of id so we don't free it twice */
2044 pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
2045
2046 meth = newSVOP(OP_CONST, 0,
2047 aver
2048 ? newSVpv("import", 6)
2049 : newSVpv("unimport", 8)
2050 );
2051 imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
a0d0e21e
LW		 2052 append_elem(OP_LIST,
2053 prepend_elem(OP_LIST, pack, list(arg)),
2054 newUNOP(OP_METHOD, 0, meth)));
4633a7c4
LW		 2055 }
2056
2057 /* Fake up a require */
2058 rqop = newUNOP(OP_REQUIRE, 0, id);
a0d0e21e
LW		 2059
2060 /* Fake up the BEGIN {}, which does its thing immediately. */
c07a80fd 2061 newSUB(floor,
a0d0e21e 2062 newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)),
4633a7c4 2063 Nullop,
a0d0e21e
LW		 2064 append_elem(OP_LINESEQ,
2065 newSTATEOP(0, Nullch, rqop),
2066 newSTATEOP(0, Nullch, imop) ));
85e6fe83 2067
85e6fe83
LW		 2068 copline = NOLINE;
2069 expect = XSTATE;
2070}
2071
79072805
LW		 2072OP *
2073newSLICEOP(flags, subscript, listval)
2074I32 flags;
2075OP *subscript;
2076OP *listval;
2077{
2078 return newBINOP(OP_LSLICE, flags,
8990e307
LW		 2079 list(force_list(subscript)),
2080 list(force_list(listval)) );
79072805
LW		 2081}
2082
2083static I32
2084list_assignment(op)
2085register OP *op;
2086{
2087 if (!op)
2088 return TRUE;
2089
2090 if (op->op_type == OP_NULL && op->op_flags & OPf_KIDS)
2091 op = cUNOP->op_first;
2092
2093 if (op->op_type == OP_COND_EXPR) {
2094 I32 t = list_assignment(cCONDOP->op_first->op_sibling);
2095 I32 f = list_assignment(cCONDOP->op_first->op_sibling->op_sibling);
2096
2097 if (t && f)
2098 return TRUE;
2099 if (t || f)
2100 yyerror("Assignment to both a list and a scalar");
2101 return FALSE;
2102 }
2103
2104 if (op->op_type == OP_LIST || op->op_flags & OPf_PARENS ||
2105 op->op_type == OP_RV2AV || op->op_type == OP_RV2HV ||
2106 op->op_type == OP_ASLICE || op->op_type == OP_HSLICE)
2107 return TRUE;
2108
93a17b20
LW		 2109 if (op->op_type == OP_PADAV || op->op_type == OP_PADHV)
2110 return TRUE;
2111
79072805
LW		 2112 if (op->op_type == OP_RV2SV)
2113 return FALSE;
2114
2115 return FALSE;
2116}
2117
2118OP *
a0d0e21e 2119newASSIGNOP(flags, left, optype, right)
79072805
LW		 2120I32 flags;
2121OP *left;
a0d0e21e 2122I32 optype;
79072805
LW		 2123OP *right;
2124{
2125 OP *op;
2126
a0d0e21e
LW		 2127 if (optype) {
2128 if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) {
2129 return newLOGOP(optype, 0,
2130 mod(scalar(left), optype),
2131 newUNOP(OP_SASSIGN, 0, scalar(right)));
2132 }
2133 else {
2134 return newBINOP(optype, OPf_STACKED,
2135 mod(scalar(left), optype), scalar(right));
2136 }
2137 }
2138
79072805 2139 if (list_assignment(left)) {
463ee0b2 2140 modcount = 0;
748a9306 2141 eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
463ee0b2 2142 left = mod(left, OP_AASSIGN);
748a9306
LW		 2143 if (eval_start)
2144 eval_start = 0;
2145 else {
a0d0e21e
LW		 2146 op_free(left);
2147 op_free(right);
2148 return Nullop;
2149 }
79072805 2150 op = newBINOP(OP_AASSIGN, flags,
8990e307
LW		 2151 list(force_list(right)),
2152 list(force_list(left)) );
c07a80fd 2153 op->op_private = 0 | (flags >> 8);
a0d0e21e 2154 if (!(left->op_private & OPpLVAL_INTRO)) {
748a9306 2155 static int generation = 100;
79072805
LW		 2156 OP *curop;
2157 OP *lastop = op;
2158 generation++;
2159 for (curop = LINKLIST(op); curop != op; curop = LINKLIST(curop)) {
2160 if (opargs[curop->op_type] & OA_DANGEROUS) {
2161 if (curop->op_type == OP_GV) {
2162 GV *gv = ((GVOP*)curop)->op_gv;
2163 if (gv == defgv || SvCUR(gv) == generation)
2164 break;
2165 SvCUR(gv) = generation;
2166 }
748a9306
LW		 2167 else if (curop->op_type == OP_PADSV ||
2168 curop->op_type == OP_PADAV ||
2169 curop->op_type == OP_PADHV ||
2170 curop->op_type == OP_PADANY) {
2171 SV **svp = AvARRAY(comppad_name);
8e07c86e 2172 SV *sv = svp[curop->op_targ];
748a9306
LW		 2173 if (SvCUR(sv) == generation)
2174 break;
2175 SvCUR(sv) = generation; /* (SvCUR not used any more) */
2176 }
79072805
LW		 2177 else if (curop->op_type == OP_RV2CV)
2178 break;
2179 else if (curop->op_type == OP_RV2SV ||
2180 curop->op_type == OP_RV2AV ||
2181 curop->op_type == OP_RV2HV ||
2182 curop->op_type == OP_RV2GV) {
2183 if (lastop->op_type != OP_GV) /* funny deref? */
2184 break;
2185 }
2186 else
2187 break;
2188 }
2189 lastop = curop;
2190 }
2191 if (curop != op)
2192 op->op_private = OPpASSIGN_COMMON;
2193 }
c07a80fd 2194 if (right && right->op_type == OP_SPLIT) {
2195 OP* tmpop;
2196 if ((tmpop = ((LISTOP*)right)->op_first) &&
2197 tmpop->op_type == OP_PUSHRE)
2198 {
2199 PMOP *pm = (PMOP*)tmpop;
2200 if (left->op_type == OP_RV2AV &&
2201 !(left->op_private & OPpLVAL_INTRO) &&
2202 !(op->op_private & OPpASSIGN_COMMON) )
2203 {
2204 tmpop = ((UNOP*)left)->op_first;
2205 if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
2206 pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv;
2207 pm->op_pmflags |= PMf_ONCE;
2208 tmpop = ((UNOP*)op)->op_first; /* to list (nulled) */
2209 tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
2210 tmpop->op_sibling = Nullop; /* don't free split */
2211 right->op_next = tmpop->op_next; /* fix starting loc */
2212 op_free(op); /* blow off assign */
2213 return right;
2214 }
2215 }
2216 else {
2217 if (modcount < 10000 &&
2218 ((LISTOP*)right)->op_last->op_type == OP_CONST)
2219 {
2220 SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
2221 if (SvIVX(sv) == 0)
2222 sv_setiv(sv, modcount+1);
2223 }
2224 }
2225 }
2226 }
79072805
LW		 2227 return op;
2228 }
2229 if (!right)
2230 right = newOP(OP_UNDEF, 0);
2231 if (right->op_type == OP_READLINE) {
2232 right->op_flags |= OPf_STACKED;
463ee0b2 2233 return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right));
79072805 2234 }
a0d0e21e 2235 else {
748a9306 2236 eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
79072805 2237 op = newBINOP(OP_SASSIGN, flags,
463ee0b2 2238 scalar(right), mod(scalar(left), OP_SASSIGN) );
748a9306
LW		 2239 if (eval_start)
2240 eval_start = 0;
2241 else {
a0d0e21e
LW		 2242 op_free(op);
2243 return Nullop;
2244 }
2245 }
79072805
LW		 2246 return op;
2247}
2248
2249OP *
2250newSTATEOP(flags, label, op)
2251I32 flags;
2252char *label;
2253OP *op;
2254{
2255 register COP *cop;
2256
8990e307
LW		 2257 /* Introduce my variables. */
2258 if (min_intro_pending) {
2259 SV **svp = AvARRAY(comppad_name);
2260 I32 i;
2261 SV *sv;
2262 for (i = min_intro_pending; i <= max_intro_pending; i++) {
4633a7c4 2263 if ((sv = svp[i]) && sv != &sv_undef && !SvIVX(sv)) {
8990e307 2264 SvIVX(sv) = 999999999; /* Don't know scope end yet. */
748a9306 2265 SvNVX(sv) = (double)cop_seqmax;
4633a7c4 2266 }
8990e307
LW		 2267 }
2268 min_intro_pending = 0;
2269 comppad_name_fill = max_intro_pending; /* Needn't search higher */
2270 }
93a17b20 2271
79072805 2272 Newz(1101, cop, 1, COP);
8990e307
LW		 2273 if (perldb && curcop->cop_line && curstash != debstash) {
2274 cop->op_type = OP_DBSTATE;
2275 cop->op_ppaddr = ppaddr[ OP_DBSTATE ];
2276 }
2277 else {
2278 cop->op_type = OP_NEXTSTATE;
2279 cop->op_ppaddr = ppaddr[ OP_NEXTSTATE ];
2280 }
79072805 2281 cop->op_flags = flags;
c07a80fd 2282 cop->op_private = 0 | (flags >> 8);
79072805
LW		 2283 cop->op_next = (OP*)cop;
2284
463ee0b2
LW		 2285 if (label) {
2286 cop->cop_label = label;
85e6fe83 2287 hints |= HINT_BLOCK_SCOPE;
463ee0b2
LW		 2288 }
2289 cop->cop_seq = cop_seqmax++;
a0d0e21e 2290 cop->cop_arybase = curcop->cop_arybase;
79072805
LW		 2291
2292 if (copline == NOLINE)
2293 cop->cop_line = curcop->cop_line;
2294 else {
2295 cop->cop_line = copline;
2296 copline = NOLINE;
2297 }
8990e307 2298 cop->cop_filegv = SvREFCNT_inc(curcop->cop_filegv);
79072805
LW		 2299 cop->cop_stash = curstash;
2300
8990e307 2301 if (perldb && curstash != debstash) {
93a17b20
LW		 2302 SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE);
2303 if (svp && *svp != &sv_undef && !SvIOK(*svp)) {
463ee0b2 2304 SvIVX(*svp) = 1;
a0d0e21e 2305 (void)SvIOK_on(*svp);
93a17b20
LW		 2306 SvSTASH(*svp) = (HV*)cop;
2307 }
2308 }
2309
79072805
LW		 2310 return prepend_elem(OP_LINESEQ, (OP*)cop, op);
2311}
2312
2313OP *
2314newLOGOP(type, flags, first, other)
2315I32 type;
2316I32 flags;
2317OP* first;
2318OP* other;
2319{
2320 LOGOP *logop;
2321 OP *op;
2322
a0d0e21e
LW		 2323 if (type == OP_XOR) /* Not short circuit, but here by precedence. */
2324 return newBINOP(type, flags, scalar(first), scalar(other));
2325
8990e307 2326 scalarboolean(first);
79072805
LW		 2327 /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
2328 if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) {
2329 if (type == OP_AND || type == OP_OR) {
2330 if (type == OP_AND)
2331 type = OP_OR;
2332 else
2333 type = OP_AND;
2334 op = first;
2335 first = cUNOP->op_first;
2336 if (op->op_next)
2337 first->op_next = op->op_next;
2338 cUNOP->op_first = Nullop;
2339 op_free(op);
2340 }
2341 }
2342 if (first->op_type == OP_CONST) {
93a17b20 2343 if (dowarn && (first->op_private & OPpCONST_BARE))
c07a80fd 2344 warn("Probable precedence problem on %s", op_desc[type]);
79072805
LW		 2345 if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
2346 op_free(first);
2347 return other;
2348 }
2349 else {
2350 op_free(other);
2351 return first;
2352 }
2353 }
2354 else if (first->op_type == OP_WANTARRAY) {
2355 if (type == OP_AND)
2356 list(other);
2357 else
2358 scalar(other);
2359 }
2360
2361 if (!other)
2362 return first;
2363
a0d0e21e
LW		 2364 if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
2365 other->op_private |= OPpASSIGN_BACKWARDS; /* other is an OP_SASSIGN */
2366
79072805
LW		 2367 Newz(1101, logop, 1, LOGOP);
2368
2369 logop->op_type = type;
2370 logop->op_ppaddr = ppaddr[type];
2371 logop->op_first = first;
2372 logop->op_flags = flags | OPf_KIDS;
2373 logop->op_other = LINKLIST(other);
c07a80fd 2374 logop->op_private = 1 | (flags >> 8);
79072805
LW		 2375
2376 /* establish postfix order */
2377 logop->op_next = LINKLIST(first);
2378 first->op_next = (OP*)logop;
2379 first->op_sibling = other;
2380
2381 op = newUNOP(OP_NULL, 0, (OP*)logop);
2382 other->op_next = op;
2383
2384 return op;
2385}
2386
2387OP *
2388newCONDOP(flags, first, true, false)
2389I32 flags;
2390OP* first;
2391OP* true;
2392OP* false;
2393{
2394 CONDOP *condop;
2395 OP *op;
2396
2397 if (!false)
2398 return newLOGOP(OP_AND, 0, first, true);
463ee0b2
LW		 2399 if (!true)
2400 return newLOGOP(OP_OR, 0, first, false);
79072805 2401
8990e307 2402 scalarboolean(first);
79072805
LW		 2403 if (first->op_type == OP_CONST) {
2404 if (SvTRUE(((SVOP*)first)->op_sv)) {
2405 op_free(first);
2406 op_free(false);
2407 return true;
2408 }
2409 else {
2410 op_free(first);
2411 op_free(true);
2412 return false;
2413 }
2414 }
2415 else if (first->op_type == OP_WANTARRAY) {
2416 list(true);
2417 scalar(false);
2418 }
2419 Newz(1101, condop, 1, CONDOP);
2420
2421 condop->op_type = OP_COND_EXPR;
2422 condop->op_ppaddr = ppaddr[OP_COND_EXPR];
2423 condop->op_first = first;
2424 condop->op_flags = flags | OPf_KIDS;
2425 condop->op_true = LINKLIST(true);
2426 condop->op_false = LINKLIST(false);
c07a80fd 2427 condop->op_private = 1 | (flags >> 8);
79072805
LW		 2428
2429 /* establish postfix order */
2430 condop->op_next = LINKLIST(first);
2431 first->op_next = (OP*)condop;
2432
2433 first->op_sibling = true;
2434 true->op_sibling = false;
2435 op = newUNOP(OP_NULL, 0, (OP*)condop);
2436
2437 true->op_next = op;
2438 false->op_next = op;
2439
2440 return op;
2441}
2442
2443OP *
2444newRANGE(flags, left, right)
2445I32 flags;
2446OP *left;
2447OP *right;
2448{
2449 CONDOP *condop;
2450 OP *flip;
2451 OP *flop;
2452 OP *op;
2453
2454 Newz(1101, condop, 1, CONDOP);
2455
2456 condop->op_type = OP_RANGE;
2457 condop->op_ppaddr = ppaddr[OP_RANGE];
2458 condop->op_first = left;
2459 condop->op_flags = OPf_KIDS;
2460 condop->op_true = LINKLIST(left);
2461 condop->op_false = LINKLIST(right);
c07a80fd 2462 condop->op_private = 1 | (flags >> 8);
79072805
LW		 2463
2464 left->op_sibling = right;
2465
2466 condop->op_next = (OP*)condop;
2467 flip = newUNOP(OP_FLIP, flags, (OP*)condop);
2468 flop = newUNOP(OP_FLOP, 0, flip);
2469 op = newUNOP(OP_NULL, 0, flop);
2470 linklist(flop);
2471
2472 left->op_next = flip;
2473 right->op_next = flop;
2474
ed6116ce 2475 condop->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
79072805 2476 sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV);
ed6116ce 2477 flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
79072805
LW		 2478 sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
2479
2480 flip->op_private = left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
2481 flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
2482
2483 flip->op_next = op;
2484 if (!flip->op_private || !flop->op_private)
2485 linklist(op); /* blow off optimizer unless constant */
2486
2487 return op;
2488}
2489
2490OP *
2491newLOOPOP(flags, debuggable, expr, block)
2492I32 flags;
2493I32 debuggable;
2494OP *expr;
2495OP *block;
2496{
463ee0b2 2497 OP* listop;
93a17b20 2498 OP* op;
463ee0b2 2499 int once = block && block->op_flags & OPf_SPECIAL &&
a0d0e21e 2500 (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
93a17b20 2501
463ee0b2
LW		 2502 if (expr) {
2503 if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
2504 return block; /* do {} while 0 does once */
2505 else if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)
a0d0e21e 2506 expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr);
463ee0b2 2507 }
93a17b20 2508
8990e307 2509 listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
93a17b20 2510 op = newLOGOP(OP_AND, 0, expr, listop);
463ee0b2 2511
79072805
LW		 2512 ((LISTOP*)listop)->op_last->op_next = LINKLIST(op);
2513
463ee0b2 2514 if (once && op != listop)
79072805
LW		 2515 op->op_next = ((LOGOP*)cUNOP->op_first)->op_other;
2516
748a9306
LW		 2517 if (op == listop)
2518 op = newUNOP(OP_NULL, 0, op); /* or do {} while 1 loses outer block */
2519
79072805 2520 op->op_flags |= flags;
a0d0e21e 2521 op = scope(op);
748a9306 2522 op->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/
a0d0e21e 2523 return op;
79072805
LW		 2524}
2525
2526OP *
2527newWHILEOP(flags, debuggable, loop, expr, block, cont)
2528I32 flags;
2529I32 debuggable;
2530LOOP *loop;
2531OP *expr;
2532OP *block;
2533OP *cont;
2534{
2535 OP *redo;
2536 OP *next = 0;
2537 OP *listop;
2538 OP *op;
2539 OP *condop;
2540
748a9306
LW		 2541 if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) {
2542 expr = newUNOP(OP_DEFINED, 0,
2543 newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
2544 }
79072805
LW		 2545
2546 if (!block)
2547 block = newOP(OP_NULL, 0);
2548
2549 if (cont)
2550 next = LINKLIST(cont);
2551 if (expr)
2552 cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
2553
463ee0b2 2554 listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
79072805
LW		 2555 redo = LINKLIST(listop);
2556
2557 if (expr) {
2558 op = newLOGOP(OP_AND, 0, expr, scalar(listop));
85e6fe83
LW		 2559 if (op == expr && op->op_type == OP_CONST && !SvTRUE(cSVOP->op_sv)) {
2560 op_free(expr); /* oops, it's a while (0) */
463ee0b2
LW		 2561 op_free((OP*)loop);
2562 return Nullop; /* (listop already freed by newLOGOP) */
2563 }
79072805
LW		 2564 ((LISTOP*)listop)->op_last->op_next = condop =
2565 (op == listop ? redo : LINKLIST(op));
2566 if (!next)
2567 next = condop;
2568 }
2569 else
2570 op = listop;
2571
2572 if (!loop) {
2573 Newz(1101,loop,1,LOOP);
2574 loop->op_type = OP_ENTERLOOP;
2575 loop->op_ppaddr = ppaddr[OP_ENTERLOOP];
2576 loop->op_private = 0;
2577 loop->op_next = (OP*)loop;
2578 }
2579
463ee0b2 2580 op = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, op);
79072805
LW		 2581
2582 loop->op_redoop = redo;
2583 loop->op_lastop = op;
2584
2585 if (next)
2586 loop->op_nextop = next;
2587 else
2588 loop->op_nextop = op;
2589
2590 op->op_flags |= flags;
c07a80fd 2591 op->op_private |= (flags >> 8);
79072805
LW		 2592 return op;
2593}
2594
2595OP *
a0d0e21e 2596#ifndef CAN_PROTOTYPE
79072805
LW		 2597newFOROP(flags,label,forline,sv,expr,block,cont)
2598I32 flags;
2599char *label;
2600line_t forline;
2601OP* sv;
2602OP* expr;
2603OP*block;
2604OP*cont;
8990e307
LW		 2605#else
2606newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
a0d0e21e 2607#endif /* CAN_PROTOTYPE */
79072805
LW		 2608{
2609 LOOP *loop;
85e6fe83 2610 int padoff = 0;
4633a7c4 2611 I32 iterflags = 0;
79072805
LW		 2612
2613 copline = forline;
2614 if (sv) {
85e6fe83 2615 if (sv->op_type == OP_RV2SV) { /* symbol table variable */
748a9306
LW		 2616 sv->op_type = OP_RV2GV;
2617 sv->op_ppaddr = ppaddr[OP_RV2GV];
79072805 2618 }
85e6fe83
LW		 2619 else if (sv->op_type == OP_PADSV) { /* private variable */
2620 padoff = sv->op_targ;
2621 op_free(sv);
2622 sv = Nullop;
2623 }
79072805 2624 else
c07a80fd 2625 croak("Can't use %s for loop variable", op_desc[sv->op_type]);
79072805
LW		 2626 }
2627 else {
2628 sv = newGVOP(OP_GV, 0, defgv);
2629 }
4633a7c4
LW		 2630 if (expr->op_type == OP_RV2AV) {
2631 expr = scalar(ref(expr, OP_ITER));
2632 iterflags |= OPf_STACKED;
2633 }
2634 loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
a0d0e21e
LW		 2635 append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART),
2636 scalar(sv))));
85e6fe83
LW		 2637 assert(!loop->op_next);
2638 Renew(loop, 1, LOOP);
2639 loop->op_targ = padoff;
2640 return newSTATEOP(0, label, newWHILEOP(flags, 1, loop,
2641 newOP(OP_ITER, 0), block, cont));
79072805
LW		 2642}
2643
8990e307
LW		 2644OP*
2645newLOOPEX(type, label)
2646I32 type;
2647OP* label;
2648{
2649 OP *op;
2650 if (type != OP_GOTO || label->op_type == OP_CONST) {
a0d0e21e
LW		 2651 op = newPVOP(type, 0, savepv(
2652 label->op_type == OP_CONST
2653 ? SvPVx(((SVOP*)label)->op_sv, na)
2654 : "" ));
8990e307
LW		 2655 op_free(label);
2656 }
2657 else {
a0d0e21e
LW		 2658 if (label->op_type == OP_ENTERSUB)
2659 label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
8990e307
LW		 2660 op = newUNOP(type, OPf_STACKED, label);
2661 }
85e6fe83 2662 hints |= HINT_BLOCK_SCOPE;
8990e307
LW		 2663 return op;
2664}
2665
79072805 2666void
85e6fe83 2667cv_undef(cv)
79072805
LW		 2668CV *cv;
2669{
a0d0e21e
LW		 2670 if (!CvXSUB(cv) && CvROOT(cv)) {
2671 if (CvDEPTH(cv))
2672 croak("Can't undef active subroutine");
8990e307 2673 ENTER;
a0d0e21e
LW		 2674
2675 SAVESPTR(curpad);
2676 curpad = 0;
2677
4aa0a1f7 2678 if (!(SvFLAGS(cv) & SVpcv_CLONED))
748a9306 2679 op_free(CvROOT(cv));
79072805 2680 CvROOT(cv) = Nullop;
8990e307 2681 LEAVE;
79072805 2682 }
8e07c86e
AD		 2683 SvREFCNT_dec(CvGV(cv));
2684 CvGV(cv) = Nullgv;
2685 SvREFCNT_dec(CvOUTSIDE(cv));
2686 CvOUTSIDE(cv) = Nullcv;
2687 if (CvPADLIST(cv)) {
2688 I32 i = AvFILL(CvPADLIST(cv));
2689 while (i >= 0) {
2690 SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
2691 if (svp)
2692 SvREFCNT_dec(*svp);
2693 }
2694 SvREFCNT_dec((SV*)CvPADLIST(cv));
2695 CvPADLIST(cv) = Nullav;
2696 }
79072805
LW		 2697}
2698
a0d0e21e 2699CV *
748a9306
LW		 2700cv_clone(proto)
2701CV* proto;
2702{
2703 AV* av;
2704 I32 ix;
2705 AV* protopadlist = CvPADLIST(proto);
2706 AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
2707 AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
2708 SV** svp = AvARRAY(protopad);
2709 AV* comppadlist;
2710 CV* cv;
2711
2712 ENTER;
2713 SAVESPTR(curpad);
2714 SAVESPTR(comppad);
2715 SAVESPTR(compcv);
2716
2717 cv = compcv = (CV*)NEWSV(1104,0);
2718 sv_upgrade((SV *)cv, SVt_PVCV);
2719 SvFLAGS(cv) |= SVpcv_CLONED;
2720
2721 CvFILEGV(cv) = CvFILEGV(proto);
2722 CvGV(cv) = SvREFCNT_inc(CvGV(proto));
2723 CvSTASH(cv) = CvSTASH(proto);
2724 CvROOT(cv) = CvROOT(proto);
2725 CvSTART(cv) = CvSTART(proto);
e9a444f0
LW		 2726 if (CvOUTSIDE(proto))
2727 CvOUTSIDE(cv) = (CV*)SvREFCNT_inc((SV*)CvOUTSIDE(proto));
748a9306
LW		 2728
2729 comppad = newAV();
2730
2731 comppadlist = newAV();
2732 AvREAL_off(comppadlist);
2733 av_store(comppadlist, 0, SvREFCNT_inc((SV*)protopad_name));
b355b4e0 2734 av_store(comppadlist, 1, (SV*)comppad);
748a9306
LW		 2735 CvPADLIST(cv) = comppadlist;
2736 av_extend(comppad, AvFILL(protopad));
2737 curpad = AvARRAY(comppad);
2738
2739 av = newAV(); /* will be @_ */
2740 av_extend(av, 0);
2741 av_store(comppad, 0, (SV*)av);
2742 AvFLAGS(av) = AVf_REIFY;
2743
2744 svp = AvARRAY(protopad_name);
2745 for ( ix = AvFILL(protopad); ix > 0; ix--) {
2746 SV *sv;
2747 if (svp[ix] != &sv_undef) {
2748 char *name = SvPVX(svp[ix]); /* XXX */
2749 if (SvFLAGS(svp[ix]) & SVf_FAKE) { /* lexical from outside? */
4633a7c4
LW		 2750 I32 off = pad_findlex(name,ix,curcop->cop_seq, CvOUTSIDE(proto),
2751 cxstack_ix);
748a9306
LW		 2752 if (off != ix)
2753 croak("panic: cv_clone: %s", name);
2754 }
2755 else { /* our own lexical */
2756 if (*name == '@')
2757 av_store(comppad, ix, sv = (SV*)newAV());
2758 else if (*name == '%')
2759 av_store(comppad, ix, sv = (SV*)newHV());
2760 else
2761 av_store(comppad, ix, sv = NEWSV(0,0));
2762 SvPADMY_on(sv);
2763 }
2764 }
2765 else {
2766 av_store(comppad, ix, sv = NEWSV(0,0));
2767 SvPADTMP_on(sv);
2768 }
2769 }
2770
2771 LEAVE;
2772 return cv;
2773}
2774
2775CV *
4633a7c4 2776newSUB(floor,op,proto,block)
79072805
LW		 2777I32 floor;
2778OP *op;
4633a7c4 2779OP *proto;
79072805
LW		 2780OP *block;
2781{
2782 register CV *cv;
a0d0e21e 2783 char *name = op ? SvPVx(cSVOP->op_sv, na) : "__ANON__";
c07a80fd 2784 GV* gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV);
79072805 2785 AV* av;
8990e307 2786 char *s;
a0d0e21e 2787 I32 ix;
79072805 2788
a0d0e21e
LW		 2789 if (op)
2790 sub_generation++;
2791 if (cv = GvCV(gv)) {
2792 if (GvCVGEN(gv))
2793 cv = 0; /* just a cached method */
748a9306
LW		 2794 else if (CvROOT(cv) || CvXSUB(cv) || GvFLAGS(gv) & GVf_IMPORTED) {
2795 if (dowarn) { /* already defined (or promised)? */
79072805
LW		 2796 line_t oldline = curcop->cop_line;
2797
2798 curcop->cop_line = copline;
2799 warn("Subroutine %s redefined",name);
2800 curcop->cop_line = oldline;
2801 }
8990e307 2802 SvREFCNT_dec(cv);
a0d0e21e 2803 cv = 0;
79072805
LW		 2804 }
2805 }
a0d0e21e 2806 if (cv) { /* must reuse cv if autoloaded */
4633a7c4 2807 cv_undef(cv);
748a9306 2808 CvOUTSIDE(cv) = CvOUTSIDE(compcv);
e9a444f0 2809 CvOUTSIDE(compcv) = 0;
748a9306 2810 CvPADLIST(cv) = CvPADLIST(compcv);
4aa0a1f7 2811 CvPADLIST(compcv) = 0;
4633a7c4
LW		 2812 if (SvREFCNT(compcv) > 1) /* XXX Make closures transit through stub. */
2813 CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)cv);
748a9306 2814 SvREFCNT_dec(compcv);
a0d0e21e
LW		 2815 }
2816 else {
748a9306 2817 cv = compcv;
a0d0e21e 2818 }
79072805 2819 GvCV(gv) = cv;
463ee0b2 2820 GvCVGEN(gv) = 0;
79072805 2821 CvFILEGV(cv) = curcop->cop_filegv;
8990e307
LW		 2822 CvGV(cv) = SvREFCNT_inc(gv);
2823 CvSTASH(cv) = curstash;
2824
4633a7c4
LW		 2825 if (proto) {
2826 char *p = SvPVx(((SVOP*)proto)->op_sv, na);
2827 if (SvPOK(cv) && strNE(SvPV((SV*)cv,na), p))
2828 warn("Prototype mismatch: (%s) vs (%s)", SvPV((SV*)cv, na), p);
2829 sv_setpv((SV*)cv, p);
c07a80fd 2830 op_free(proto);
4633a7c4
LW		 2831 }
2832
c07a80fd 2833 if (error_count) {
2834 op_free(block);
2835 block = Nullop;
2836 }
a0d0e21e
LW		 2837 if (!block) {
2838 CvROOT(cv) = 0;
2839 op_free(op);
2840 copline = NOLINE;
2841 LEAVE_SCOPE(floor);
2842 return cv;
2843 }
2844
2845 av = newAV(); /* Will be @_ */
2846 av_extend(av, 0);
8990e307 2847 av_store(comppad, 0, (SV*)av);
a0d0e21e
LW		 2848 AvFLAGS(av) = AVf_REIFY;
2849
2850 for (ix = AvFILL(comppad); ix > 0; ix--) {
2851 if (!SvPADMY(curpad[ix]))
2852 SvPADTMP_on(curpad[ix]);
2853 }
79072805 2854
8990e307
LW		 2855 if (AvFILL(comppad_name) < AvFILL(comppad))
2856 av_store(comppad_name, AvFILL(comppad), Nullsv);
79072805 2857
a0d0e21e 2858 CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
79072805
LW		 2859 CvSTART(cv) = LINKLIST(CvROOT(cv));
2860 CvROOT(cv)->op_next = 0;
2861 peep(CvSTART(cv));
8990e307
LW		 2862 if (s = strrchr(name,':'))
2863 s++;
2864 else
2865 s = name;
4633a7c4 2866 if (strEQ(s, "BEGIN") && !error_count) {
8990e307 2867 line_t oldline = compiling.cop_line;
c07a80fd 2868 SV *oldrs = rs;
93a17b20 2869
8990e307
LW		 2870 ENTER;
2871 SAVESPTR(compiling.cop_filegv);
2872 SAVEI32(perldb);
93a17b20
LW		 2873 if (!beginav)
2874 beginav = newAV();
85e6fe83 2875 av_push(beginav, (SV *)cv);
93a17b20 2876 DEBUG_x( dump_sub(gv) );
c07a80fd 2877 rs = SvREFCNT_inc(nrs);
8990e307 2878 GvCV(gv) = 0;
93a17b20 2879 calllist(beginav);
c07a80fd 2880 SvREFCNT_dec(rs);
2881 rs = oldrs;
93a17b20 2882 curcop = &compiling;
8990e307
LW		 2883 curcop->cop_line = oldline; /* might have recursed to yylex */
2884 LEAVE;
93a17b20 2885 }
4633a7c4 2886 else if (strEQ(s, "END") && !error_count) {
93a17b20
LW		 2887 if (!endav)
2888 endav = newAV();
2889 av_unshift(endav, 1);
8990e307 2890 av_store(endav, 0, SvREFCNT_inc(cv));
93a17b20 2891 }
8990e307 2892 if (perldb && curstash != debstash) {
79072805 2893 SV *sv;
8990e307 2894 SV *tmpstr = sv_newmortal();
79072805 2895
a0d0e21e 2896 sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
79072805
LW		 2897 sv = newSVpv(buf,0);
2898 sv_catpv(sv,"-");
2899 sprintf(buf,"%ld",(long)curcop->cop_line);
2900 sv_catpv(sv,buf);
2901 gv_efullname(tmpstr,gv);
463ee0b2 2902 hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
79072805
LW		 2903 }
2904 op_free(op);
2905 copline = NOLINE;
8990e307 2906 LEAVE_SCOPE(floor);
748a9306 2907 if (!op) {
a0d0e21e 2908 GvCV(gv) = 0; /* Will remember in SVOP instead. */
748a9306
LW		 2909 SvFLAGS(cv) |= SVpcv_ANON;
2910 }
a0d0e21e 2911 return cv;
79072805
LW		 2912}
2913
a0d0e21e
LW		 2914#ifdef DEPRECATED
2915CV *
463ee0b2 2916newXSUB(name, ix, subaddr, filename)
79072805
LW		 2917char *name;
2918I32 ix;
2919I32 (*subaddr)();
2920char *filename;
2921{
a0d0e21e
LW		 2922 CV* cv = newXS(name, (void(*)())subaddr, filename);
2923 CvOLDSTYLE(cv) = TRUE;
2924 CvXSUBANY(cv).any_i32 = ix;
2925 return cv;
2926}
2927#endif
2928
2929CV *
2930newXS(name, subaddr, filename)
2931char *name;
2932void (*subaddr) _((CV*));
2933char *filename;
2934{
79072805 2935 register CV *cv;
a0d0e21e 2936 GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV);
8990e307 2937 char *s;
79072805 2938
a0d0e21e
LW		 2939 if (name)
2940 sub_generation++;
2941 if (cv = GvCV(gv)) {
2942 if (GvCVGEN(gv))
2943 cv = 0; /* just a cached method */
748a9306 2944 else if (CvROOT(cv) || CvXSUB(cv)) { /* already defined? */
a0d0e21e
LW		 2945 if (dowarn) {
2946 line_t oldline = curcop->cop_line;
2947
2948 curcop->cop_line = copline;
2949 warn("Subroutine %s redefined",name);
2950 curcop->cop_line = oldline;
2951 }
2952 SvREFCNT_dec(cv);
2953 cv = 0;
79072805 2954 }
79072805 2955 }
a0d0e21e
LW		 2956 if (cv) { /* must reuse cv if autoloaded */
2957 assert(SvREFCNT(CvGV(cv)) > 1);
2958 SvREFCNT_dec(CvGV(cv));
2959 }
2960 else {
2961 cv = (CV*)NEWSV(1105,0);
2962 sv_upgrade((SV *)cv, SVt_PVCV);
2963 }
79072805 2964 GvCV(gv) = cv;
8990e307 2965 CvGV(cv) = SvREFCNT_inc(gv);
463ee0b2 2966 GvCVGEN(gv) = 0;
79072805 2967 CvFILEGV(cv) = gv_fetchfile(filename);
a0d0e21e
LW		 2968 CvXSUB(cv) = subaddr;
2969 if (!name)
2970 s = "__ANON__";
2971 else if (s = strrchr(name,':'))
8990e307
LW		 2972 s++;
2973 else
2974 s = name;
2975 if (strEQ(s, "BEGIN")) {
93a17b20
LW		 2976 if (!beginav)
2977 beginav = newAV();
8990e307 2978 av_push(beginav, SvREFCNT_inc(gv));
93a17b20 2979 }
8990e307 2980 else if (strEQ(s, "END")) {
93a17b20
LW		 2981 if (!endav)
2982 endav = newAV();
2983 av_unshift(endav, 1);
8990e307 2984 av_store(endav, 0, SvREFCNT_inc(gv));
93a17b20 2985 }
748a9306 2986 if (!name) {
a0d0e21e 2987 GvCV(gv) = 0; /* Will remember elsewhere instead. */
748a9306
LW		 2988 SvFLAGS(cv) |= SVpcv_ANON;
2989 }
a0d0e21e 2990 return cv;
79072805
LW		 2991}
2992
2993void
2994newFORM(floor,op,block)
2995I32 floor;
2996OP *op;
2997OP *block;
2998{
2999 register CV *cv;
3000 char *name;
3001 GV *gv;
a0d0e21e 3002 I32 ix;
79072805
LW		 3003
3004 if (op)
463ee0b2 3005 name = SvPVx(cSVOP->op_sv, na);
79072805
LW		 3006 else
3007 name = "STDOUT";
85e6fe83 3008 gv = gv_fetchpv(name,TRUE, SVt_PVFM);
a0d0e21e 3009 SvMULTI_on(gv);
79072805
LW		 3010 if (cv = GvFORM(gv)) {
3011 if (dowarn) {
3012 line_t oldline = curcop->cop_line;
3013
3014 curcop->cop_line = copline;
3015 warn("Format %s redefined",name);
3016 curcop->cop_line = oldline;
3017 }
8990e307 3018 SvREFCNT_dec(cv);
79072805 3019 }
748a9306 3020 cv = compcv;
79072805 3021 GvFORM(gv) = cv;
8990e307 3022 CvGV(cv) = SvREFCNT_inc(gv);
79072805
LW		 3023 CvFILEGV(cv) = curcop->cop_filegv;
3024
a0d0e21e
LW		 3025 for (ix = AvFILL(comppad); ix > 0; ix--) {
3026 if (!SvPADMY(curpad[ix]))
3027 SvPADTMP_on(curpad[ix]);
3028 }
3029
79072805
LW		 3030 CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
3031 CvSTART(cv) = LINKLIST(CvROOT(cv));
3032 CvROOT(cv)->op_next = 0;
3033 peep(CvSTART(cv));
79072805
LW		 3034 FmLINES(cv) = 0;
3035 op_free(op);
3036 copline = NOLINE;
8990e307 3037 LEAVE_SCOPE(floor);
79072805
LW		 3038}
3039
3040OP *
79072805
LW		 3041newANONLIST(op)
3042OP* op;
3043{
93a17b20 3044 return newUNOP(OP_REFGEN, 0,
a0d0e21e 3045 mod(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN));
79072805
LW		 3046}
3047
3048OP *
3049newANONHASH(op)
3050OP* op;
3051{
93a17b20 3052 return newUNOP(OP_REFGEN, 0,
a0d0e21e
LW		 3053 mod(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN));
3054}
3055
3056OP *
4633a7c4 3057newANONSUB(floor, proto, block)
a0d0e21e 3058I32 floor;
4633a7c4 3059OP *proto;
a0d0e21e
LW		 3060OP *block;
3061{
3062 return newUNOP(OP_REFGEN, 0,
4633a7c4 3063 newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, proto, block)));
79072805
LW		 3064}
3065
3066OP *
3067oopsAV(o)
3068OP *o;
3069{
ed6116ce
LW		 3070 switch (o->op_type) {
3071 case OP_PADSV:
3072 o->op_type = OP_PADAV;
3073 o->op_ppaddr = ppaddr[OP_PADAV];
3074 return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV);
3075
3076 case OP_RV2SV:
79072805
LW		 3077 o->op_type = OP_RV2AV;
3078 o->op_ppaddr = ppaddr[OP_RV2AV];
3079 ref(o, OP_RV2AV);
ed6116ce
LW		 3080 break;
3081
3082 default:
79072805 3083 warn("oops: oopsAV");
ed6116ce
LW		 3084 break;
3085 }
79072805
LW		 3086 return o;
3087}
3088
3089OP *
3090oopsHV(o)
3091OP *o;
3092{
ed6116ce
LW		 3093 switch (o->op_type) {
3094 case OP_PADSV:
3095 case OP_PADAV:
3096 o->op_type = OP_PADHV;
3097 o->op_ppaddr = ppaddr[OP_PADHV];
3098 return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV);
3099
3100 case OP_RV2SV:
3101 case OP_RV2AV:
79072805
LW		 3102 o->op_type = OP_RV2HV;
3103 o->op_ppaddr = ppaddr[OP_RV2HV];
3104 ref(o, OP_RV2HV);
ed6116ce
LW		 3105 break;
3106
3107 default:
79072805 3108 warn("oops: oopsHV");
ed6116ce
LW		 3109 break;
3110 }
79072805
LW		 3111 return o;
3112}
3113
3114OP *
3115newAVREF(o)
3116OP *o;
3117{
ed6116ce
LW		 3118 if (o->op_type == OP_PADANY) {
3119 o->op_type = OP_PADAV;
3120 o->op_ppaddr = ppaddr[OP_PADAV];
93a17b20 3121 return o;
ed6116ce 3122 }
79072805
LW		 3123 return newUNOP(OP_RV2AV, 0, scalar(o));
3124}
3125
3126OP *
a0d0e21e
LW		 3127newGVREF(type,o)
3128I32 type;
79072805
LW		 3129OP *o;
3130{
a0d0e21e
LW		 3131 if (type == OP_MAPSTART)
3132 return newUNOP(OP_NULL, 0, o);
748a9306 3133 return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
79072805
LW		 3134}
3135
3136OP *
3137newHVREF(o)
3138OP *o;
3139{
ed6116ce
LW		 3140 if (o->op_type == OP_PADANY) {
3141 o->op_type = OP_PADHV;
3142 o->op_ppaddr = ppaddr[OP_PADHV];
93a17b20 3143 return o;
ed6116ce 3144 }
79072805
LW		 3145 return newUNOP(OP_RV2HV, 0, scalar(o));
3146}
3147
3148OP *
3149oopsCV(o)
3150OP *o;
3151{
463ee0b2 3152 croak("NOT IMPL LINE %d",__LINE__);
79072805
LW		 3153 /* STUB */
3154 return o;
3155}
3156
3157OP *
c07a80fd 3158newCVREF(flags, o)
3159I32 flags;
79072805
LW		 3160OP *o;
3161{
c07a80fd 3162 return newUNOP(OP_RV2CV, flags, scalar(o));
79072805
LW		 3163}
3164
3165OP *
3166newSVREF(o)
3167OP *o;
3168{
ed6116ce
LW		 3169 if (o->op_type == OP_PADANY) {
3170 o->op_type = OP_PADSV;
3171 o->op_ppaddr = ppaddr[OP_PADSV];
93a17b20 3172 return o;
ed6116ce 3173 }
79072805
LW		 3174 return newUNOP(OP_RV2SV, 0, scalar(o));
3175}
3176
3177/* Check routines. */
3178
3179OP *
79072805
LW		 3180ck_concat(op)
3181OP *op;
3182{
3183 if (cUNOP->op_first->op_type == OP_CONCAT)
3184 op->op_flags |= OPf_STACKED;
3185 return op;
3186}
3187
3188OP *
a0d0e21e 3189ck_spair(op)
79072805
LW		 3190OP *op;
3191{
3192 if (op->op_flags & OPf_KIDS) {
3193 OP* newop;
a0d0e21e 3194 OP* kid;
463ee0b2 3195 op = modkids(ck_fun(op), op->op_type);
a0d0e21e
LW		 3196 kid = cUNOP->op_first;
3197 newop = kUNOP->op_first->op_sibling;
3198 if (newop &&
3199 (newop->op_sibling ||
3200 !(opargs[newop->op_type] & OA_RETSCALAR) ||
3201 newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
3202 newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
3203
79072805 3204 return op;
a0d0e21e
LW		 3205 }
3206 op_free(kUNOP->op_first);
3207 kUNOP->op_first = newop;
3208 }
3209 op->op_ppaddr = ppaddr[++op->op_type];
3210 return ck_fun(op);
3211}
3212
3213OP *
3214ck_delete(op)
3215OP *op;
3216{
3217 op = ck_fun(op);
3218 if (op->op_flags & OPf_KIDS) {
3219 OP *kid = cUNOP->op_first;
3220 if (kid->op_type != OP_HELEM)
c07a80fd 3221 croak("%s argument is not a HASH element", op_desc[op->op_type]);
a0d0e21e 3222 null(kid);
79072805 3223 }
79072805
LW		 3224 return op;
3225}
3226
3227OP *
3228ck_eof(op)
3229OP *op;
3230{
3231 I32 type = op->op_type;
3232
8990e307
LW		 3233 if (op->op_flags & OPf_KIDS) {
3234 if (cLISTOP->op_first->op_type == OP_STUB) {
3235 op_free(op);
3236 op = newUNOP(type, OPf_SPECIAL,
85e6fe83 3237 newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV)));
8990e307 3238 }
79072805 3239 return ck_fun(op);
79072805
LW		 3240 }
3241 return op;
3242}
3243
3244OP *
3245ck_eval(op)
3246OP *op;
3247{
85e6fe83 3248 hints |= HINT_BLOCK_SCOPE;
79072805
LW		 3249 if (op->op_flags & OPf_KIDS) {
3250 SVOP *kid = (SVOP*)cUNOP->op_first;
3251
93a17b20
LW		 3252 if (!kid) {
3253 op->op_flags &= ~OPf_KIDS;
8990e307 3254 null(op);
79072805
LW		 3255 }
3256 else if (kid->op_type == OP_LINESEQ) {
3257 LOGOP *enter;
3258
3259 kid->op_next = op->op_next;
3260 cUNOP->op_first = 0;
3261 op_free(op);
3262
3263 Newz(1101, enter, 1, LOGOP);
3264 enter->op_type = OP_ENTERTRY;
3265 enter->op_ppaddr = ppaddr[OP_ENTERTRY];
3266 enter->op_private = 0;
3267
3268 /* establish postfix order */
3269 enter->op_next = (OP*)enter;
3270
463ee0b2 3271 op = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
79072805
LW		 3272 op->op_type = OP_LEAVETRY;
3273 op->op_ppaddr = ppaddr[OP_LEAVETRY];
3274 enter->op_other = op;
3275 return op;
3276 }
3277 }
3278 else {
3279 op_free(op);
3280 op = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3281 }
a0d0e21e 3282 op->op_targ = (PADOFFSET)hints;
79072805
LW		 3283 return op;
3284}
3285
3286OP *
3287ck_exec(op)
3288OP *op;
3289{
3290 OP *kid;
79072805 3291 if (op->op_flags & OPf_STACKED) {
463ee0b2 3292 op = ck_fun(op);
79072805 3293 kid = cUNOP->op_first->op_sibling;
8990e307
LW		 3294 if (kid->op_type == OP_RV2GV)
3295 null(kid);
79072805 3296 }
463ee0b2
LW		 3297 else
3298 op = listkids(op);
79072805
LW		 3299 return op;
3300}
3301
3302OP *
3303ck_gvconst(o)
3304register OP *o;
3305{
3306 o = fold_constants(o);
3307 if (o->op_type == OP_CONST)
3308 o->op_type = OP_GV;
3309 return o;
3310}
3311
3312OP *
3313ck_rvconst(op)
3314register OP *op;
3315{
3316 SVOP *kid = (SVOP*)cUNOP->op_first;
85e6fe83 3317
c07a80fd 3318 op->op_private |= (hints & HINT_STRICT_REFS);
79072805 3319 if (kid->op_type == OP_CONST) {
748a9306 3320 int iscv = (op->op_type==OP_RV2CV)*2;
a0d0e21e 3321 GV *gv = 0;
79072805 3322 kid->op_type = OP_GV;
a0d0e21e 3323 for (gv = 0; !gv; iscv++) {
748a9306
LW		 3324 /*
3325 * This is a little tricky. We only want to add the symbol if we
3326 * didn't add it in the lexer. Otherwise we get duplicate strict
3327 * warnings. But if we didn't add it in the lexer, we must at
3328 * least pretend like we wanted to add it even if it existed before,
3329 * or we get possible typo warnings. OPpCONST_ENTERED says
3330 * whether the lexer already added THIS instance of this symbol.
3331 */
a0d0e21e 3332 gv = gv_fetchpv(SvPVx(kid->op_sv, na),
748a9306 3333 iscv | !(kid->op_private & OPpCONST_ENTERED),
a0d0e21e
LW		 3334 iscv
3335 ? SVt_PVCV
3336 : op->op_type == OP_RV2SV
3337 ? SVt_PV
3338 : op->op_type == OP_RV2AV
3339 ? SVt_PVAV
3340 : op->op_type == OP_RV2HV
3341 ? SVt_PVHV
3342 : SVt_PVGV);
3343 }
adbc6bb1 3344 SvREFCNT_dec(kid->op_sv);
a0d0e21e 3345 kid->op_sv = SvREFCNT_inc(gv);
79072805
LW		 3346 }
3347 return op;
3348}
3349
3350OP *
3351ck_formline(op)
3352OP *op;
3353{
3354 return ck_fun(op);
3355}
3356
3357OP *
3358ck_ftst(op)
3359OP *op;
3360{
3361 I32 type = op->op_type;
3362
a0d0e21e 3363 if (op->op_flags & OPf_REF)
79072805
LW		 3364 return op;
3365
3366 if (op->op_flags & OPf_KIDS) {
3367 SVOP *kid = (SVOP*)cUNOP->op_first;
3368
3369 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
a0d0e21e 3370 OP *newop = newGVOP(type, OPf_REF,
85e6fe83 3371 gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
79072805
LW		 3372 op_free(op);
3373 return newop;
3374 }
3375 }
3376 else {
3377 op_free(op);
3378 if (type == OP_FTTTY)
a0d0e21e 3379 return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
85e6fe83 3380 SVt_PVIO));
79072805
LW		 3381 else
3382 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3383 }
3384 return op;
3385}
3386
3387OP *
3388ck_fun(op)
3389OP *op;
3390{
3391 register OP *kid;
3392 OP **tokid;
3393 OP *sibl;
3394 I32 numargs = 0;
a0d0e21e
LW		 3395 int type = op->op_type;
3396 register I32 oa = opargs[type] >> OASHIFT;
79072805
LW		 3397
3398 if (op->op_flags & OPf_STACKED) {
3399 if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
3400 oa &= ~OA_OPTIONAL;
3401 else
3402 return no_fh_allowed(op);
3403 }
3404
3405 if (op->op_flags & OPf_KIDS) {
3406 tokid = &cLISTOP->op_first;
3407 kid = cLISTOP->op_first;
8990e307
LW		 3408 if (kid->op_type == OP_PUSHMARK ||
3409 kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
3410 {
79072805
LW		 3411 tokid = &kid->op_sibling;
3412 kid = kid->op_sibling;
3413 }
a0d0e21e
LW		 3414 if (!kid && opargs[type] & OA_DEFGV)
3415 *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
79072805
LW		 3416
3417 while (oa && kid) {
3418 numargs++;
3419 sibl = kid->op_sibling;
3420 switch (oa & 7) {
3421 case OA_SCALAR:
3422 scalar(kid);
3423 break;
3424 case OA_LIST:
3425 if (oa < 16) {
3426 kid = 0;
3427 continue;
3428 }
3429 else
3430 list(kid);
3431 break;
3432 case OA_AVREF:
3433 if (kid->op_type == OP_CONST &&
3434 (kid->op_private & OPpCONST_BARE)) {
463ee0b2 3435 char *name = SvPVx(((SVOP*)kid)->op_sv, na);
79072805 3436 OP *newop = newAVREF(newGVOP(OP_GV, 0,
85e6fe83 3437 gv_fetchpv(name, TRUE, SVt_PVAV) ));
463ee0b2
LW		 3438 if (dowarn)
3439 warn("Array @%s missing the @ in argument %d of %s()",
c07a80fd 3440 name, numargs, op_desc[type]);
79072805
LW		 3441 op_free(kid);
3442 kid = newop;
3443 kid->op_sibling = sibl;
3444 *tokid = kid;
3445 }
8990e307 3446 else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
c07a80fd 3447 bad_type(numargs, "array", op_desc[op->op_type], kid);
a0d0e21e 3448 mod(kid, type);
79072805
LW		 3449 break;
3450 case OA_HVREF:
3451 if (kid->op_type == OP_CONST &&
3452 (kid->op_private & OPpCONST_BARE)) {
463ee0b2 3453 char *name = SvPVx(((SVOP*)kid)->op_sv, na);
79072805 3454 OP *newop = newHVREF(newGVOP(OP_GV, 0,
85e6fe83 3455 gv_fetchpv(name, TRUE, SVt_PVHV) ));
463ee0b2
LW		 3456 if (dowarn)
3457 warn("Hash %%%s missing the %% in argument %d of %s()",
c07a80fd 3458 name, numargs, op_desc[type]);
79072805
LW		 3459 op_free(kid);
3460 kid = newop;
3461 kid->op_sibling = sibl;
3462 *tokid = kid;
3463 }
8990e307 3464 else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
c07a80fd 3465 bad_type(numargs, "hash", op_desc[op->op_type], kid);
a0d0e21e 3466 mod(kid, type);
79072805
LW		 3467 break;
3468 case OA_CVREF:
3469 {
a0d0e21e 3470 OP *newop = newUNOP(OP_NULL, 0, kid);
79072805
LW		 3471 kid->op_sibling = 0;
3472 linklist(kid);
3473 newop->op_next = newop;
3474 kid = newop;
3475 kid->op_sibling = sibl;
3476 *tokid = kid;
3477 }
3478 break;
3479 case OA_FILEREF:
3480 if (kid->op_type != OP_GV) {
3481 if (kid->op_type == OP_CONST &&
3482 (kid->op_private & OPpCONST_BARE)) {
3483 OP *newop = newGVOP(OP_GV, 0,
85e6fe83
LW		 3484 gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE,
3485 SVt_PVIO) );
79072805
LW		 3486 op_free(kid);
3487 kid = newop;
3488 }
3489 else {
3490 kid->op_sibling = 0;
3491 kid = newUNOP(OP_RV2GV, 0, scalar(kid));
3492 }
3493 kid->op_sibling = sibl;
3494 *tokid = kid;
3495 }
3496 scalar(kid);
3497 break;
3498 case OA_SCALARREF:
a0d0e21e 3499 mod(scalar(kid), type);
79072805
LW		 3500 break;
3501 }
3502 oa >>= 4;
3503 tokid = &kid->op_sibling;
3504 kid = kid->op_sibling;
3505 }
c07a80fd 3506 op->op_private |= numargs;
79072805 3507 if (kid)
c07a80fd 3508 return too_many_arguments(op,op_desc[op->op_type]);
79072805
LW		 3509 listkids(op);
3510 }
a0d0e21e
LW		 3511 else if (opargs[type] & OA_DEFGV) {
3512 op_free(op);
3513 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3514 }
3515
79072805
LW		 3516 if (oa) {
3517 while (oa & OA_OPTIONAL)
3518 oa >>= 4;
3519 if (oa && oa != OA_LIST)
c07a80fd 3520 return too_few_arguments(op,op_desc[op->op_type]);
79072805
LW		 3521 }
3522 return op;
3523}
3524
3525OP *
3526ck_glob(op)
3527OP *op;
3528{
a0d0e21e
LW		 3529 GV *gv = newGVgen("main");
3530 gv_IOadd(gv);
79072805
LW		 3531 append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
3532 scalarkids(op);
a0d0e21e 3533 return ck_fun(op);
79072805
LW		 3534}
3535
3536OP *
3537ck_grep(op)
3538OP *op;
3539{
3540 LOGOP *gwop;
3541 OP *kid;
a0d0e21e 3542 OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
79072805 3543
a0d0e21e
LW		 3544 op->op_ppaddr = ppaddr[OP_GREPSTART];
3545 Newz(1101, gwop, 1, LOGOP);
3546
93a17b20 3547 if (op->op_flags & OPf_STACKED) {
a0d0e21e 3548 OP* k;
93a17b20 3549 op = ck_sort(op);
8e07c86e 3550 kid = cLISTOP->op_first->op_sibling;
a0d0e21e
LW		 3551 for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) {
3552 kid = k;
3553 }
3554 kid->op_next = (OP*)gwop;
93a17b20
LW		 3555 op->op_flags &= ~OPf_STACKED;
3556 }
a0d0e21e
LW		 3557 kid = cLISTOP->op_first->op_sibling;
3558 if (type == OP_MAPWHILE)
3559 list(kid);
3560 else
3561 scalar(kid);
79072805
LW		 3562 op = ck_fun(op);
3563 if (error_count)
3564 return op;
a0d0e21e 3565 kid = cLISTOP->op_first->op_sibling;
79072805 3566 if (kid->op_type != OP_NULL)
463ee0b2 3567 croak("panic: ck_grep");
79072805
LW		 3568 kid = kUNOP->op_first;
3569
a0d0e21e
LW		 3570 gwop->op_type = type;
3571 gwop->op_ppaddr = ppaddr[type];
3572 gwop->op_first = listkids(op);
79072805
LW		 3573 gwop->op_flags |= OPf_KIDS;
3574 gwop->op_private = 1;
3575 gwop->op_other = LINKLIST(kid);
a0d0e21e 3576 gwop->op_targ = pad_alloc(type, SVs_PADTMP);
79072805
LW		 3577 kid->op_next = (OP*)gwop;
3578
a0d0e21e
LW		 3579 kid = cLISTOP->op_first->op_sibling;
3580 if (!kid || !kid->op_sibling)
c07a80fd 3581 return too_few_arguments(op,op_desc[op->op_type]);
a0d0e21e
LW		 3582 for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
3583 mod(kid, OP_GREPSTART);
3584
79072805
LW		 3585 return (OP*)gwop;
3586}
3587
3588OP *
3589ck_index(op)
3590OP *op;
3591{
3592 if (op->op_flags & OPf_KIDS) {
3593 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
3594 if (kid && kid->op_type == OP_CONST)
3595 fbm_compile(((SVOP*)kid)->op_sv, 0);
3596 }
3597 return ck_fun(op);
3598}
3599
3600OP *
3601ck_lengthconst(op)
3602OP *op;
3603{
3604 /* XXX length optimization goes here */
a0d0e21e 3605 return ck_fun(op);
79072805
LW		 3606}
3607
3608OP *
3609ck_lfun(op)
3610OP *op;
3611{
463ee0b2 3612 return modkids(ck_fun(op), op->op_type);
79072805
LW		 3613}
3614
3615OP *
8990e307
LW		 3616ck_rfun(op)
3617OP *op;
3618{
3619 return refkids(ck_fun(op), op->op_type);
3620}
3621
3622OP *
79072805
LW		 3623ck_listiob(op)
3624OP *op;
3625{
3626 register OP *kid;
3627
3628 kid = cLISTOP->op_first;
3629 if (!kid) {
8990e307 3630 op = force_list(op);
79072805
LW		 3631 kid = cLISTOP->op_first;
3632 }
3633 if (kid->op_type == OP_PUSHMARK)
3634 kid = kid->op_sibling;
3635 if (kid && op->op_flags & OPf_STACKED)
3636 kid = kid->op_sibling;
3637 else if (kid && !kid->op_sibling) { /* print HANDLE; */
3638 if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
3639 op->op_flags |= OPf_STACKED; /* make it a filehandle */
748a9306 3640 kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
79072805
LW		 3641 cLISTOP->op_first->op_sibling = kid;
3642 cLISTOP->op_last = kid;
3643 kid = kid->op_sibling;
3644 }
3645 }
3646
3647 if (!kid)
3648 append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3649
3650 return listkids(op);
3651}
3652
3653OP *
3654ck_match(op)
3655OP *op;
3656{
3657 cPMOP->op_pmflags |= PMf_RUNTIME;
4633a7c4 3658 cPMOP->op_pmpermflags |= PMf_RUNTIME;
79072805
LW		 3659 return op;
3660}
3661
3662OP *
3663ck_null(op)
3664OP *op;
3665{
3666 return op;
3667}
3668
3669OP *
3670ck_repeat(op)
3671OP *op;
3672{
3673 if (cBINOP->op_first->op_flags & OPf_PARENS) {
c07a80fd 3674 op->op_private |= OPpREPEAT_DOLIST;
8990e307 3675 cBINOP->op_first = force_list(cBINOP->op_first);
79072805
LW		 3676 }
3677 else
3678 scalar(op);
3679 return op;
3680}
3681
3682OP *
8990e307
LW		 3683ck_require(op)
3684OP *op;
3685{
a0d0e21e 3686 if (op->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */
8990e307
LW		 3687 SVOP *kid = (SVOP*)cUNOP->op_first;
3688
3689 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
8990e307 3690 char *s;
a0d0e21e
LW		 3691 for (s = SvPVX(kid->op_sv); *s; s++) {
3692 if (*s == ':' && s[1] == ':') {
3693 *s = '/';
1aef975c 3694 Move(s+2, s+1, strlen(s+2)+1, char);
a0d0e21e
LW		 3695 --SvCUR(kid->op_sv);
3696 }
8990e307 3697 }
a0d0e21e 3698 sv_catpvn(kid->op_sv, ".pm", 3);
8990e307
LW		 3699 }
3700 }
3701 return ck_fun(op);
3702}
3703
3704OP *
79072805
LW		 3705ck_retarget(op)
3706OP *op;
3707{
463ee0b2 3708 croak("NOT IMPL LINE %d",__LINE__);
79072805
LW		 3709 /* STUB */
3710 return op;
3711}
3712
3713OP *
3714ck_select(op)
3715OP *op;
3716{
c07a80fd 3717 OP* kid;
79072805 3718 if (op->op_flags & OPf_KIDS) {
c07a80fd 3719 kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
2304df62 3720 if (kid && kid->op_sibling) {
79072805
LW		 3721 op->op_type = OP_SSELECT;
3722 op->op_ppaddr = ppaddr[OP_SSELECT];
3723 op = ck_fun(op);
3724 return fold_constants(op);
3725 }
3726 }
c07a80fd 3727 op = ck_fun(op);
3728 kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
3729 if (kid && kid->op_type == OP_RV2GV)
3730 kid->op_private &= ~HINT_STRICT_REFS;
3731 return op;
79072805
LW		 3732}
3733
3734OP *
3735ck_shift(op)
3736OP *op;
3737{
3738 I32 type = op->op_type;
3739
3740 if (!(op->op_flags & OPf_KIDS)) {
3741 op_free(op);
3742 return newUNOP(type, 0,
3743 scalar(newUNOP(OP_RV2AV, 0,
3744 scalar(newGVOP(OP_GV, 0,
85e6fe83 3745 gv_fetchpv((subline ? "_" : "ARGV"), TRUE, SVt_PVAV) )))));
79072805 3746 }
463ee0b2 3747 return scalar(modkids(ck_fun(op), type));
79072805
LW		 3748}
3749
3750OP *
3751ck_sort(op)
3752OP *op;
3753{
3754 if (op->op_flags & OPf_STACKED) {
3755 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
463ee0b2
LW		 3756 OP *k;
3757 kid = kUNOP->op_first; /* get past rv2gv */
79072805 3758
463ee0b2 3759 if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
79072805 3760 linklist(kid);
463ee0b2
LW		 3761 if (kid->op_type == OP_SCOPE) {
3762 k = kid->op_next;
3763 kid->op_next = 0;
79072805 3764 }
463ee0b2 3765 else if (kid->op_type == OP_LEAVE) {
748a9306
LW		 3766 if (op->op_type == OP_SORT) {
3767 null(kid); /* wipe out leave */
3768 kid->op_next = kid;
463ee0b2 3769
748a9306
LW		 3770 for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
3771 if (k->op_next == kid)
3772 k->op_next = 0;
3773 }
463ee0b2 3774 }
748a9306
LW		 3775 else
3776 kid->op_next = 0; /* just disconnect the leave */
a0d0e21e 3777 k = kLISTOP->op_first;
463ee0b2 3778 }
a0d0e21e
LW		 3779 peep(k);
3780
463ee0b2 3781 kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
8990e307 3782 null(kid); /* wipe out rv2gv */
a0d0e21e
LW		 3783 if (op->op_type == OP_SORT)
3784 kid->op_next = kid;
3785 else
3786 kid->op_next = k;
79072805
LW		 3787 op->op_flags |= OPf_SPECIAL;
3788 }
3789 }
3790 return op;
3791}
3792
3793OP *
3794ck_split(op)
3795OP *op;
3796{
3797 register OP *kid;
ed6116ce 3798 PMOP* pm;
79072805
LW		 3799
3800 if (op->op_flags & OPf_STACKED)
3801 return no_fh_allowed(op);
3802
79072805 3803 kid = cLISTOP->op_first;
8990e307 3804 if (kid->op_type != OP_NULL)
463ee0b2 3805 croak("panic: ck_split");
8990e307
LW		 3806 kid = kid->op_sibling;
3807 op_free(cLISTOP->op_first);
3808 cLISTOP->op_first = kid;
85e6fe83 3809 if (!kid) {
8990e307 3810 cLISTOP->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
85e6fe83
LW		 3811 cLISTOP->op_last = kid; /* There was only one element previously */
3812 }
79072805
LW		 3813
3814 if (kid->op_type != OP_MATCH) {
3815 OP *sibl = kid->op_sibling;
463ee0b2 3816 kid->op_sibling = 0;
79072805
LW		 3817 kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
3818 if (cLISTOP->op_first == cLISTOP->op_last)
3819 cLISTOP->op_last = kid;
3820 cLISTOP->op_first = kid;
3821 kid->op_sibling = sibl;
3822 }
ed6116ce
LW		 3823 pm = (PMOP*)kid;
3824 if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
8990e307 3825 SvREFCNT_dec(pm->op_pmshort); /* can't use substring to optimize */
ed6116ce
LW		 3826 pm->op_pmshort = 0;
3827 }
79072805
LW		 3828
3829 kid->op_type = OP_PUSHRE;
3830 kid->op_ppaddr = ppaddr[OP_PUSHRE];
3831 scalar(kid);
3832
3833 if (!kid->op_sibling)
3834 append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3835
3836 kid = kid->op_sibling;
3837 scalar(kid);
3838
3839 if (!kid->op_sibling)
3840 append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0)));
3841
3842 kid = kid->op_sibling;
3843 scalar(kid);
3844
3845 if (kid->op_sibling)
c07a80fd 3846 return too_many_arguments(op,op_desc[op->op_type]);
79072805
LW		 3847
3848 return op;
3849}
3850
3851OP *
3852ck_subr(op)
3853OP *op;
3854{
4633a7c4
LW		 3855 OP *prev = ((cUNOP->op_first->op_sibling)
3856 ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first;
3857 OP *o = prev->op_sibling;
3858 OP *cvop;
3859 char *proto = 0;
3860 CV *cv = 0;
3861 int optional = 0;
3862 I32 arg = 0;
3863
3864 for (cvop = o; cvop->op_sibling; cvop = cvop->op_sibling) ;
3865 if (cvop->op_type == OP_RV2CV) {
3866 SVOP* tmpop;
c07a80fd 3867 op->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
4633a7c4
LW		 3868 null(cvop); /* disable rv2cv */
3869 tmpop = (SVOP*)((UNOP*)cvop)->op_first;
3870 if (tmpop->op_type == OP_GV) {
3871 cv = GvCV(tmpop->op_sv);
c07a80fd 3872 if (cv && SvPOK(cv) && !(op->op_private & OPpENTERSUB_AMPER))
4633a7c4
LW		 3873 proto = SvPV((SV*)cv,na);
3874 }
3875 }
c07a80fd 3876 op->op_private |= (hints & HINT_STRICT_REFS);
8990e307 3877 if (perldb && curstash != debstash)
c07a80fd 3878 op->op_private |= OPpENTERSUB_DB;
4633a7c4
LW		 3879 while (o != cvop) {
3880 if (proto) {
3881 switch (*proto) {
3882 case '\0':
3883 return too_many_arguments(op, CvNAME(cv));
3884 case ';':
3885 optional = 1;
3886 proto++;
3887 continue;
3888 case '$':
3889 proto++;
3890 arg++;
3891 scalar(o);
3892 break;
3893 case '%':
3894 case '@':
3895 list(o);
3896 arg++;
3897 break;
3898 case '&':
3899 proto++;
3900 arg++;
3901 if (o->op_type != OP_REFGEN && o->op_type != OP_UNDEF)
3902 bad_type(arg, "block", CvNAME(cv), o);
3903 break;
3904 case '*':
3905 proto++;
3906 arg++;
3907 if (o->op_type == OP_RV2GV)
3908 goto wrapref;
3909 {
3910 OP* kid = o;
3911 o = newUNOP(OP_RV2GV, 0, kid);
3912 o->op_sibling = kid->op_sibling;
3913 kid->op_sibling = 0;
3914 prev->op_sibling = o;
3915 }
3916 goto wrapref;
3917 case '\\':
3918 proto++;
3919 arg++;
3920 switch (*proto++) {
3921 case '*':
3922 if (o->op_type != OP_RV2GV)
3923 bad_type(arg, "symbol", CvNAME(cv), o);
3924 goto wrapref;
3925 case '&':
3926 if (o->op_type != OP_RV2CV)
3927 bad_type(arg, "sub", CvNAME(cv), o);
3928 goto wrapref;
3929 case '$':
3930 if (o->op_type != OP_RV2SV && o->op_type != OP_PADSV)
3931 bad_type(arg, "scalar", CvNAME(cv), o);
3932 goto wrapref;
3933 case '@':
3934 if (o->op_type != OP_RV2AV && o->op_type != OP_PADAV)
3935 bad_type(arg, "array", CvNAME(cv), o);
3936 goto wrapref;
3937 case '%':
3938 if (o->op_type != OP_RV2HV && o->op_type != OP_PADHV)
3939 bad_type(arg, "hash", CvNAME(cv), o);
3940 wrapref:
3941 {
3942 OP* kid = o;
3943 o = newUNOP(OP_REFGEN, 0, kid);
3944 o->op_sibling = kid->op_sibling;
3945 kid->op_sibling = 0;
3946 prev->op_sibling = o;
3947 }
3948 break;
3949 default: goto oops;
3950 }
3951 break;
3952 default:
3953 oops:
3954 croak("Malformed prototype for %s: %s",
3955 CvNAME(cv),SvPV((SV*)cv,na));
3956 }
3957 }
3958 else
3959 list(o);
a0d0e21e 3960 mod(o, OP_ENTERSUB);
4633a7c4
LW		 3961 prev = o;
3962 o = o->op_sibling;
3963 }
3964 if (proto && !optional && *proto == '$')
3965 return too_few_arguments(op, CvNAME(cv));
79072805
LW		 3966 return op;
3967}
3968
3969OP *
8990e307
LW		 3970ck_svconst(op)
3971OP *op;
3972{
3973 SvREADONLY_on(cSVOP->op_sv);
3974 return op;
3975}
3976
3977OP *
79072805
LW		 3978ck_trunc(op)
3979OP *op;
3980{
3981 if (op->op_flags & OPf_KIDS) {
3982 SVOP *kid = (SVOP*)cUNOP->op_first;
3983
a0d0e21e
LW		 3984 if (kid->op_type == OP_NULL)
3985 kid = (SVOP*)kid->op_sibling;
3986 if (kid &&
3987 kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
79072805
LW		 3988 op->op_flags |= OPf_SPECIAL;
3989 }
3990 return ck_fun(op);
3991}
3992
463ee0b2
LW		 3993/* A peephole optimizer. We visit the ops in the order they're to execute. */
3994
79072805 3995void
a0d0e21e
LW		 3996peep(o)
3997register OP* o;
79072805
LW		 3998{
3999 register OP* oldop = 0;
a0d0e21e 4000 if (!o || o->op_seq)
79072805 4001 return;
a0d0e21e
LW		 4002 ENTER;
4003 SAVESPTR(op);
4004 SAVESPTR(curcop);
4005 for (; o; o = o->op_next) {
4006 if (o->op_seq)
4007 break;
c07a80fd 4008 if (!op_seqmax)
4009 op_seqmax++;
a0d0e21e
LW		 4010 op = o;
4011 switch (o->op_type) {
4012 case OP_NEXTSTATE:
4013 case OP_DBSTATE:
4014 curcop = ((COP*)o); /* for warnings */
c07a80fd 4015 o->op_seq = op_seqmax++;
a0d0e21e
LW		 4016 break;
4017
4018 case OP_CONCAT:
4019 case OP_CONST:
4020 case OP_JOIN:
4021 case OP_UC:
4022 case OP_UCFIRST:
4023 case OP_LC:
4024 case OP_LCFIRST:
4025 case OP_QUOTEMETA:
4026 if (o->op_next->op_type == OP_STRINGIFY)
4027 null(o->op_next);
c07a80fd 4028 o->op_seq = op_seqmax++;
a0d0e21e 4029 break;
8990e307 4030 case OP_STUB:
a0d0e21e 4031 if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) {
c07a80fd 4032 o->op_seq = op_seqmax++;
8990e307
LW		 4033 break; /* Scalar stub must produce undef. List stub is noop */
4034 }
748a9306 4035 goto nothin;
79072805 4036 case OP_NULL:
748a9306
LW		 4037 if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
4038 curcop = ((COP*)op);
4039 goto nothin;
79072805 4040 case OP_SCALAR:
93a17b20 4041 case OP_LINESEQ:
463ee0b2 4042 case OP_SCOPE:
748a9306 4043 nothin:
a0d0e21e
LW		 4044 if (oldop && o->op_next) {
4045 oldop->op_next = o->op_next;
79072805
LW		 4046 continue;
4047 }
c07a80fd 4048 o->op_seq = op_seqmax++;
79072805
LW		 4049 break;
4050
4051 case OP_GV:
a0d0e21e
LW		 4052 if (o->op_next->op_type == OP_RV2SV) {
4053 if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) {
4054 null(o->op_next);
4055 o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
4056 o->op_next = o->op_next->op_next;
4057 o->op_type = OP_GVSV;
4058 o->op_ppaddr = ppaddr[OP_GVSV];
8990e307
LW		 4059 }
4060 }
a0d0e21e
LW		 4061 else if (o->op_next->op_type == OP_RV2AV) {
4062 OP* pop = o->op_next->op_next;
4063 IV i;
8990e307 4064 if (pop->op_type == OP_CONST &&
a0d0e21e 4065 (op = pop->op_next) &&
8990e307 4066 pop->op_next->op_type == OP_AELEM &&
a0d0e21e
LW		 4067 !(pop->op_next->op_private &
4068 (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) &&
4069 (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
4070 <= 255 &&
8990e307
LW		 4071 i >= 0)
4072 {
748a9306 4073 SvREFCNT_dec(((SVOP*)pop)->op_sv);
a0d0e21e 4074 null(o->op_next);
8990e307
LW		 4075 null(pop->op_next);
4076 null(pop);
a0d0e21e
LW		 4077 o->op_flags |= pop->op_next->op_flags & OPf_MOD;
4078 o->op_next = pop->op_next->op_next;
4079 o->op_type = OP_AELEMFAST;
4080 o->op_ppaddr = ppaddr[OP_AELEMFAST];
4081 o->op_private = (U8)i;
4082 GvAVn((GV*)(((SVOP*)o)->op_sv));
8990e307 4083 }
79072805 4084 }
c07a80fd 4085 o->op_seq = op_seqmax++;
79072805
LW		 4086 break;
4087
a0d0e21e 4088 case OP_MAPWHILE:
79072805
LW		 4089 case OP_GREPWHILE:
4090 case OP_AND:
4091 case OP_OR:
c07a80fd 4092 o->op_seq = op_seqmax++;
79072805
LW		 4093 peep(cLOGOP->op_other);
4094 break;
4095
4096 case OP_COND_EXPR:
c07a80fd 4097 o->op_seq = op_seqmax++;
79072805
LW		 4098 peep(cCONDOP->op_true);
4099 peep(cCONDOP->op_false);
4100 break;
4101
4102 case OP_ENTERLOOP:
c07a80fd 4103 o->op_seq = op_seqmax++;
79072805
LW		 4104 peep(cLOOP->op_redoop);
4105 peep(cLOOP->op_nextop);
4106 peep(cLOOP->op_lastop);
4107 break;
4108
4109 case OP_MATCH:
4110 case OP_SUBST:
c07a80fd 4111 o->op_seq = op_seqmax++;
a0d0e21e 4112 peep(cPMOP->op_pmreplstart);
79072805
LW		 4113 break;
4114
a0d0e21e 4115 case OP_EXEC:
c07a80fd 4116 o->op_seq = op_seqmax++;
a0d0e21e
LW		 4117 if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
4118 if (o->op_next->op_sibling &&
4119 o->op_next->op_sibling->op_type != OP_DIE) {
4120 line_t oldline = curcop->cop_line;
4121
4122 curcop->cop_line = ((COP*)o->op_next)->cop_line;
4123 warn("Statement unlikely to be reached");
4124 warn("(Maybe you meant system() when you said exec()?)\n");
4125 curcop->cop_line = oldline;
4126 }
4127 }
4128 break;
79072805 4129 default:
c07a80fd 4130 o->op_seq = op_seqmax++;
79072805
LW		 4131 break;
4132 }
a0d0e21e 4133 oldop = o;
79072805 4134 }
a0d0e21e 4135 LEAVE;
79072805 4136}
Unnamed repository; edit this file 'description' to name the repository.