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