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