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