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