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