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