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