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