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