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