This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
support for C<exists &func> (from Spider Boardman)
[perl5.git] / op.c
CommitLineData
a0d0e21e 1/* op.c
79072805 2 *
4eb8286e 3 * Copyright (c) 1991-1999, 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"
864dbfa3 19#define PERL_IN_OP_C
79072805 20#include "perl.h"
77ca0c92 21#include "keywords.h"
79072805 22
b7dc083c 23/* #define PL_OP_SLAB_ALLOC */
7934575e
GS
24
25/* XXXXXX testing */
af365420
GS
26#ifdef USE_ITHREADS
27# define OP_REFCNT_LOCK NOOP
28# define OP_REFCNT_UNLOCK NOOP
29# define OpREFCNT_set(o,n) ((o)->op_targ = (n))
30# define OpREFCNT_dec(o) (--(o)->op_targ)
31#else
32# define OP_REFCNT_LOCK NOOP
33# define OP_REFCNT_UNLOCK NOOP
34# define OpREFCNT_set(o,n) NOOP
35# define OpREFCNT_dec(o) 0
36#endif
7934575e 37
b7dc083c
NIS
38#ifdef PL_OP_SLAB_ALLOC
39#define SLAB_SIZE 8192
40static char *PL_OpPtr = NULL;
41static int PL_OpSpace = 0;
42#define NewOp(m,var,c,type) do { if ((PL_OpSpace -= c*sizeof(type)) >= 0) \
43 var = (type *)(PL_OpPtr -= c*sizeof(type)); \
44 else \
45 var = (type *) Slab_Alloc(m,c*sizeof(type)); \
46 } while (0)
47
864dbfa3 48STATIC void *
cea2e8a9 49S_Slab_Alloc(pTHX_ int m, size_t sz)
b7dc083c
NIS
50{
51 Newz(m,PL_OpPtr,SLAB_SIZE,char);
52 PL_OpSpace = SLAB_SIZE - sz;
53 return PL_OpPtr += PL_OpSpace;
54}
76e3520e 55
b7dc083c
NIS
56#else
57#define NewOp(m, var, c, type) Newz(m, var, c, type)
58#endif
e50aee73 59/*
5dc0d613 60 * In the following definition, the ", Nullop" is just to make the compiler
a5f75d66 61 * think the expression is of the right type: croak actually does a Siglongjmp.
e50aee73 62 */
11343788 63#define CHECKOP(type,o) \
3280af22 64 ((PL_op_mask && PL_op_mask[type]) \
5dc0d613 65 ? ( op_free((OP*)o), \
cea2e8a9 66 Perl_croak(aTHX_ "%s trapped by operation mask", PL_op_desc[type]), \
28757baa 67 Nullop ) \
fc0dc3b3 68 : CALL_FPTR(PL_check[type])(aTHX_ (OP*)o))
e50aee73 69
c53d7c7d
HS
70#define PAD_MAX 999999999
71
76e3520e 72STATIC char*
cea2e8a9 73S_gv_ename(pTHX_ GV *gv)
4633a7c4 74{
2d8e6c8d 75 STRLEN n_a;
4633a7c4 76 SV* tmpsv = sv_newmortal();
46fc3d4c 77 gv_efullname3(tmpsv, gv, Nullch);
2d8e6c8d 78 return SvPV(tmpsv,n_a);
4633a7c4
LW
79}
80
76e3520e 81STATIC OP *
cea2e8a9 82S_no_fh_allowed(pTHX_ OP *o)
79072805 83{
cea2e8a9 84 yyerror(Perl_form(aTHX_ "Missing comma after first argument to %s function",
22c35a8c 85 PL_op_desc[o->op_type]));
11343788 86 return o;
79072805
LW
87}
88
76e3520e 89STATIC OP *
cea2e8a9 90S_too_few_arguments(pTHX_ OP *o, char *name)
79072805 91{
cea2e8a9 92 yyerror(Perl_form(aTHX_ "Not enough arguments for %s", name));
11343788 93 return o;
79072805
LW
94}
95
76e3520e 96STATIC OP *
cea2e8a9 97S_too_many_arguments(pTHX_ OP *o, char *name)
79072805 98{
cea2e8a9 99 yyerror(Perl_form(aTHX_ "Too many arguments for %s", name));
11343788 100 return o;
79072805
LW
101}
102
76e3520e 103STATIC void
cea2e8a9 104S_bad_type(pTHX_ I32 n, char *t, char *name, OP *kid)
8990e307 105{
cea2e8a9 106 yyerror(Perl_form(aTHX_ "Type of arg %d to %s must be %s (not %s)",
22c35a8c 107 (int)n, name, t, PL_op_desc[kid->op_type]));
8990e307
LW
108}
109
7a52d87a 110STATIC void
cea2e8a9 111S_no_bareword_allowed(pTHX_ OP *o)
7a52d87a 112{
5a844595
GS
113 qerror(Perl_mess(aTHX_
114 "Bareword \"%s\" not allowed while \"strict subs\" in use",
7766f137 115 SvPV_nolen(cSVOPo_sv)));
7a52d87a
GS
116}
117
79072805
LW
118/* "register" allocation */
119
120PADOFFSET
864dbfa3 121Perl_pad_allocmy(pTHX_ char *name)
93a17b20 122{
11343788 123 dTHR;
a0d0e21e
LW
124 PADOFFSET off;
125 SV *sv;
126
834a4ddd 127 if (!(
77ca0c92 128 PL_in_my == KEY_our ||
834a4ddd
LW
129 isALPHA(name[1]) ||
130 (PL_hints & HINT_UTF8 && (name[1] & 0xc0) == 0xc0) ||
77ca0c92 131 name[1] == '_' && (int)strlen(name) > 2 ))
834a4ddd 132 {
c4d0567e 133 if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
2b92dfce
GS
134 /* 1999-02-27 mjd@plover.com */
135 char *p;
136 p = strchr(name, '\0');
137 /* The next block assumes the buffer is at least 205 chars
138 long. At present, it's always at least 256 chars. */
139 if (p-name > 200) {
140 strcpy(name+200, "...");
141 p = name+199;
142 }
143 else {
144 p[1] = '\0';
145 }
146 /* Move everything else down one character */
147 for (; p-name > 2; p--)
148 *p = *(p-1);
46fc3d4c
PP
149 name[2] = toCTRL(name[1]);
150 name[1] = '^';
151 }
cea2e8a9 152 yyerror(Perl_form(aTHX_ "Can't use global %s in \"my\"",name));
a0d0e21e 153 }
599cee73 154 if (ckWARN(WARN_UNSAFE) && AvFILLp(PL_comppad_name) >= 0) {
3280af22
NIS
155 SV **svp = AvARRAY(PL_comppad_name);
156 for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_floor; off--) {
b1cb66bf 157 if ((sv = svp[off])
3280af22 158 && sv != &PL_sv_undef
c53d7c7d 159 && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
b1cb66bf
PP
160 && strEQ(name, SvPVX(sv)))
161 {
f472eb5c
GS
162 if (PL_in_my != KEY_our
163 || GvSTASH(sv) == (PL_curstash ? PL_curstash : PL_defstash))
164 {
165 Perl_warner(aTHX_ WARN_UNSAFE,
77ca0c92
LW
166 "\"%s\" variable %s masks earlier declaration in same %s",
167 (PL_in_my == KEY_our ? "our" : "my"),
168 name,
169 (SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
f472eb5c 170 }
b1cb66bf
PP
171 break;
172 }
173 }
174 }
a0d0e21e
LW
175 off = pad_alloc(OP_PADSV, SVs_PADMY);
176 sv = NEWSV(1102,0);
93a17b20
LW
177 sv_upgrade(sv, SVt_PVNV);
178 sv_setpv(sv, name);
3280af22 179 if (PL_in_my_stash) {
c750a3ec 180 if (*name != '$')
cea2e8a9 181 yyerror(Perl_form(aTHX_ "Can't declare class for non-scalar %s in \"my\"",
dce40276 182 name));
c750a3ec
MB
183 SvOBJECT_on(sv);
184 (void)SvUPGRADE(sv, SVt_PVMG);
3280af22
NIS
185 SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash);
186 PL_sv_objcount++;
c750a3ec 187 }
f472eb5c
GS
188 if (PL_in_my == KEY_our) {
189 (void)SvUPGRADE(sv, SVt_PVGV);
190 GvSTASH(sv) = (HV*)SvREFCNT_inc(PL_curstash ? PL_curstash : PL_defstash);
77ca0c92 191 SvFLAGS(sv) |= SVpad_OUR;
f472eb5c 192 }
3280af22 193 av_store(PL_comppad_name, off, sv);
65202027 194 SvNVX(sv) = (NV)PAD_MAX;
8990e307 195 SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */
3280af22
NIS
196 if (!PL_min_intro_pending)
197 PL_min_intro_pending = off;
198 PL_max_intro_pending = off;
93a17b20 199 if (*name == '@')
3280af22 200 av_store(PL_comppad, off, (SV*)newAV());
93a17b20 201 else if (*name == '%')
3280af22
NIS
202 av_store(PL_comppad, off, (SV*)newHV());
203 SvPADMY_on(PL_curpad[off]);
93a17b20
LW
204 return off;
205}
206
2680586e
GS
207#define FINDLEX_NOSEARCH 1 /* don't search outer contexts */
208
76e3520e 209STATIC PADOFFSET
cea2e8a9 210S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
864dbfa3 211 I32 cx_ix, I32 saweval, U32 flags)
93a17b20 212{
11343788 213 dTHR;
748a9306 214 CV *cv;
93a17b20
LW
215 I32 off;
216 SV *sv;
93a17b20 217 register I32 i;
c09156bb 218 register PERL_CONTEXT *cx;
93a17b20 219
748a9306 220 for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
4fdae800
PP
221 AV *curlist = CvPADLIST(cv);
222 SV **svp = av_fetch(curlist, 0, FALSE);
748a9306 223 AV *curname;
4fdae800 224
3280af22 225 if (!svp || *svp == &PL_sv_undef)
4633a7c4 226 continue;
748a9306
LW
227 curname = (AV*)*svp;
228 svp = AvARRAY(curname);
93965878 229 for (off = AvFILLp(curname); off > 0; off--) {
748a9306 230 if ((sv = svp[off]) &&
3280af22 231 sv != &PL_sv_undef &&
748a9306 232 seq <= SvIVX(sv) &&
13826f2c 233 seq > I_32(SvNVX(sv)) &&
748a9306
LW
234 strEQ(SvPVX(sv), name))
235 {
5f05dabc
PP
236 I32 depth;
237 AV *oldpad;
238 SV *oldsv;
239
240 depth = CvDEPTH(cv);
241 if (!depth) {
9607fc9c
PP
242 if (newoff) {
243 if (SvFAKE(sv))
244 continue;
4fdae800 245 return 0; /* don't clone from inactive stack frame */
9607fc9c 246 }
5f05dabc
PP
247 depth = 1;
248 }
249 oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
250 oldsv = *av_fetch(oldpad, off, TRUE);
748a9306 251 if (!newoff) { /* Not a mere clone operation. */
9607fc9c 252 SV *namesv = NEWSV(1103,0);
748a9306 253 newoff = pad_alloc(OP_PADSV, SVs_PADMY);
9607fc9c
PP
254 sv_upgrade(namesv, SVt_PVNV);
255 sv_setpv(namesv, name);
3280af22 256 av_store(PL_comppad_name, newoff, namesv);
65202027 257 SvNVX(namesv) = (NV)PL_curcop->cop_seq;
c53d7c7d 258 SvIVX(namesv) = PAD_MAX; /* A ref, intro immediately */
9607fc9c 259 SvFAKE_on(namesv); /* A ref, not a real var */
5faabd7d
GS
260 if (SvFLAGS(sv) & SVpad_OUR) { /* An "our" variable */
261 SvFLAGS(namesv) |= SVpad_OUR;
262 (void)SvUPGRADE(namesv, SVt_PVGV);
263 GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)GvSTASH(sv));
264 }
87671ffc 265 if (SvOBJECT(sv)) { /* A typed var */
3d93dc8b
GS
266 SvOBJECT_on(namesv);
267 (void)SvUPGRADE(namesv, SVt_PVMG);
87671ffc 268 SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*)SvSTASH(sv));
3d93dc8b
GS
269 PL_sv_objcount++;
270 }
3280af22 271 if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
28757baa 272 /* "It's closures all the way down." */
3280af22 273 CvCLONE_on(PL_compcv);
54310121 274 if (cv == startcv) {
3280af22 275 if (CvANON(PL_compcv))
54310121
PP
276 oldsv = Nullsv; /* no need to keep ref */
277 }
278 else {
28757baa
PP
279 CV *bcv;
280 for (bcv = startcv;
281 bcv && bcv != cv && !CvCLONE(bcv);
6b35e009
GS
282 bcv = CvOUTSIDE(bcv))
283 {
28757baa
PP
284 if (CvANON(bcv))
285 CvCLONE_on(bcv);
286 else {
6b35e009
GS
287 if (ckWARN(WARN_CLOSURE)
288 && !CvUNIQUE(bcv) && !CvUNIQUE(cv))
289 {
cea2e8a9 290 Perl_warner(aTHX_ WARN_CLOSURE,
44a8e56a 291 "Variable \"%s\" may be unavailable",
28757baa 292 name);
6b35e009 293 }
28757baa
PP
294 break;
295 }
296 }
297 }
298 }
3280af22 299 else if (!CvUNIQUE(PL_compcv)) {
599cee73 300 if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv))
cea2e8a9 301 Perl_warner(aTHX_ WARN_CLOSURE,
599cee73 302 "Variable \"%s\" will not stay shared", name);
5f05dabc 303 }
748a9306 304 }
3280af22 305 av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
748a9306
LW
306 return newoff;
307 }
93a17b20
LW
308 }
309 }
310
2680586e
GS
311 if (flags & FINDLEX_NOSEARCH)
312 return 0;
313
93a17b20
LW
314 /* Nothing in current lexical context--try eval's context, if any.
315 * This is necessary to let the perldb get at lexically scoped variables.
316 * XXX This will also probably interact badly with eval tree caching.
317 */
318
748a9306 319 for (i = cx_ix; i >= 0; i--) {
93a17b20 320 cx = &cxstack[i];
6b35e009 321 switch (CxTYPE(cx)) {
93a17b20 322 default:
748a9306
LW
323 if (i == 0 && saweval) {
324 seq = cxstack[saweval].blk_oldcop->cop_seq;
2680586e 325 return pad_findlex(name, newoff, seq, PL_main_cv, -1, saweval, 0);
748a9306 326 }
93a17b20
LW
327 break;
328 case CXt_EVAL:
44a8e56a
PP
329 switch (cx->blk_eval.old_op_type) {
330 case OP_ENTEREVAL:
6b35e009
GS
331 if (CxREALEVAL(cx))
332 saweval = i;
44a8e56a
PP
333 break;
334 case OP_REQUIRE:
335 /* require must have its own scope */
336 return 0;
337 }
93a17b20 338 break;
7766f137 339 case CXt_FORMAT:
93a17b20
LW
340 case CXt_SUB:
341 if (!saweval)
342 return 0;
343 cv = cx->blk_sub.cv;
3280af22 344 if (PL_debstash && CvSTASH(cv) == PL_debstash) { /* ignore DB'* scope */
748a9306 345 saweval = i; /* so we know where we were called from */
93a17b20 346 continue;
93a17b20 347 }
748a9306 348 seq = cxstack[saweval].blk_oldcop->cop_seq;
2680586e 349 return pad_findlex(name, newoff, seq, cv, i-1, saweval,FINDLEX_NOSEARCH);
93a17b20
LW
350 }
351 }
352
748a9306
LW
353 return 0;
354}
a0d0e21e 355
748a9306 356PADOFFSET
864dbfa3 357Perl_pad_findmy(pTHX_ char *name)
748a9306 358{
11343788 359 dTHR;
748a9306 360 I32 off;
54310121 361 I32 pendoff = 0;
748a9306 362 SV *sv;
3280af22
NIS
363 SV **svp = AvARRAY(PL_comppad_name);
364 U32 seq = PL_cop_seqmax;
6b35e009 365 PERL_CONTEXT *cx;
33b8ce05 366 CV *outside;
748a9306 367
11343788
MB
368#ifdef USE_THREADS
369 /*
370 * Special case to get lexical (and hence per-thread) @_.
371 * XXX I need to find out how to tell at parse-time whether use
372 * of @_ should refer to a lexical (from a sub) or defgv (global
373 * scope and maybe weird sub-ish things like formats). See
374 * startsub in perly.y. It's possible that @_ could be lexical
375 * (at least from subs) even in non-threaded perl.
376 */
377 if (strEQ(name, "@_"))
378 return 0; /* success. (NOT_IN_PAD indicates failure) */
379#endif /* USE_THREADS */
380
748a9306 381 /* The one we're looking for is probably just before comppad_name_fill. */
3280af22 382 for (off = AvFILLp(PL_comppad_name); off > 0; off--) {
a0d0e21e 383 if ((sv = svp[off]) &&
3280af22 384 sv != &PL_sv_undef &&
54310121
PP
385 (!SvIVX(sv) ||
386 (seq <= SvIVX(sv) &&
387 seq > I_32(SvNVX(sv)))) &&
a0d0e21e
LW
388 strEQ(SvPVX(sv), name))
389 {
77ca0c92 390 if (SvIVX(sv) || SvFLAGS(sv) & SVpad_OUR)
54310121
PP
391 return (PADOFFSET)off;
392 pendoff = off; /* this pending def. will override import */
a0d0e21e
LW
393 }
394 }
748a9306 395
33b8ce05
GS
396 outside = CvOUTSIDE(PL_compcv);
397
398 /* Check if if we're compiling an eval'', and adjust seq to be the
399 * eval's seq number. This depends on eval'' having a non-null
400 * CvOUTSIDE() while it is being compiled. The eval'' itself is
1aff0e91
GS
401 * identified by CvEVAL being true and CvGV being null. */
402 if (outside && CvEVAL(PL_compcv) && !CvGV(PL_compcv) && cxstack_ix >= 0) {
6b35e009
GS
403 cx = &cxstack[cxstack_ix];
404 if (CxREALEVAL(cx))
405 seq = cx->blk_oldcop->cop_seq;
406 }
407
748a9306 408 /* See if it's in a nested scope */
2680586e 409 off = pad_findlex(name, 0, seq, outside, cxstack_ix, 0, 0);
54310121
PP
410 if (off) {
411 /* If there is a pending local definition, this new alias must die */
412 if (pendoff)
3280af22 413 SvIVX(AvARRAY(PL_comppad_name)[off]) = seq;
11343788 414 return off; /* pad_findlex returns 0 for failure...*/
54310121 415 }
11343788 416 return NOT_IN_PAD; /* ...but we return NOT_IN_PAD for failure */
93a17b20
LW
417}
418
419void
864dbfa3 420Perl_pad_leavemy(pTHX_ I32 fill)
93a17b20 421{
0453d815 422 dTHR;
93a17b20 423 I32 off;
3280af22 424 SV **svp = AvARRAY(PL_comppad_name);
93a17b20 425 SV *sv;
3280af22
NIS
426 if (PL_min_intro_pending && fill < PL_min_intro_pending) {
427 for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
0453d815
PM
428 if ((sv = svp[off]) && sv != &PL_sv_undef && ckWARN_d(WARN_INTERNAL))
429 Perl_warner(aTHX_ WARN_INTERNAL, "%s never introduced", SvPVX(sv));
8990e307
LW
430 }
431 }
432 /* "Deintroduce" my variables that are leaving with this scope. */
3280af22 433 for (off = AvFILLp(PL_comppad_name); off > fill; off--) {
c53d7c7d 434 if ((sv = svp[off]) && sv != &PL_sv_undef && SvIVX(sv) == PAD_MAX)
3280af22 435 SvIVX(sv) = PL_cop_seqmax;
93a17b20
LW
436 }
437}
438
439PADOFFSET
864dbfa3 440Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
79072805 441{
11343788 442 dTHR;
79072805
LW
443 SV *sv;
444 I32 retval;
445
3280af22 446 if (AvARRAY(PL_comppad) != PL_curpad)
cea2e8a9 447 Perl_croak(aTHX_ "panic: pad_alloc");
3280af22 448 if (PL_pad_reset_pending)
a0d0e21e 449 pad_reset();
ed6116ce 450 if (tmptype & SVs_PADMY) {
79072805 451 do {
3280af22 452 sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
ed6116ce 453 } while (SvPADBUSY(sv)); /* need a fresh one */
3280af22 454 retval = AvFILLp(PL_comppad);
79072805
LW
455 }
456 else {
3280af22
NIS
457 SV **names = AvARRAY(PL_comppad_name);
458 SSize_t names_fill = AvFILLp(PL_comppad_name);
bbce6d69
PP
459 for (;;) {
460 /*
461 * "foreach" index vars temporarily become aliases to non-"my"
462 * values. Thus we must skip, not just pad values that are
463 * marked as current pad values, but also those with names.
464 */
3280af22
NIS
465 if (++PL_padix <= names_fill &&
466 (sv = names[PL_padix]) && sv != &PL_sv_undef)
bbce6d69 467 continue;
3280af22 468 sv = *av_fetch(PL_comppad, PL_padix, TRUE);
743e66e6 469 if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)) && !IS_PADGV(sv))
bbce6d69
PP
470 break;
471 }
3280af22 472 retval = PL_padix;
79072805 473 }
8990e307 474 SvFLAGS(sv) |= tmptype;
3280af22 475 PL_curpad = AvARRAY(PL_comppad);
11343788 476#ifdef USE_THREADS
b900a521
JH
477 DEBUG_X(PerlIO_printf(Perl_debug_log,
478 "0x%"UVxf" Pad 0x%"UVxf" alloc %ld for %s\n",
479 PTR2UV(thr), PTR2UV(PL_curpad),
22c35a8c 480 (long) retval, PL_op_name[optype]));
11343788 481#else
b900a521
JH
482 DEBUG_X(PerlIO_printf(Perl_debug_log,
483 "Pad 0x%"UVxf" alloc %ld for %s\n",
484 PTR2UV(PL_curpad),
22c35a8c 485 (long) retval, PL_op_name[optype]));
11343788 486#endif /* USE_THREADS */
79072805
LW
487 return (PADOFFSET)retval;
488}
489
490SV *
864dbfa3 491Perl_pad_sv(pTHX_ PADOFFSET po)
79072805 492{
11343788
MB
493 dTHR;
494#ifdef USE_THREADS
b900a521 495 DEBUG_X(PerlIO_printf(Perl_debug_log,
f1dbda3d
JH
496 "0x%"UVxf" Pad 0x%"UVxf" sv %"IVdf"\n",
497 PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
11343788 498#else
79072805 499 if (!po)
cea2e8a9 500 Perl_croak(aTHX_ "panic: pad_sv po");
97835f67
JH
501 DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" sv %"IVdf"\n",
502 PTR2UV(PL_curpad), (IV)po));
11343788 503#endif /* USE_THREADS */
3280af22 504 return PL_curpad[po]; /* eventually we'll turn this into a macro */
79072805
LW
505}
506
507void
864dbfa3 508Perl_pad_free(pTHX_ PADOFFSET po)
79072805 509{
11343788 510 dTHR;
3280af22 511 if (!PL_curpad)
a0d0e21e 512 return;
3280af22 513 if (AvARRAY(PL_comppad) != PL_curpad)
cea2e8a9 514 Perl_croak(aTHX_ "panic: pad_free curpad");
79072805 515 if (!po)
cea2e8a9 516 Perl_croak(aTHX_ "panic: pad_free po");
11343788 517#ifdef USE_THREADS
b900a521 518 DEBUG_X(PerlIO_printf(Perl_debug_log,
7766f137 519 "0x%"UVxf" Pad 0x%"UVxf" free %"IVdf"\n",
f1dbda3d 520 PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
11343788 521#else
97835f67
JH
522 DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" free %"IVdf"\n",
523 PTR2UV(PL_curpad), (IV)po));
11343788 524#endif /* USE_THREADS */
2aa1bedc 525 if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
3280af22 526 SvPADTMP_off(PL_curpad[po]);
2aa1bedc
GS
527#ifdef USE_ITHREADS
528 SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */
529#endif
530 }
3280af22
NIS
531 if ((I32)po < PL_padix)
532 PL_padix = po - 1;
79072805
LW
533}
534
535void
864dbfa3 536Perl_pad_swipe(pTHX_ PADOFFSET po)
79072805 537{
11343788 538 dTHR;
3280af22 539 if (AvARRAY(PL_comppad) != PL_curpad)
cea2e8a9 540 Perl_croak(aTHX_ "panic: pad_swipe curpad");
79072805 541 if (!po)
cea2e8a9 542 Perl_croak(aTHX_ "panic: pad_swipe po");
11343788 543#ifdef USE_THREADS
b900a521 544 DEBUG_X(PerlIO_printf(Perl_debug_log,
f1dbda3d
JH
545 "0x%"UVxf" Pad 0x%"UVxf" swipe %"IVdf"\n",
546 PTR2UV(thr), PTR2UV(PL_curpad), (IV)po));
11343788 547#else
97835f67
JH
548 DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" swipe %"IVdf"\n",
549 PTR2UV(PL_curpad), (IV)po));
11343788 550#endif /* USE_THREADS */
3280af22
NIS
551 SvPADTMP_off(PL_curpad[po]);
552 PL_curpad[po] = NEWSV(1107,0);
553 SvPADTMP_on(PL_curpad[po]);
554 if ((I32)po < PL_padix)
555 PL_padix = po - 1;
79072805
LW
556}
557
d9bb4600
GS
558/* XXX pad_reset() is currently disabled because it results in serious bugs.
559 * It causes pad temp TARGs to be shared between OPs. Since TARGs are pushed
560 * on the stack by OPs that use them, there are several ways to get an alias
561 * to a shared TARG. Such an alias will change randomly and unpredictably.
562 * We avoid doing this until we can think of a Better Way.
563 * GSAR 97-10-29 */
79072805 564void
864dbfa3 565Perl_pad_reset(pTHX)
79072805 566{
d9bb4600 567#ifdef USE_BROKEN_PAD_RESET
11343788 568 dTHR;
79072805
LW
569 register I32 po;
570
6b88bc9c 571 if (AvARRAY(PL_comppad) != PL_curpad)
cea2e8a9 572 Perl_croak(aTHX_ "panic: pad_reset curpad");
11343788 573#ifdef USE_THREADS
b900a521
JH
574 DEBUG_X(PerlIO_printf(Perl_debug_log,
575 "0x%"UVxf" Pad 0x%"UVxf" reset\n",
576 PTR2UV(thr), PTR2UV(PL_curpad)));
11343788 577#else
b900a521
JH
578 DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad 0x%"UVxf" reset\n",
579 PTR2UV(PL_curpad)));
11343788 580#endif /* USE_THREADS */
6b88bc9c
GS
581 if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
582 for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
583 if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
584 SvPADTMP_off(PL_curpad[po]);
748a9306 585 }
6b88bc9c 586 PL_padix = PL_padix_floor;
79072805 587 }
d9bb4600 588#endif
3280af22 589 PL_pad_reset_pending = FALSE;
79072805
LW
590}
591
a863c7d1 592#ifdef USE_THREADS
54b9620d 593/* find_threadsv is not reentrant */
a863c7d1 594PADOFFSET
864dbfa3 595Perl_find_threadsv(pTHX_ const char *name)
a863c7d1
MB
596{
597 dTHR;
598 char *p;
599 PADOFFSET key;
554b3eca 600 SV **svp;
54b9620d 601 /* We currently only handle names of a single character */
533c011a 602 p = strchr(PL_threadsv_names, *name);
a863c7d1
MB
603 if (!p)
604 return NOT_IN_PAD;
533c011a 605 key = p - PL_threadsv_names;
2d8e6c8d 606 MUTEX_LOCK(&thr->mutex);
54b9620d 607 svp = av_fetch(thr->threadsv, key, FALSE);
2d8e6c8d
GS
608 if (svp)
609 MUTEX_UNLOCK(&thr->mutex);
610 else {
554b3eca 611 SV *sv = NEWSV(0, 0);
54b9620d 612 av_store(thr->threadsv, key, sv);
940cb80d 613 thr->threadsvp = AvARRAY(thr->threadsv);
2d8e6c8d 614 MUTEX_UNLOCK(&thr->mutex);
554b3eca
MB
615 /*
616 * Some magic variables used to be automagically initialised
617 * in gv_fetchpv. Those which are now per-thread magicals get
618 * initialised here instead.
619 */
620 switch (*name) {
54b9620d
MB
621 case '_':
622 break;
554b3eca
MB
623 case ';':
624 sv_setpv(sv, "\034");
54b9620d 625 sv_magic(sv, 0, 0, name, 1);
554b3eca 626 break;
c277df42
IZ
627 case '&':
628 case '`':
629 case '\'':
533c011a 630 PL_sawampersand = TRUE;
a3f914c5
GS
631 /* FALL THROUGH */
632 case '1':
633 case '2':
634 case '3':
635 case '4':
636 case '5':
637 case '6':
638 case '7':
639 case '8':
640 case '9':
c277df42 641 SvREADONLY_on(sv);
d8b5173a 642 /* FALL THROUGH */
067391ea
GS
643
644 /* XXX %! tied to Errno.pm needs to be added here.
645 * See gv_fetchpv(). */
646 /* case '!': */
647
54b9620d
MB
648 default:
649 sv_magic(sv, 0, 0, name, 1);
554b3eca 650 }
bf49b057 651 DEBUG_S(PerlIO_printf(Perl_error_log,
54b9620d 652 "find_threadsv: new SV %p for $%s%c\n",
554b3eca
MB
653 sv, (*name < 32) ? "^" : "",
654 (*name < 32) ? toCTRL(*name) : *name));
a863c7d1
MB
655 }
656 return key;
657}
658#endif /* USE_THREADS */
659
79072805
LW
660/* Destructor */
661
662void
864dbfa3 663Perl_op_free(pTHX_ OP *o)
79072805 664{
85e6fe83 665 register OP *kid, *nextkid;
acb36ea4 666 OPCODE type;
79072805 667
5dc0d613 668 if (!o || o->op_seq == (U16)-1)
79072805
LW
669 return;
670
7934575e
GS
671 if (o->op_private & OPpREFCOUNTED) {
672 switch (o->op_type) {
673 case OP_LEAVESUB:
674 case OP_LEAVESUBLV:
675 case OP_LEAVEEVAL:
676 case OP_LEAVE:
677 case OP_SCOPE:
678 case OP_LEAVEWRITE:
679 OP_REFCNT_LOCK;
680 if (OpREFCNT_dec(o)) {
681 OP_REFCNT_UNLOCK;
682 return;
683 }
684 OP_REFCNT_UNLOCK;
685 break;
686 default:
687 break;
688 }
689 }
690
11343788
MB
691 if (o->op_flags & OPf_KIDS) {
692 for (kid = cUNOPo->op_first; kid; kid = nextkid) {
85e6fe83 693 nextkid = kid->op_sibling; /* Get before next freeing kid */
79072805 694 op_free(kid);
85e6fe83 695 }
79072805 696 }
acb36ea4
GS
697 type = o->op_type;
698 if (type == OP_NULL)
699 type = o->op_targ;
700
701 /* COP* is not cleared by op_clear() so that we may track line
702 * numbers etc even after null() */
703 if (type == OP_NEXTSTATE || type == OP_SETSTATE || type == OP_DBSTATE)
704 cop_free((COP*)o);
705
706 op_clear(o);
707
708#ifdef PL_OP_SLAB_ALLOC
709 if ((char *) o == PL_OpPtr)
710 {
711 }
712#else
713 Safefree(o);
714#endif
715}
79072805 716
acb36ea4
GS
717STATIC void
718S_op_clear(pTHX_ OP *o)
719{
11343788 720 switch (o->op_type) {
acb36ea4
GS
721 case OP_NULL: /* Was holding old type, if any. */
722 case OP_ENTEREVAL: /* Was holding hints. */
723#ifdef USE_THREADS
724 case OP_THREADSV: /* Was holding index into thr->threadsv AV. */
725#endif
726 o->op_targ = 0;
a0d0e21e 727 break;
554b3eca 728#ifdef USE_THREADS
8dd3ba40
SM
729 case OP_ENTERITER:
730 if (!(o->op_flags & OPf_SPECIAL))
731 break;
732 /* FALL THROUGH */
554b3eca 733#endif /* USE_THREADS */
a6006777 734 default:
ac4c12e7 735 if (!(o->op_flags & OPf_REF)
0b94c7bb 736 || (PL_check[o->op_type] != MEMBER_TO_FPTR(Perl_ck_ftst)))
a6006777
PP
737 break;
738 /* FALL THROUGH */
463ee0b2 739 case OP_GVSV:
79072805 740 case OP_GV:
a6006777 741 case OP_AELEMFAST:
350de78d 742#ifdef USE_ITHREADS
971a9dd3
GS
743 if (cPADOPo->op_padix > 0) {
744 if (PL_curpad) {
638eceb6 745 GV *gv = cGVOPo_gv;
971a9dd3
GS
746 pad_swipe(cPADOPo->op_padix);
747 /* No GvIN_PAD_off(gv) here, because other references may still
748 * exist on the pad */
749 SvREFCNT_dec(gv);
750 }
751 cPADOPo->op_padix = 0;
752 }
350de78d 753#else
971a9dd3 754 SvREFCNT_dec(cSVOPo->op_sv);
7934575e 755 cSVOPo->op_sv = Nullsv;
350de78d 756#endif
79072805
LW
757 break;
758 case OP_CONST:
11343788 759 SvREFCNT_dec(cSVOPo->op_sv);
acb36ea4 760 cSVOPo->op_sv = Nullsv;
79072805 761 break;
748a9306
LW
762 case OP_GOTO:
763 case OP_NEXT:
764 case OP_LAST:
765 case OP_REDO:
11343788 766 if (o->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
748a9306
LW
767 break;
768 /* FALL THROUGH */
a0d0e21e 769 case OP_TRANS:
acb36ea4 770 if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
a0ed51b3 771 SvREFCNT_dec(cSVOPo->op_sv);
acb36ea4
GS
772 cSVOPo->op_sv = Nullsv;
773 }
774 else {
a0ed51b3 775 Safefree(cPVOPo->op_pv);
acb36ea4
GS
776 cPVOPo->op_pv = Nullch;
777 }
a0d0e21e
LW
778 break;
779 case OP_SUBST:
11343788 780 op_free(cPMOPo->op_pmreplroot);
971a9dd3 781 goto clear_pmop;
748a9306 782 case OP_PUSHRE:
971a9dd3
GS
783#ifdef USE_ITHREADS
784 if ((PADOFFSET)cPMOPo->op_pmreplroot) {
785 if (PL_curpad) {
786 GV *gv = (GV*)PL_curpad[(PADOFFSET)cPMOPo->op_pmreplroot];
787 pad_swipe((PADOFFSET)cPMOPo->op_pmreplroot);
788 /* No GvIN_PAD_off(gv) here, because other references may still
789 * exist on the pad */
790 SvREFCNT_dec(gv);
791 }
792 }
793#else
794 SvREFCNT_dec((SV*)cPMOPo->op_pmreplroot);
795#endif
796 /* FALL THROUGH */
a0d0e21e 797 case OP_MATCH:
8782bef2 798 case OP_QR:
971a9dd3
GS
799clear_pmop:
800 cPMOPo->op_pmreplroot = Nullop;
c277df42 801 ReREFCNT_dec(cPMOPo->op_pmregexp);
acb36ea4 802 cPMOPo->op_pmregexp = (REGEXP*)NULL;
a0d0e21e 803 break;
79072805
LW
804 }
805
743e66e6 806 if (o->op_targ > 0) {
11343788 807 pad_free(o->op_targ);
743e66e6
GS
808 o->op_targ = 0;
809 }
79072805
LW
810}
811
76e3520e 812STATIC void
3eb57f73
HS
813S_cop_free(pTHX_ COP* cop)
814{
815 Safefree(cop->cop_label);
57843af0
GS
816#ifdef USE_ITHREADS
817 Safefree(CopFILE(cop)); /* XXXXX share in a pvtable? */
11faa288 818 Safefree(CopSTASHPV(cop)); /* XXXXX share in a pvtable? */
57843af0 819#else
11faa288 820 /* NOTE: COP.cop_stash is not refcounted */
cc49e20b 821 SvREFCNT_dec(CopFILEGV(cop));
57843af0 822#endif
0453d815 823 if (! specialWARN(cop->cop_warnings))
3eb57f73
HS
824 SvREFCNT_dec(cop->cop_warnings);
825}
826
827STATIC void
cea2e8a9 828S_null(pTHX_ OP *o)
8990e307 829{
acb36ea4
GS
830 if (o->op_type == OP_NULL)
831 return;
832 op_clear(o);
11343788
MB
833 o->op_targ = o->op_type;
834 o->op_type = OP_NULL;
22c35a8c 835 o->op_ppaddr = PL_ppaddr[OP_NULL];
8990e307
LW
836}
837
79072805
LW
838/* Contextualizers */
839
463ee0b2 840#define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
79072805
LW
841
842OP *
864dbfa3 843Perl_linklist(pTHX_ OP *o)
79072805
LW
844{
845 register OP *kid;
846
11343788
MB
847 if (o->op_next)
848 return o->op_next;
79072805
LW
849
850 /* establish postfix order */
11343788
MB
851 if (cUNOPo->op_first) {
852 o->op_next = LINKLIST(cUNOPo->op_first);
853 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
79072805
LW
854 if (kid->op_sibling)
855 kid->op_next = LINKLIST(kid->op_sibling);
856 else
11343788 857 kid->op_next = o;
79072805
LW
858 }
859 }
860 else
11343788 861 o->op_next = o;
79072805 862
11343788 863 return o->op_next;
79072805
LW
864}
865
866OP *
864dbfa3 867Perl_scalarkids(pTHX_ OP *o)
79072805
LW
868{
869 OP *kid;
11343788
MB
870 if (o && o->op_flags & OPf_KIDS) {
871 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
79072805
LW
872 scalar(kid);
873 }
11343788 874 return o;
79072805
LW
875}
876
76e3520e 877STATIC OP *
cea2e8a9 878S_scalarboolean(pTHX_ OP *o)
8990e307 879{
d008e5eb 880 if (o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
0f15f207 881 dTHR;
d008e5eb 882 if (ckWARN(WARN_SYNTAX)) {
57843af0 883 line_t oldline = CopLINE(PL_curcop);
a0d0e21e 884
d008e5eb 885 if (PL_copline != NOLINE)
57843af0 886 CopLINE_set(PL_curcop, PL_copline);
cea2e8a9 887 Perl_warner(aTHX_ WARN_SYNTAX, "Found = in conditional, should be ==");
57843af0 888 CopLINE_set(PL_curcop, oldline);
d008e5eb 889 }
a0d0e21e 890 }
11343788 891 return scalar(o);
8990e307
LW
892}
893
894OP *
864dbfa3 895Perl_scalar(pTHX_ OP *o)
79072805
LW
896{
897 OP *kid;
898
a0d0e21e 899 /* assumes no premature commitment */
3280af22 900 if (!o || (o->op_flags & OPf_WANT) || PL_error_count
5dc0d613 901 || o->op_type == OP_RETURN)
7e363e51 902 {
11343788 903 return o;
7e363e51 904 }
79072805 905
5dc0d613 906 o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
79072805 907
11343788 908 switch (o->op_type) {
79072805 909 case OP_REPEAT:
11343788
MB
910 if (o->op_private & OPpREPEAT_DOLIST)
911 null(((LISTOP*)cBINOPo->op_first)->op_first);
912 scalar(cBINOPo->op_first);
8990e307 913 break;
79072805
LW
914 case OP_OR:
915 case OP_AND:
916 case OP_COND_EXPR:
11343788 917 for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
8990e307 918 scalar(kid);
79072805 919 break;
a0d0e21e 920 case OP_SPLIT:
11343788 921 if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
a0d0e21e
LW
922 if (!kPMOP->op_pmreplroot)
923 deprecate("implicit split to @_");
924 }
925 /* FALL THROUGH */
79072805 926 case OP_MATCH:
8782bef2 927 case OP_QR:
79072805
LW
928 case OP_SUBST:
929 case OP_NULL:
8990e307 930 default:
11343788
MB
931 if (o->op_flags & OPf_KIDS) {
932 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
8990e307
LW
933 scalar(kid);
934 }
79072805
LW
935 break;
936 case OP_LEAVE:
937 case OP_LEAVETRY:
5dc0d613 938 kid = cLISTOPo->op_first;
54310121
PP
939 scalar(kid);
940 while (kid = kid->op_sibling) {
941 if (kid->op_sibling)
942 scalarvoid(kid);
943 else
944 scalar(kid);
945 }
3280af22 946 WITH_THR(PL_curcop = &PL_compiling);
54310121 947 break;
748a9306 948 case OP_SCOPE:
79072805 949 case OP_LINESEQ:
8990e307 950 case OP_LIST:
11343788 951 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
79072805
LW
952 if (kid->op_sibling)
953 scalarvoid(kid);
954 else
955 scalar(kid);
956 }
3280af22 957 WITH_THR(PL_curcop = &PL_compiling);
79072805
LW
958 break;
959 }
11343788 960 return o;
79072805
LW
961}
962
963OP *
864dbfa3 964Perl_scalarvoid(pTHX_ OP *o)
79072805
LW
965{
966 OP *kid;
8990e307
LW
967 char* useless = 0;
968 SV* sv;
2ebea0a1
GS
969 U8 want;
970
acb36ea4
GS
971 if (o->op_type == OP_NEXTSTATE
972 || o->op_type == OP_SETSTATE
973 || o->op_type == OP_DBSTATE
974 || (o->op_type == OP_NULL && (o->op_targ == OP_NEXTSTATE
975 || o->op_targ == OP_SETSTATE
976 || o->op_targ == OP_DBSTATE)))
2ebea0a1
GS
977 {
978 dTHR;
979 PL_curcop = (COP*)o; /* for warning below */
980 }
79072805 981
54310121 982 /* assumes no premature commitment */
2ebea0a1
GS
983 want = o->op_flags & OPf_WANT;
984 if ((want && want != OPf_WANT_SCALAR) || PL_error_count
5dc0d613 985 || o->op_type == OP_RETURN)
7e363e51 986 {
11343788 987 return o;
7e363e51 988 }
79072805 989
b162f9ea 990 if ((o->op_private & OPpTARGET_MY)
7e363e51
GS
991 && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
992 {
b162f9ea 993 return scalar(o); /* As if inside SASSIGN */
7e363e51 994 }
b162f9ea 995
5dc0d613 996 o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
79072805 997
11343788 998 switch (o->op_type) {
79072805 999 default:
22c35a8c 1000 if (!(PL_opargs[o->op_type] & OA_FOLDCONST))
8990e307 1001 break;
36477c24
PP
1002 /* FALL THROUGH */
1003 case OP_REPEAT:
11343788 1004 if (o->op_flags & OPf_STACKED)
8990e307 1005 break;
5d82c453
GA
1006 goto func_ops;
1007 case OP_SUBSTR:
1008 if (o->op_private == 4)
1009 break;
8990e307
LW
1010 /* FALL THROUGH */
1011 case OP_GVSV:
1012 case OP_WANTARRAY:
1013 case OP_GV:
1014 case OP_PADSV:
1015 case OP_PADAV:
1016 case OP_PADHV:
1017 case OP_PADANY:
1018 case OP_AV2ARYLEN:
8990e307 1019 case OP_REF:
a0d0e21e
LW
1020 case OP_REFGEN:
1021 case OP_SREFGEN:
8990e307
LW
1022 case OP_DEFINED:
1023 case OP_HEX:
1024 case OP_OCT:
1025 case OP_LENGTH:
8990e307
LW
1026 case OP_VEC:
1027 case OP_INDEX:
1028 case OP_RINDEX:
1029 case OP_SPRINTF:
1030 case OP_AELEM:
1031 case OP_AELEMFAST:
1032 case OP_ASLICE:
8990e307
LW
1033 case OP_HELEM:
1034 case OP_HSLICE:
1035 case OP_UNPACK:
1036 case OP_PACK:
8990e307
LW
1037 case OP_JOIN:
1038 case OP_LSLICE:
1039 case OP_ANONLIST:
1040 case OP_ANONHASH:
1041 case OP_SORT:
1042 case OP_REVERSE:
1043 case OP_RANGE:
1044 case OP_FLIP:
1045 case OP_FLOP:
1046 case OP_CALLER:
1047 case OP_FILENO:
1048 case OP_EOF:
1049 case OP_TELL:
1050 case OP_GETSOCKNAME:
1051 case OP_GETPEERNAME:
1052 case OP_READLINK:
1053 case OP_TELLDIR:
1054 case OP_GETPPID:
1055 case OP_GETPGRP:
1056 case OP_GETPRIORITY:
1057 case OP_TIME:
1058 case OP_TMS:
1059 case OP_LOCALTIME:
1060 case OP_GMTIME:
1061 case OP_GHBYNAME:
1062 case OP_GHBYADDR:
1063 case OP_GHOSTENT:
1064 case OP_GNBYNAME:
1065 case OP_GNBYADDR:
1066 case OP_GNETENT:
1067 case OP_GPBYNAME:
1068 case OP_GPBYNUMBER:
1069 case OP_GPROTOENT:
1070 case OP_GSBYNAME:
1071 case OP_GSBYPORT:
1072 case OP_GSERVENT:
1073 case OP_GPWNAM:
1074 case OP_GPWUID:
1075 case OP_GGRNAM:
1076 case OP_GGRGID:
1077 case OP_GETLOGIN:
5d82c453 1078 func_ops:
11343788 1079 if (!(o->op_private & OPpLVAL_INTRO))
22c35a8c 1080 useless = PL_op_desc[o->op_type];
8990e307
LW
1081 break;
1082
1083 case OP_RV2GV:
1084 case OP_RV2SV:
1085 case OP_RV2AV:
1086 case OP_RV2HV:
192587c2 1087 if (!(o->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO)) &&
11343788 1088 (!o->op_sibling || o->op_sibling->op_type != OP_READLINE))
8990e307
LW
1089 useless = "a variable";
1090 break;
79072805
LW
1091
1092 case OP_CONST:
7766f137 1093 sv = cSVOPo_sv;
7a52d87a
GS
1094 if (cSVOPo->op_private & OPpCONST_STRICT)
1095 no_bareword_allowed(o);
1096 else {
d008e5eb
GS
1097 dTHR;
1098 if (ckWARN(WARN_VOID)) {
1099 useless = "a constant";
1100 if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
1101 useless = 0;
1102 else if (SvPOK(sv)) {
1103 if (strnEQ(SvPVX(sv), "di", 2) ||
1104 strnEQ(SvPVX(sv), "ds", 2) ||
1105 strnEQ(SvPVX(sv), "ig", 2))
1106 useless = 0;
1107 }
8990e307
LW
1108 }
1109 }
acb36ea4 1110 null(o); /* don't execute or even remember it */
79072805
LW
1111 break;
1112
1113 case OP_POSTINC:
11343788 1114 o->op_type = OP_PREINC; /* pre-increment is faster */
22c35a8c 1115 o->op_ppaddr = PL_ppaddr[OP_PREINC];
79072805
LW
1116 break;
1117
1118 case OP_POSTDEC:
11343788 1119 o->op_type = OP_PREDEC; /* pre-decrement is faster */
22c35a8c 1120 o->op_ppaddr = PL_ppaddr[OP_PREDEC];
79072805
LW
1121 break;
1122
79072805
LW
1123 case OP_OR:
1124 case OP_AND:
1125 case OP_COND_EXPR:
11343788 1126 for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
79072805
LW
1127 scalarvoid(kid);
1128 break;
5aabfad6 1129
a0d0e21e 1130 case OP_NULL:
11343788 1131 if (o->op_flags & OPf_STACKED)
a0d0e21e 1132 break;
5aabfad6 1133 /* FALL THROUGH */
2ebea0a1
GS
1134 case OP_NEXTSTATE:
1135 case OP_DBSTATE:
79072805
LW
1136 case OP_ENTERTRY:
1137 case OP_ENTER:
1138 case OP_SCALAR:
11343788 1139 if (!(o->op_flags & OPf_KIDS))
79072805 1140 break;
54310121 1141 /* FALL THROUGH */
463ee0b2 1142 case OP_SCOPE:
79072805
LW
1143 case OP_LEAVE:
1144 case OP_LEAVETRY:
a0d0e21e 1145 case OP_LEAVELOOP:
79072805 1146 case OP_LINESEQ:
79072805 1147 case OP_LIST:
11343788 1148 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
79072805
LW
1149 scalarvoid(kid);
1150 break;
c90c0ff4 1151 case OP_ENTEREVAL:
5196be3e 1152 scalarkids(o);
c90c0ff4 1153 break;
5aabfad6 1154 case OP_REQUIRE:
c90c0ff4 1155 /* all requires must return a boolean value */
5196be3e
MB
1156 o->op_flags &= ~OPf_WANT;
1157 return scalar(o);
a0d0e21e 1158 case OP_SPLIT:
11343788 1159 if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
a0d0e21e
LW
1160 if (!kPMOP->op_pmreplroot)
1161 deprecate("implicit split to @_");
1162 }
1163 break;
79072805 1164 }
d008e5eb
GS
1165 if (useless) {
1166 dTHR;
1167 if (ckWARN(WARN_VOID))
cea2e8a9 1168 Perl_warner(aTHX_ WARN_VOID, "Useless use of %s in void context", useless);
d008e5eb 1169 }
11343788 1170 return o;
79072805
LW
1171}
1172
1173OP *
864dbfa3 1174Perl_listkids(pTHX_ OP *o)
79072805
LW
1175{
1176 OP *kid;
11343788
MB
1177 if (o && o->op_flags & OPf_KIDS) {
1178 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
79072805
LW
1179 list(kid);
1180 }
11343788 1181 return o;
79072805
LW
1182}
1183
1184OP *
864dbfa3 1185Perl_list(pTHX_ OP *o)
79072805
LW
1186{
1187 OP *kid;
1188
a0d0e21e 1189 /* assumes no premature commitment */
3280af22 1190 if (!o || (o->op_flags & OPf_WANT) || PL_error_count
5dc0d613 1191 || o->op_type == OP_RETURN)
7e363e51 1192 {
11343788 1193 return o;
7e363e51 1194 }
79072805 1195
b162f9ea 1196 if ((o->op_private & OPpTARGET_MY)
7e363e51
GS
1197 && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
1198 {
b162f9ea 1199 return o; /* As if inside SASSIGN */
7e363e51 1200 }
b162f9ea 1201
5dc0d613 1202 o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_LIST;
79072805 1203
11343788 1204 switch (o->op_type) {
79072805
LW
1205 case OP_FLOP:
1206 case OP_REPEAT:
11343788 1207 list(cBINOPo->op_first);
79072805
LW
1208 break;
1209 case OP_OR:
1210 case OP_AND:
1211 case OP_COND_EXPR:
11343788 1212 for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
79072805
LW
1213 list(kid);
1214 break;
1215 default:
1216 case OP_MATCH:
8782bef2 1217 case OP_QR:
79072805
LW
1218 case OP_SUBST:
1219 case OP_NULL:
11343788 1220 if (!(o->op_flags & OPf_KIDS))
79072805 1221 break;
11343788
MB
1222 if (!o->op_next && cUNOPo->op_first->op_type == OP_FLOP) {
1223 list(cBINOPo->op_first);
1224 return gen_constant_list(o);
79072805
LW
1225 }
1226 case OP_LIST:
11343788 1227 listkids(o);
79072805
LW
1228 break;
1229 case OP_LEAVE:
1230 case OP_LEAVETRY:
5dc0d613 1231 kid = cLISTOPo->op_first;
54310121
PP
1232 list(kid);
1233 while (kid = kid->op_sibling) {
1234 if (kid->op_sibling)
1235 scalarvoid(kid);
1236 else
1237 list(kid);
1238 }
3280af22 1239 WITH_THR(PL_curcop = &PL_compiling);
54310121 1240 break;
748a9306 1241 case OP_SCOPE:
79072805 1242 case OP_LINESEQ:
11343788 1243 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
79072805
LW
1244 if (kid->op_sibling)
1245 scalarvoid(kid);
1246 else
1247 list(kid);
1248 }
3280af22 1249 WITH_THR(PL_curcop = &PL_compiling);
79072805 1250 break;
c90c0ff4
PP
1251 case OP_REQUIRE:
1252 /* all requires must return a boolean value */
5196be3e
MB
1253 o->op_flags &= ~OPf_WANT;
1254 return scalar(o);
79072805 1255 }
11343788 1256 return o;
79072805
LW
1257}
1258
1259OP *
864dbfa3 1260Perl_scalarseq(pTHX_ OP *o)
79072805
LW
1261{
1262 OP *kid;
1263
11343788
MB
1264 if (o) {
1265 if (o->op_type == OP_LINESEQ ||
1266 o->op_type == OP_SCOPE ||
1267 o->op_type == OP_LEAVE ||
1268 o->op_type == OP_LEAVETRY)
463ee0b2 1269 {
0f15f207 1270 dTHR;
11343788 1271 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
ed6116ce 1272 if (kid->op_sibling) {
463ee0b2 1273 scalarvoid(kid);
ed6116ce 1274 }
463ee0b2 1275 }
3280af22 1276 PL_curcop = &PL_compiling;
79072805 1277 }
11343788 1278 o->op_flags &= ~OPf_PARENS;
3280af22 1279 if (PL_hints & HINT_BLOCK_SCOPE)
11343788 1280 o->op_flags |= OPf_PARENS;
79072805 1281 }
8990e307 1282 else
11343788
MB
1283 o = newOP(OP_STUB, 0);
1284 return o;
79072805
LW
1285}
1286
76e3520e 1287STATIC OP *
cea2e8a9 1288S_modkids(pTHX_ OP *o, I32 type)
79072805
LW
1289{
1290 OP *kid;
11343788
MB
1291 if (o && o->op_flags & OPf_KIDS) {
1292 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
463ee0b2 1293 mod(kid, type);
79072805 1294 }
11343788 1295 return o;
79072805
LW
1296}
1297
79072805 1298OP *
864dbfa3 1299Perl_mod(pTHX_ OP *o, I32 type)
79072805 1300{
11343788 1301 dTHR;
79072805
LW
1302 OP *kid;
1303 SV *sv;
2d8e6c8d 1304 STRLEN n_a;
79072805 1305
3280af22 1306 if (!o || PL_error_count)
11343788 1307 return o;
79072805 1308
b162f9ea 1309 if ((o->op_private & OPpTARGET_MY)
7e363e51
GS
1310 && (PL_opargs[o->op_type] & OA_TARGLEX))/* OPp share the meaning */
1311 {
b162f9ea 1312 return o;
7e363e51 1313 }
b162f9ea 1314
11343788 1315 switch (o->op_type) {
68dc0745 1316 case OP_UNDEF:
3280af22 1317 PL_modcount++;
5dc0d613 1318 return o;
a0d0e21e 1319 case OP_CONST:
11343788 1320 if (!(o->op_private & (OPpCONST_ARYBASE)))
a0d0e21e 1321 goto nomod;
3280af22 1322 if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
7766f137 1323 PL_compiling.cop_arybase = (I32)SvIV(cSVOPx(PL_eval_start)->op_sv);
3280af22 1324 PL_eval_start = 0;
a0d0e21e
LW
1325 }
1326 else if (!type) {
3280af22
NIS
1327 SAVEI32(PL_compiling.cop_arybase);
1328 PL_compiling.cop_arybase = 0;
a0d0e21e
LW
1329 }
1330 else if (type == OP_REFGEN)
1331 goto nomod;
1332 else
cea2e8a9 1333 Perl_croak(aTHX_ "That use of $[ is unsupported");
a0d0e21e 1334 break;
5f05dabc 1335 case OP_STUB:
5196be3e 1336 if (o->op_flags & OPf_PARENS)
5f05dabc
PP
1337 break;
1338 goto nomod;
a0d0e21e
LW
1339 case OP_ENTERSUB:
1340 if ((type == OP_UNDEF || type == OP_REFGEN) &&
11343788
MB
1341 !(o->op_flags & OPf_STACKED)) {
1342 o->op_type = OP_RV2CV; /* entersub => rv2cv */
22c35a8c 1343 o->op_ppaddr = PL_ppaddr[OP_RV2CV];
11343788
MB
1344 assert(cUNOPo->op_first->op_type == OP_NULL);
1345 null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
79072805
LW
1346 break;
1347 }
cd06dffe
GS
1348 else { /* lvalue subroutine call */
1349 o->op_private |= OPpLVAL_INTRO;
4978d6d9 1350 if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN) {
cd06dffe
GS
1351 /* Backward compatibility mode: */
1352 o->op_private |= OPpENTERSUB_INARGS;
1353 break;
1354 }
1355 else { /* Compile-time error message: */
1356 OP *kid = cUNOPo->op_first;
1357 CV *cv;
1358 OP *okid;
1359
1360 if (kid->op_type == OP_PUSHMARK)
1361 goto skip_kids;
1362 if (kid->op_type != OP_NULL || kid->op_targ != OP_LIST)
1363 Perl_croak(aTHX_
1364 "panic: unexpected lvalue entersub "
1365 "args: type/targ %ld:%ld",
1366 (long)kid->op_type,kid->op_targ);
1367 kid = kLISTOP->op_first;
1368 skip_kids:
1369 while (kid->op_sibling)
1370 kid = kid->op_sibling;
1371 if (!(kid->op_type == OP_NULL && kid->op_targ == OP_RV2CV)) {
1372 /* Indirect call */
1373 if (kid->op_type == OP_METHOD_NAMED
1374 || kid->op_type == OP_METHOD)
1375 {
349fd7b7 1376 OP *newop;
cd06dffe
GS
1377
1378 if (kid->op_sibling || kid->op_next != kid) {
1379 yyerror("panic: unexpected optree near method call");
1380 break;
1381 }
1382
349fd7b7
GS
1383 NewOp(1101, newop, 1, OP);
1384 newop->op_type = OP_RV2CV;
1385 newop->op_ppaddr = PL_ppaddr[OP_RV2CV];
1386 newop->op_next = newop;
1387 kid->op_sibling = newop;
1388 newop->op_private |= OPpLVAL_INTRO;
cd06dffe
GS
1389 break;
1390 }
1391
1392 if (kid->op_type != OP_RV2CV)
1393 Perl_croak(aTHX_
1394 "panic: unexpected lvalue entersub "
1395 "entry via type/targ %ld:%ld",
1396 (long)kid->op_type,kid->op_targ);
1397 kid->op_private |= OPpLVAL_INTRO;
1398 break; /* Postpone until runtime */
1399 }
1400
1401 okid = kid;
1402 kid = kUNOP->op_first;
1403 if (kid->op_type == OP_NULL && kid->op_targ == OP_RV2SV)
1404 kid = kUNOP->op_first;
1405 if (kid->op_type == OP_NULL)
1406 Perl_croak(aTHX_
1407 "Unexpected constant lvalue entersub "
1408 "entry via type/targ %ld:%ld",
1409 (long)kid->op_type,kid->op_targ);
1410 if (kid->op_type != OP_GV) {
1411 /* Restore RV2CV to check lvalueness */
1412 restore_2cv:
1413 if (kid->op_next && kid->op_next != kid) { /* Happens? */
1414 okid->op_next = kid->op_next;
1415 kid->op_next = okid;
1416 }
1417 else
1418 okid->op_next = Nullop;
1419 okid->op_type = OP_RV2CV;
1420 okid->op_targ = 0;
1421 okid->op_ppaddr = PL_ppaddr[OP_RV2CV];
1422 okid->op_private |= OPpLVAL_INTRO;
1423 break;
1424 }
1425
638eceb6 1426 cv = GvCV(kGVOP_gv);
cd06dffe
GS
1427 if (!cv)
1428 goto restore_2cv;
1429 if (CvLVALUE(cv))
1430 break;
1431 }
1432 }
79072805
LW
1433 /* FALL THROUGH */
1434 default:
a0d0e21e
LW
1435 nomod:
1436 /* grep, foreach, subcalls, refgen */
1437 if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
1438 break;
cea2e8a9 1439 yyerror(Perl_form(aTHX_ "Can't modify %s in %s",
638bc118 1440 (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)
cd06dffe
GS
1441 ? "do block"
1442 : (o->op_type == OP_ENTERSUB
1443 ? "non-lvalue subroutine call"
1444 : PL_op_desc[o->op_type])),
22c35a8c 1445 type ? PL_op_desc[type] : "local"));
11343788 1446 return o;
79072805 1447
a0d0e21e
LW
1448 case OP_PREINC:
1449 case OP_PREDEC:
1450 case OP_POW:
1451 case OP_MULTIPLY:
1452 case OP_DIVIDE:
1453 case OP_MODULO:
1454 case OP_REPEAT:
1455 case OP_ADD:
1456 case OP_SUBTRACT:
1457 case OP_CONCAT:
1458 case OP_LEFT_SHIFT:
1459 case OP_RIGHT_SHIFT:
1460 case OP_BIT_AND:
1461 case OP_BIT_XOR:
1462 case OP_BIT_OR:
1463 case OP_I_MULTIPLY:
1464 case OP_I_DIVIDE:
1465 case OP_I_MODULO:
1466 case OP_I_ADD:
1467 case OP_I_SUBTRACT:
11343788 1468 if (!(o->op_flags & OPf_STACKED))
a0d0e21e 1469 goto nomod;
3280af22 1470 PL_modcount++;
a0d0e21e
LW
1471 break;
1472
79072805 1473 case OP_COND_EXPR:
11343788 1474 for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
463ee0b2 1475 mod(kid, type);
79072805
LW
1476 break;
1477
1478 case OP_RV2AV:
1479 case OP_RV2HV:
93af7a87 1480 if (!type && cUNOPo->op_first->op_type != OP_GV)
cea2e8a9 1481 Perl_croak(aTHX_ "Can't localize through a reference");
11343788 1482 if (type == OP_REFGEN && o->op_flags & OPf_PARENS) {
3280af22 1483 PL_modcount = 10000;
11343788 1484 return o; /* Treat \(@foo) like ordinary list. */
748a9306
LW
1485 }
1486 /* FALL THROUGH */
79072805 1487 case OP_RV2GV:
5dc0d613 1488 if (scalar_mod_type(o, type))
3fe9a6f1 1489 goto nomod;
11343788 1490 ref(cUNOPo->op_first, o->op_type);
79072805
LW
1491 /* FALL THROUGH */
1492 case OP_AASSIGN:
1493 case OP_ASLICE:
1494 case OP_HSLICE:
93a17b20
LW
1495 case OP_NEXTSTATE:
1496 case OP_DBSTATE:
a0d0e21e
LW
1497 case OP_REFGEN:
1498 case OP_CHOMP:
3280af22 1499 PL_modcount = 10000;
79072805 1500 break;
463ee0b2 1501 case OP_RV2SV:
11343788 1502 if (!type && cUNOPo->op_first->op_type != OP_GV)
cea2e8a9 1503 Perl_croak(aTHX_ "Can't localize through a reference");
aeea060c 1504 ref(cUNOPo->op_first, o->op_type);
463ee0b2 1505 /* FALL THROUGH */
79072805 1506 case OP_GV:
463ee0b2 1507 case OP_AV2ARYLEN:
3280af22 1508 PL_hints |= HINT_BLOCK_SCOPE;
463ee0b2 1509 case OP_SASSIGN:
bf4b1e52
GS
1510 case OP_ANDASSIGN:
1511 case OP_ORASSIGN:
8990e307 1512 case OP_AELEMFAST:
3280af22 1513 PL_modcount++;
8990e307
LW
1514 break;
1515
748a9306
LW
1516 case OP_PADAV:
1517 case OP_PADHV:
3280af22 1518 PL_modcount = 10000;
5196be3e
MB
1519 if (type == OP_REFGEN && o->op_flags & OPf_PARENS)
1520 return o; /* Treat \(@foo) like ordinary list. */
1521 if (scalar_mod_type(o, type))
3fe9a6f1 1522 goto nomod;
748a9306
LW
1523 /* FALL THROUGH */
1524 case OP_PADSV:
3280af22 1525 PL_modcount++;
748a9306 1526 if (!type)
cea2e8a9 1527 Perl_croak(aTHX_ "Can't localize lexical variable %s",
2d8e6c8d 1528 SvPV(*av_fetch(PL_comppad_name, o->op_targ, 4), n_a));
463ee0b2
LW
1529 break;
1530
554b3eca 1531#ifdef USE_THREADS
2faa37cc 1532 case OP_THREADSV:
533c011a 1533 PL_modcount++; /* XXX ??? */
554b3eca
MB
1534 break;
1535#endif /* USE_THREADS */
1536
748a9306
LW
1537 case OP_PUSHMARK:
1538 break;
a0d0e21e 1539
69969c6f
SB
1540 case OP_KEYS:
1541 if (type != OP_SASSIGN)
1542 goto nomod;
5d82c453
GA
1543 goto lvalue_func;
1544 case OP_SUBSTR:
1545 if (o->op_private == 4) /* don't allow 4 arg substr as lvalue */
1546 goto nomod;
5f05dabc 1547 /* FALL THROUGH */
a0d0e21e 1548 case OP_POS:
463ee0b2 1549 case OP_VEC:
5d82c453 1550 lvalue_func:
11343788
MB
1551 pad_free(o->op_targ);
1552 o->op_targ = pad_alloc(o->op_type, SVs_PADMY);
5dc0d613 1553 assert(SvTYPE(PAD_SV(o->op_targ)) == SVt_NULL);
11343788
MB
1554 if (o->op_flags & OPf_KIDS)
1555 mod(cBINOPo->op_first->op_sibling, type);
463ee0b2 1556 break;
a0d0e21e 1557
463ee0b2
LW
1558 case OP_AELEM:
1559 case OP_HELEM:
11343788 1560 ref(cBINOPo->op_first, o->op_type);
68dc0745 1561 if (type == OP_ENTERSUB &&
5dc0d613
MB
1562 !(o->op_private & (OPpLVAL_INTRO | OPpDEREF)))
1563 o->op_private |= OPpLVAL_DEFER;
3280af22 1564 PL_modcount++;
463ee0b2
LW
1565 break;
1566
1567 case OP_SCOPE:
1568 case OP_LEAVE:
1569 case OP_ENTER:
11343788
MB
1570 if (o->op_flags & OPf_KIDS)
1571 mod(cLISTOPo->op_last, type);
a0d0e21e
LW
1572 break;
1573
1574 case OP_NULL:
638bc118
GS
1575 if (o->op_flags & OPf_SPECIAL) /* do BLOCK */
1576 goto nomod;
1577 else if (!(o->op_flags & OPf_KIDS))
463ee0b2 1578 break;
11343788
MB
1579 if (o->op_targ != OP_LIST) {
1580 mod(cBINOPo->op_first, type);
a0d0e21e
LW
1581 break;
1582 }
1583 /* FALL THROUGH */
463ee0b2 1584 case OP_LIST:
11343788 1585 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
463ee0b2
LW
1586 mod(kid, type);
1587 break;
1588 }
11343788 1589 o->op_flags |= OPf_MOD;
a0d0e21e
LW
1590
1591 if (type == OP_AASSIGN || type == OP_SASSIGN)
11343788 1592 o->op_flags |= OPf_SPECIAL|OPf_REF;
a0d0e21e 1593 else if (!type) {
11343788
MB
1594 o->op_private |= OPpLVAL_INTRO;
1595 o->op_flags &= ~OPf_SPECIAL;
3280af22 1596 PL_hints |= HINT_BLOCK_SCOPE;
463ee0b2 1597 }
a0d0e21e 1598 else if (type != OP_GREPSTART && type != OP_ENTERSUB)
11343788
MB
1599 o->op_flags |= OPf_REF;
1600 return o;
463ee0b2
LW
1601}
1602
864dbfa3 1603STATIC bool
cea2e8a9 1604S_scalar_mod_type(pTHX_ OP *o, I32 type)
3fe9a6f1
PP
1605{
1606 switch (type) {
1607 case OP_SASSIGN:
5196be3e 1608 if (o->op_type == OP_RV2GV)
3fe9a6f1
PP
1609 return FALSE;
1610 /* FALL THROUGH */
1611 case OP_PREINC:
1612 case OP_PREDEC:
1613 case OP_POSTINC:
1614 case OP_POSTDEC:
1615 case OP_I_PREINC:
1616 case OP_I_PREDEC:
1617 case OP_I_POSTINC:
1618 case OP_I_POSTDEC:
1619 case OP_POW:
1620 case OP_MULTIPLY:
1621 case OP_DIVIDE:
1622 case OP_MODULO:
1623 case OP_REPEAT:
1624 case OP_ADD:
1625 case OP_SUBTRACT:
1626 case OP_I_MULTIPLY:
1627 case OP_I_DIVIDE:
1628 case OP_I_MODULO:
1629 case OP_I_ADD:
1630 case OP_I_SUBTRACT:
1631 case OP_LEFT_SHIFT:
1632 case OP_RIGHT_SHIFT:
1633 case OP_BIT_AND:
1634 case OP_BIT_XOR:
1635 case OP_BIT_OR:
1636 case OP_CONCAT:
1637 case OP_SUBST:
1638 case OP_TRANS:
49e9fbe6
GS
1639 case OP_READ:
1640 case OP_SYSREAD:
1641 case OP_RECV:
bf4b1e52
GS
1642 case OP_ANDASSIGN:
1643 case OP_ORASSIGN:
3fe9a6f1
PP
1644 return TRUE;
1645 default:
1646 return FALSE;
1647 }
1648}
1649
35cd451c 1650STATIC bool
cea2e8a9 1651S_is_handle_constructor(pTHX_ OP *o, I32 argnum)
35cd451c
GS
1652{
1653 switch (o->op_type) {
1654 case OP_PIPE_OP:
1655 case OP_SOCKPAIR:
1656 if (argnum == 2)
1657 return TRUE;
1658 /* FALL THROUGH */
1659 case OP_SYSOPEN:
1660 case OP_OPEN:
ded8aa31 1661 case OP_SELECT: /* XXX c.f. SelectSaver.pm */
35cd451c
GS
1662 case OP_SOCKET:
1663 case OP_OPEN_DIR:
1664 case OP_ACCEPT:
1665 if (argnum == 1)
1666 return TRUE;
1667 /* FALL THROUGH */
1668 default:
1669 return FALSE;
1670 }
1671}
1672
463ee0b2 1673OP *
864dbfa3 1674Perl_refkids(pTHX_ OP *o, I32 type)
463ee0b2
LW
1675{
1676 OP *kid;
11343788
MB
1677 if (o && o->op_flags & OPf_KIDS) {
1678 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
463ee0b2
LW
1679 ref(kid, type);
1680 }
11343788 1681 return o;
463ee0b2
LW
1682}
1683
1684OP *
864dbfa3 1685Perl_ref(pTHX_ OP *o, I32 type)
463ee0b2
LW
1686{
1687 OP *kid;
463ee0b2 1688
3280af22 1689 if (!o || PL_error_count)
11343788 1690 return o;
463ee0b2 1691
11343788 1692 switch (o->op_type) {
a0d0e21e 1693 case OP_ENTERSUB:
afebc493 1694 if ((type == OP_EXISTS || type == OP_DEFINED || type == OP_LOCK) &&
11343788
MB
1695 !(o->op_flags & OPf_STACKED)) {
1696 o->op_type = OP_RV2CV; /* entersub => rv2cv */
22c35a8c 1697 o->op_ppaddr = PL_ppaddr[OP_RV2CV];
11343788
MB
1698 assert(cUNOPo->op_first->op_type == OP_NULL);
1699 null(((LISTOP*)cUNOPo->op_first)->op_first); /* disable pushmark */
1700 o->op_flags |= OPf_SPECIAL;
8990e307
LW
1701 }
1702 break;
aeea060c 1703
463ee0b2 1704 case OP_COND_EXPR:
11343788 1705 for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
463ee0b2
LW
1706 ref(kid, type);
1707 break;
8990e307 1708 case OP_RV2SV:
35cd451c
GS
1709 if (type == OP_DEFINED)
1710 o->op_flags |= OPf_SPECIAL; /* don't create GV */
11343788 1711 ref(cUNOPo->op_first, o->op_type);
4633a7c4
LW
1712 /* FALL THROUGH */
1713 case OP_PADSV:
5f05dabc 1714 if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
5dc0d613
MB
1715 o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
1716 : type == OP_RV2HV ? OPpDEREF_HV
1717 : OPpDEREF_SV);
11343788 1718 o->op_flags |= OPf_MOD;
a0d0e21e 1719 }
8990e307
LW
1720 break;
1721
2faa37cc 1722 case OP_THREADSV:
a863c7d1
MB
1723 o->op_flags |= OPf_MOD; /* XXX ??? */
1724 break;
1725
463ee0b2
LW
1726 case OP_RV2AV:
1727 case OP_RV2HV:
aeea060c 1728 o->op_flags |= OPf_REF;
8990e307 1729 /* FALL THROUGH */
463ee0b2 1730 case OP_RV2GV:
35cd451c
GS
1731 if (type == OP_DEFINED)
1732 o->op_flags |= OPf_SPECIAL; /* don't create GV */
11343788 1733 ref(cUNOPo->op_first, o->op_type);
463ee0b2 1734 break;
8990e307 1735
463ee0b2
LW
1736 case OP_PADAV:
1737 case OP_PADHV:
aeea060c 1738 o->op_flags |= OPf_REF;
79072805 1739 break;
aeea060c 1740
8990e307 1741 case OP_SCALAR:
79072805 1742 case OP_NULL:
11343788 1743 if (!(o->op_flags & OPf_KIDS))
463ee0b2 1744 break;
11343788 1745 ref(cBINOPo->op_first, type);
79072805
LW
1746 break;
1747 case OP_AELEM:
1748 case OP_HELEM:
11343788 1749 ref(cBINOPo->op_first, o->op_type);
5f05dabc 1750 if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
5dc0d613
MB
1751 o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
1752 : type == OP_RV2HV ? OPpDEREF_HV
1753 : OPpDEREF_SV);
11343788 1754 o->op_flags |= OPf_MOD;
8990e307 1755 }
79072805
LW
1756 break;
1757
463ee0b2 1758 case OP_SCOPE:
79072805
LW
1759 case OP_LEAVE:
1760 case OP_ENTER:
8990e307 1761 case OP_LIST:
11343788 1762 if (!(o->op_flags & OPf_KIDS))
79072805 1763 break;
11343788 1764 ref(cLISTOPo->op_last, type);
79072805 1765 break;
a0d0e21e
LW
1766 default:
1767 break;
79072805 1768 }
11343788 1769 return scalar(o);
8990e307 1770
79072805
LW
1771}
1772
09bef843
SB
1773STATIC OP *
1774S_dup_attrlist(pTHX_ OP *o)
1775{
1776 OP *rop = Nullop;
1777
1778 /* An attrlist is either a simple OP_CONST or an OP_LIST with kids,
1779 * where the first kid is OP_PUSHMARK and the remaining ones
1780 * are OP_CONST. We need to push the OP_CONST values.
1781 */
1782 if (o->op_type == OP_CONST)
1783 rop = newSVOP(OP_CONST, o->op_flags, SvREFCNT_inc(cSVOPo->op_sv));
1784 else {
1785 assert((o->op_type == OP_LIST) && (o->op_flags & OPf_KIDS));
1786 for (o = cLISTOPo->op_first; o; o=o->op_sibling) {
1787 if (o->op_type == OP_CONST)
1788 rop = append_elem(OP_LIST, rop,
1789 newSVOP(OP_CONST, o->op_flags,
1790 SvREFCNT_inc(cSVOPo->op_sv)));
1791 }
1792 }
1793 return rop;
1794}
1795
1796STATIC void
1797S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
1798{
1799 OP *modname; /* for 'use' */
1800 SV *stashsv;
1801
1802 /* fake up C<use attributes $pkg,$rv,@attrs> */
1803 ENTER; /* need to protect against side-effects of 'use' */
1804 SAVEINT(PL_expect);
1805 if (stash && HvNAME(stash))
1806 stashsv = newSVpv(HvNAME(stash), 0);
1807 else
1808 stashsv = &PL_sv_no;
1809#define ATTRSMODULE "attributes"
1810 modname = newSVOP(OP_CONST, 0,
1811 newSVpvn(ATTRSMODULE, sizeof(ATTRSMODULE)-1));
1812 modname->op_private |= OPpCONST_BARE;
1813 /* that flag is required to make 'use' work right */
1814 utilize(1, start_subparse(FALSE, 0),
1815 Nullop, /* version */
1816 modname,
1817 prepend_elem(OP_LIST,
1818 newSVOP(OP_CONST, 0, stashsv),
1819 prepend_elem(OP_LIST,
1820 newSVOP(OP_CONST, 0, newRV(target)),
1821 dup_attrlist(attrs))));
1822 LEAVE;
1823}
1824
1825STATIC OP *
1826S_my_kid(pTHX_ OP *o, OP *attrs)
93a17b20
LW
1827{
1828 OP *kid;
93a17b20
LW
1829 I32 type;
1830
3280af22 1831 if (!o || PL_error_count)
11343788 1832 return o;
93a17b20 1833
11343788 1834 type = o->op_type;
93a17b20 1835 if (type == OP_LIST) {
11343788 1836 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
09bef843 1837 my_kid(kid, attrs);
dab48698 1838 } else if (type == OP_UNDEF) {
7766148a 1839 return o;
77ca0c92
LW
1840 } else if (type == OP_RV2SV || /* "our" declaration */
1841 type == OP_RV2AV ||
1842 type == OP_RV2HV) { /* XXX does this let anything illegal in? */
192587c2 1843 o->op_private |= OPpOUR_INTRO;
77ca0c92 1844 return o;
dab48698 1845 } else if (type != OP_PADSV &&
93a17b20
LW
1846 type != OP_PADAV &&
1847 type != OP_PADHV &&
1848 type != OP_PUSHMARK)
1849 {
cea2e8a9 1850 yyerror(Perl_form(aTHX_ "Can't declare %s in my", PL_op_desc[o->op_type]));
11343788 1851 return o;
93a17b20 1852 }
09bef843
SB
1853 else if (attrs && type != OP_PUSHMARK) {
1854 HV *stash;
1855 SV *padsv;
1856 SV **namesvp;
1857
1858 /* check for C<my Dog $spot> when deciding package */
1859 namesvp = av_fetch(PL_comppad_name, o->op_targ, FALSE);
1860 if (namesvp && *namesvp && SvOBJECT(*namesvp) && HvNAME(SvSTASH(*namesvp)))
1861 stash = SvSTASH(*namesvp);
1862 else
1863 stash = PL_curstash;
1864 padsv = PAD_SV(o->op_targ);
1865 apply_attrs(stash, padsv, attrs);
1866 }
11343788
MB
1867 o->op_flags |= OPf_MOD;
1868 o->op_private |= OPpLVAL_INTRO;
1869 return o;
93a17b20
LW
1870}
1871
1872OP *
09bef843
SB
1873Perl_my_attrs(pTHX_ OP *o, OP *attrs)
1874{
1875 if (o->op_flags & OPf_PARENS)
1876 list(o);
1877 PL_in_my = FALSE;
1878 PL_in_my_stash = Nullhv;
1879 if (attrs)
1880 SAVEFREEOP(attrs);
1881 return my_kid(o, attrs);
1882}
1883
1884OP *
1885Perl_my(pTHX_ OP *o)
1886{
1887 return my_kid(o, Nullop);
1888}
1889
1890OP *
864dbfa3 1891Perl_sawparens(pTHX_ OP *o)
79072805
LW
1892{
1893 if (o)
1894 o->op_flags |= OPf_PARENS;
1895 return o;
1896}
1897
1898OP *
864dbfa3 1899Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
79072805 1900{
d008e5eb 1901 dTHR;
11343788 1902 OP *o;
79072805 1903
599cee73
PM
1904 if (ckWARN(WARN_UNSAFE) &&
1905 (left->op_type == OP_RV2AV ||
1906 left->op_type == OP_RV2HV ||
1907 left->op_type == OP_PADAV ||
1908 left->op_type == OP_PADHV)) {
22c35a8c 1909 char *desc = PL_op_desc[(right->op_type == OP_SUBST ||
599cee73
PM
1910 right->op_type == OP_TRANS)
1911 ? right->op_type : OP_MATCH];
dff6d3cd
GS
1912 const char *sample = ((left->op_type == OP_RV2AV ||
1913 left->op_type == OP_PADAV)
1914 ? "@array" : "%hash");
cea2e8a9 1915 Perl_warner(aTHX_ WARN_UNSAFE,
599cee73
PM
1916 "Applying %s to %s will act on scalar(%s)",
1917 desc, sample, sample);
2ae324a7
PP
1918 }
1919
79072805
LW
1920 if (right->op_type == OP_MATCH ||
1921 right->op_type == OP_SUBST ||
1922 right->op_type == OP_TRANS) {
1923 right->op_flags |= OPf_STACKED;
1924 if (right->op_type != OP_MATCH)
463ee0b2 1925 left = mod(left, right->op_type);
79072805 1926 if (right->op_type == OP_TRANS)
11343788 1927 o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
79072805 1928 else
11343788 1929 o = prepend_elem(right->op_type, scalar(left), right);
79072805 1930 if (type == OP_NOT)
11343788
MB
1931 return newUNOP(OP_NOT, 0, scalar(o));
1932 return o;
79072805
LW
1933 }
1934 else
1935 return bind_match(type, left,
1936 pmruntime(newPMOP(OP_MATCH, 0), right, Nullop));
1937}
1938
1939OP *
864dbfa3 1940Perl_invert(pTHX_ OP *o)
79072805 1941{
11343788
MB
1942 if (!o)
1943 return o;
79072805 1944 /* XXX need to optimize away NOT NOT here? Or do we let optimizer do it? */
11343788 1945 return newUNOP(OP_NOT, OPf_SPECIAL, scalar(o));
79072805
LW
1946}
1947
1948OP *
864dbfa3 1949Perl_scope(pTHX_ OP *o)
79072805
LW
1950{
1951 if (o) {
3280af22 1952 if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || PL_tainting) {
463ee0b2
LW
1953 o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
1954 o->op_type = OP_LEAVE;
22c35a8c 1955 o->op_ppaddr = PL_ppaddr[OP_LEAVE];
463ee0b2
LW
1956 }
1957 else {
1958 if (o->op_type == OP_LINESEQ) {
1959 OP *kid;
1960 o->op_type = OP_SCOPE;
22c35a8c 1961 o->op_ppaddr = PL_ppaddr[OP_SCOPE];
c3ed7a6a
GS
1962 kid = ((LISTOP*)o)->op_first;
1963 if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE)
1964 null(kid);
463ee0b2
LW
1965 }
1966 else
748a9306 1967 o = newLISTOP(OP_SCOPE, 0, o, Nullop);
463ee0b2 1968 }
79072805
LW
1969 }
1970 return o;
1971}
1972
b3ac6de7 1973void
864dbfa3 1974Perl_save_hints(pTHX)
b3ac6de7 1975{
3280af22
NIS
1976 SAVEI32(PL_hints);
1977 SAVESPTR(GvHV(PL_hintgv));
1978 GvHV(PL_hintgv) = newHVhv(GvHV(PL_hintgv));
1979 SAVEFREESV(GvHV(PL_hintgv));
b3ac6de7
IZ
1980}
1981
a0d0e21e 1982int
864dbfa3 1983Perl_block_start(pTHX_ int full)
79072805 1984{
11343788 1985 dTHR;
3280af22 1986 int retval = PL_savestack_ix;
b3ac6de7 1987
3280af22 1988 SAVEI32(PL_comppad_name_floor);
55497cff 1989 if (full) {
3280af22
NIS
1990 if ((PL_comppad_name_fill = AvFILLp(PL_comppad_name)) > 0)
1991 PL_comppad_name_floor = PL_comppad_name_fill;
55497cff 1992 else
3280af22
NIS
1993 PL_comppad_name_floor = 0;
1994 }
1995 SAVEI32(PL_min_intro_pending);
1996 SAVEI32(PL_max_intro_pending);
1997 PL_min_intro_pending = 0;
1998 SAVEI32(PL_comppad_name_fill);
1999 SAVEI32(PL_padix_floor);
2000 PL_padix_floor = PL_padix;
2001 PL_pad_reset_pending = FALSE;
b3ac6de7 2002 SAVEHINTS();
3280af22 2003 PL_hints &= ~HINT_BLOCK_SCOPE;
7766f137 2004 SAVESPTR(PL_compiling.cop_warnings);
0453d815 2005 if (! specialWARN(PL_compiling.cop_warnings)) {
599cee73
PM
2006 PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
2007 SAVEFREESV(PL_compiling.cop_warnings) ;
2008 }
2009
2010
a0d0e21e
LW
2011 return retval;
2012}
2013
2014OP*
864dbfa3 2015Perl_block_end(pTHX_ I32 floor, OP *seq)
a0d0e21e 2016{
11343788 2017 dTHR;
3280af22 2018 int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
a0d0e21e 2019 OP* retval = scalarseq(seq);
a0d0e21e 2020 LEAVE_SCOPE(floor);
3280af22 2021 PL_pad_reset_pending = FALSE;
e24b16f9 2022 PL_compiling.op_private = PL_hints;
a0d0e21e 2023 if (needblockscope)
3280af22
NIS
2024 PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
2025 pad_leavemy(PL_comppad_name_fill);
2026 PL_cop_seqmax++;
a0d0e21e
LW
2027 return retval;
2028}
2029
76e3520e 2030STATIC OP *
cea2e8a9 2031S_newDEFSVOP(pTHX)
54b9620d
MB
2032{
2033#ifdef USE_THREADS
2034 OP *o = newOP(OP_THREADSV, 0);
2035 o->op_targ = find_threadsv("_");
2036 return o;
2037#else
3280af22 2038 return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
54b9620d
MB
2039#endif /* USE_THREADS */
2040}
2041
a0d0e21e 2042void
864dbfa3 2043Perl_newPROG(pTHX_ OP *o)
a0d0e21e 2044{
11343788 2045 dTHR;
3280af22 2046 if (PL_in_eval) {
b295d113
TH
2047 if (PL_eval_root)
2048 return;
faef0170
HS
2049 PL_eval_root = newUNOP(OP_LEAVEEVAL,
2050 ((PL_in_eval & EVAL_KEEPERR)
2051 ? OPf_SPECIAL : 0), o);
3280af22 2052 PL_eval_start = linklist(PL_eval_root);
7934575e
GS
2053 PL_eval_root->op_private |= OPpREFCOUNTED;
2054 OpREFCNT_set(PL_eval_root, 1);
3280af22
NIS
2055 PL_eval_root->op_next = 0;
2056 peep(PL_eval_start);
a0d0e21e
LW
2057 }
2058 else {
5dc0d613 2059 if (!o)
a0d0e21e 2060 return;
3280af22
NIS
2061 PL_main_root = scope(sawparens(scalarvoid(o)));
2062 PL_curcop = &PL_compiling;
2063 PL_main_start = LINKLIST(PL_main_root);
7934575e
GS
2064 PL_main_root->op_private |= OPpREFCOUNTED;
2065 OpREFCNT_set(PL_main_root, 1);
3280af22
NIS
2066 PL_main_root->op_next = 0;
2067 peep(PL_main_start);
2068 PL_compcv = 0;
3841441e 2069
4fdae800 2070 /* Register with debugger */
84902520 2071 if (PERLDB_INTER) {
864dbfa3 2072 CV *cv = get_cv("DB::postponed", FALSE);
3841441e
CS
2073 if (cv) {
2074 dSP;
924508f0 2075 PUSHMARK(SP);
cc49e20b 2076 XPUSHs((SV*)CopFILEGV(&PL_compiling));
3841441e 2077 PUTBACK;
864dbfa3 2078 call_sv((SV*)cv, G_DISCARD);
3841441e
CS
2079 }
2080 }
79072805 2081 }
79072805
LW
2082}
2083
2084OP *
864dbfa3 2085Perl_localize(pTHX_ OP *o, I32 lex)
79072805
LW
2086{
2087 if (o->op_flags & OPf_PARENS)
2088 list(o);
8990e307 2089 else {
d008e5eb 2090 dTHR;
599cee73 2091 if (ckWARN(WARN_PARENTHESIS) && PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ',') {
8990e307 2092 char *s;
834a4ddd 2093 for (s = PL_bufptr; *s && (isALNUM(*s) || (*s & 0x80) || strchr("@$%, ",*s)); s++) ;
a0d0e21e 2094 if (*s == ';' || *s == '=')
cea2e8a9 2095 Perl_warner(aTHX_ WARN_PARENTHESIS, "Parentheses missing around \"%s\" list",
599cee73 2096 lex ? "my" : "local");
8990e307
LW
2097 }
2098 }
3280af22
NIS
2099 PL_in_my = FALSE;
2100 PL_in_my_stash = Nullhv;
93a17b20
LW
2101 if (lex)
2102 return my(o);
2103 else
463ee0b2 2104 return mod(o, OP_NULL); /* a bit kludgey */
79072805
LW
2105}
2106
2107OP *
864dbfa3 2108Perl_jmaybe(pTHX_ OP *o)
79072805
LW
2109{
2110 if (o->op_type == OP_LIST) {
554b3eca
MB
2111 OP *o2;
2112#ifdef USE_THREADS
2faa37cc 2113 o2 = newOP(OP_THREADSV, 0);
54b9620d 2114 o2->op_targ = find_threadsv(";");
554b3eca
MB
2115#else
2116 o2 = newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
2117#endif /* USE_THREADS */
2118 o = convert(OP_JOIN, 0, prepend_elem(OP_LIST, o2, o));
79072805
LW
2119 }
2120 return o;
2121}
2122
2123OP *
864dbfa3 2124Perl_fold_constants(pTHX_ register OP *o)
79072805 2125{
11343788 2126 dTHR;
79072805
LW
2127 register OP *curop;
2128 I32 type = o->op_type;
748a9306 2129 SV *sv;
79072805 2130
22c35a8c 2131 if (PL_opargs[type] & OA_RETSCALAR)
79072805 2132 scalar(o);
b162f9ea 2133 if (PL_opargs[type] & OA_TARGET && !o->op_targ)
ed6116ce 2134 o->op_targ = pad_alloc(type, SVs_PADTMP);
79072805 2135
eac055e9
GS
2136 /* integerize op, unless it happens to be C<-foo>.
2137 * XXX should pp_i_negate() do magic string negation instead? */
2138 if ((PL_opargs[type] & OA_OTHERINT) && (PL_hints & HINT_INTEGER)
2139 && !(type == OP_NEGATE && cUNOPo->op_first->op_type == OP_CONST
2140 && (cUNOPo->op_first->op_private & OPpCONST_BARE)))
2141 {
22c35a8c 2142 o->op_ppaddr = PL_ppaddr[type = ++(o->op_type)];
eac055e9 2143 }
85e6fe83 2144
22c35a8c 2145 if (!(PL_opargs[type] & OA_FOLDCONST))
79072805
LW
2146 goto nope;
2147
de939608 2148 switch (type) {
7a52d87a
GS
2149 case OP_NEGATE:
2150 /* XXX might want a ck_negate() for this */
2151 cUNOPo->op_first->op_private &= ~OPpCONST_STRICT;
2152 break;
de939608
CS
2153 case OP_SPRINTF:
2154 case OP_UCFIRST:
2155 case OP_LCFIRST:
2156 case OP_UC:
2157 case OP_LC:
69dcf70c
MB
2158 case OP_SLT:
2159 case OP_SGT:
2160 case OP_SLE:
2161 case OP_SGE:
2162 case OP_SCMP:
2163
de939608
CS
2164 if (o->op_private & OPpLOCALE)
2165 goto nope;
2166 }
2167
3280af22 2168 if (PL_error_count)
a0d0e21e
LW
2169 goto nope; /* Don't try to run w/ errors */
2170
79072805 2171 for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
11fa937b
GS
2172 if ((curop->op_type != OP_CONST ||
2173 (curop->op_private & OPpCONST_BARE)) &&
7a52d87a
GS
2174 curop->op_type != OP_LIST &&
2175 curop->op_type != OP_SCALAR &&
2176 curop->op_type != OP_NULL &&
2177 curop->op_type != OP_PUSHMARK)
2178 {
79072805
LW
2179 goto nope;
2180 }
2181 }
2182
2183 curop = LINKLIST(o);
2184 o->op_next = 0;
533c011a 2185 PL_op = curop;
cea2e8a9 2186 CALLRUNOPS(aTHX);
3280af22 2187 sv = *(PL_stack_sp--);
748a9306 2188 if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */
79072805 2189 pad_swipe(o->op_targ);
748a9306
LW
2190 else if (SvTEMP(sv)) { /* grab mortal temp? */
2191 (void)SvREFCNT_inc(sv);
2192 SvTEMP_off(sv);
85e6fe83 2193 }
79072805
LW
2194 op_free(o);
2195 if (type == OP_RV2GV)
b1cb66bf 2196 return newGVOP(OP_GV, 0, (GV*)sv);
748a9306 2197 else {
ee580363
GS
2198 /* try to smush double to int, but don't smush -2.0 to -2 */
2199 if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK &&
2200 type != OP_NEGATE)
2201 {
748a9306 2202 IV iv = SvIV(sv);
65202027 2203 if ((NV)iv == SvNV(sv)) {
748a9306
LW
2204 SvREFCNT_dec(sv);
2205 sv = newSViv(iv);
2206 }
b1cb66bf
PP
2207 else
2208 SvIOK_off(sv); /* undo SvIV() damage */
748a9306
LW
2209 }
2210 return newSVOP(OP_CONST, 0, sv);
2211 }
aeea060c 2212
79072805 2213 nope:
22c35a8c 2214 if (!(PL_opargs[type] & OA_OTHERINT))
79072805 2215 return o;
79072805 2216
3280af22 2217 if (!(PL_hints & HINT_INTEGER)) {
4bb9f687
GS
2218 if (type == OP_MODULO
2219 || type == OP_DIVIDE
2220 || !(o->op_flags & OPf_KIDS))
2221 {
85e6fe83 2222 return o;
4bb9f687 2223 }
85e6fe83
LW
2224
2225 for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
2226 if (curop->op_type == OP_CONST) {
b1cb66bf 2227 if (SvIOK(((SVOP*)curop)->op_sv))
85e6fe83
LW
2228 continue;
2229 return o;
2230 }
22c35a8c 2231 if (PL_opargs[curop->op_type] & OA_RETINTEGER)
79072805
LW
2232 continue;
2233 return o;
2234 }
22c35a8c 2235 o->op_ppaddr = PL_ppaddr[++(o->op_type)];
79072805
LW
2236 }
2237
79072805
LW
2238 return o;
2239}
2240
2241OP *
864dbfa3 2242Perl_gen_constant_list(pTHX_ register OP *o)
79072805 2243{
11343788 2244 dTHR;
79072805 2245 register OP *curop;
3280af22 2246 I32 oldtmps_floor = PL_tmps_floor;
79072805 2247
a0d0e21e 2248 list(o);
3280af22 2249 if (PL_error_count)
a0d0e21e
LW
2250 return o; /* Don't attempt to run with errors */
2251
533c011a 2252 PL_op = curop = LINKLIST(o);
a0d0e21e 2253 o->op_next = 0;
7d4045d4 2254 peep(curop);
cea2e8a9
GS
2255 pp_pushmark();
2256 CALLRUNOPS(aTHX);
533c011a 2257 PL_op = curop;
cea2e8a9 2258 pp_anonlist();
3280af22 2259 PL_tmps_floor = oldtmps_floor;
79072805
LW
2260
2261 o->op_type = OP_RV2AV;
22c35a8c 2262 o->op_ppaddr = PL_ppaddr[OP_RV2AV];
79072805 2263 curop = ((UNOP*)o)->op_first;
3280af22 2264 ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*PL_stack_sp--));
79072805 2265 op_free(curop);
79072805
LW
2266 linklist(o);
2267 return list(o);
2268}
2269
2270OP *
864dbfa3 2271Perl_convert(pTHX_ I32 type, I32 flags, OP *o)
79072805
LW
2272{
2273 OP *kid;
a0d0e21e 2274 OP *last = 0;
79072805 2275
11343788
MB
2276 if (!o || o->op_type != OP_LIST)
2277 o = newLISTOP(OP_LIST, 0, o, Nullop);
748a9306 2278 else
5dc0d613 2279 o->op_flags &= ~OPf_WANT;
79072805 2280
22c35a8c 2281 if (!(PL_opargs[type] & OA_MARK))
11343788 2282 null(cLISTOPo->op_first);
8990e307 2283
11343788 2284 o->op_type = type;
22c35a8c 2285 o->op_ppaddr = PL_ppaddr[type];
11343788 2286 o->op_flags |= flags;
79072805 2287
11343788
MB
2288 o = CHECKOP(type, o);
2289 if (o->op_type != type)
2290 return o;
79072805 2291
11343788 2292 if (cLISTOPo->op_children < 7) {
79072805 2293 /* XXX do we really need to do this if we're done appending?? */
11343788 2294 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
79072805 2295 last = kid;
11343788 2296 cLISTOPo->op_last = last; /* in case check substituted last arg */
79072805
LW
2297 }
2298
11343788 2299 return fold_constants(o);
79072805
LW
2300}
2301
2302/* List constructors */
2303
2304OP *
864dbfa3 2305Perl_append_elem(pTHX_ I32 type, OP *first, OP *last)
79072805
LW
2306{
2307 if (!first)
2308 return last;
8990e307
LW
2309
2310 if (!last)
79072805 2311 return first;
8990e307 2312
a0d0e21e
LW
2313 if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS)
2314 return newLISTOP(type, 0, first, last);
79072805 2315
a0d0e21e
LW
2316 if (first->op_flags & OPf_KIDS)
2317 ((LISTOP*)first)->op_last->op_sibling = last;
2318 else {
2319 first->op_flags |= OPf_KIDS;
2320 ((LISTOP*)first)->op_first = last;
2321 }
2322 ((LISTOP*)first)->op_last = last;
2323 ((LISTOP*)first)->op_children++;
2324 return first;
79072805
LW
2325}
2326
2327OP *
864dbfa3 2328Perl_append_list(pTHX_ I32 type, LISTOP *first, LISTOP *last)
79072805
LW
2329{
2330 if (!first)
2331 return (OP*)last;
8990e307
LW
2332
2333 if (!last)
79072805 2334 return (OP*)first;
8990e307
LW
2335
2336 if (first->op_type != type)
79072805 2337 return prepend_elem(type, (OP*)first, (OP*)last);
8990e307
LW
2338
2339 if (last->op_type != type)
79072805
LW
2340 return append_elem(type, (OP*)first, (OP*)last);
2341
2342 first->op_last->op_sibling = last->op_first;
2343 first->op_last = last->op_last;
2344 first->op_children += last->op_children;
2345 if (first->op_children)
acb74605 2346 first->op_flags |= OPf_KIDS;
b7dc083c
NIS
2347
2348#ifdef PL_OP_SLAB_ALLOC
2349#else
2350 Safefree(last);
2351#endif
79072805
LW
2352 return (OP*)first;
2353}
2354
2355OP *
864dbfa3 2356Perl_prepend_elem(pTHX_ I32 type, OP *first, OP *last)
79072805
LW
2357{
2358 if (!first)
2359 return last;
8990e307
LW
2360
2361 if (!last)
79072805 2362 return first;
8990e307
LW
2363
2364 if (last->op_type == type) {
2365 if (type == OP_LIST) { /* already a PUSHMARK there */
2366 first->op_sibling = ((LISTOP*)last)->op_first->op_sibling;
2367 ((LISTOP*)last)->op_first->op_sibling = first;
2368 }
2369 else {
2370 if (!(last->op_flags & OPf_KIDS)) {
2371 ((LISTOP*)last)->op_last = first;
2372 last->op_flags |= OPf_KIDS;
2373 }
2374 first->op_sibling = ((LISTOP*)last)->op_first;
2375 ((LISTOP*)last)->op_first = first;
79072805 2376 }
79072805
LW
2377 ((LISTOP*)last)->op_children++;
2378 return last;
2379 }
2380
2381 return newLISTOP(type, 0, first, last);
2382}
2383
2384/* Constructors */
2385
2386OP *
864dbfa3 2387Perl_newNULLLIST(pTHX)
79072805 2388{
8990e307
LW
2389 return newOP(OP_STUB, 0);
2390}
2391
2392OP *
864dbfa3 2393Perl_force_list(pTHX_ OP *o)
8990e307 2394{
11343788
MB
2395 if (!o || o->op_type != OP_LIST)
2396 o = newLISTOP(OP_LIST, 0, o, Nullop);
2397 null(o);
2398 return o;
79072805
LW
2399}
2400
2401OP *
864dbfa3 2402Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
79072805
LW
2403{
2404 LISTOP *listop;
2405
b7dc083c 2406 NewOp(1101, listop, 1, LISTOP);
79072805
LW
2407
2408 listop->op_type = type;
22c35a8c 2409 listop->op_ppaddr = PL_ppaddr[type];
79072805
LW
2410 listop->op_children = (first != 0) + (last != 0);
2411 listop->op_flags = flags;
79072805
LW
2412
2413 if (!last && first)
2414 last = first;
2415 else if (!first && last)
2416 first = last;
8990e307
LW
2417 else if (first)
2418 first->op_sibling = last;
79072805
LW
2419 listop->op_first = first;
2420 listop->op_last = last;
8990e307
LW
2421 if (type == OP_LIST) {
2422 OP* pushop;
2423 pushop = newOP(OP_PUSHMARK, 0);
2424 pushop->op_sibling = first;
2425 listop->op_first = pushop;
2426 listop->op_flags |= OPf_KIDS;
2427 if (!last)
2428 listop->op_last = pushop;
2429 }
2430 else if (listop->op_children)
2431 listop->op_flags |= OPf_KIDS;
79072805
LW
2432
2433 return (OP*)listop;
2434}
2435
2436OP *
864dbfa3 2437Perl_newOP(pTHX_ I32 type, I32 flags)
79072805 2438{
11343788 2439 OP *o;
b7dc083c 2440 NewOp(1101, o, 1, OP);
11343788 2441 o->op_type = type;
22c35a8c 2442 o->op_ppaddr = PL_ppaddr[type];
11343788 2443 o->op_flags = flags;
79072805 2444
11343788
MB
2445 o->op_next = o;
2446 o->op_private = 0 + (flags >> 8);
22c35a8c 2447 if (PL_opargs[type] & OA_RETSCALAR)
11343788 2448 scalar(o);
22c35a8c 2449 if (PL_opargs[type] & OA_TARGET)
11343788
MB
2450 o->op_targ = pad_alloc(type, SVs_PADTMP);
2451 return CHECKOP(type, o);
79072805
LW
2452}
2453
2454OP *
864dbfa3 2455Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
79072805
LW
2456{
2457 UNOP *unop;
2458
93a17b20 2459 if (!first)
aeea060c 2460 first = newOP(OP_STUB, 0);
22c35a8c 2461 if (PL_opargs[type] & OA_MARK)
8990e307 2462 first = force_list(first);
93a17b20 2463
b7dc083c 2464 NewOp(1101, unop, 1, UNOP);
79072805 2465 unop->op_type = type;
22c35a8c 2466 unop->op_ppaddr = PL_ppaddr[type];
79072805
LW
2467 unop->op_first = first;
2468 unop->op_flags = flags | OPf_KIDS;
c07a80fd 2469 unop->op_private = 1 | (flags >> 8);
e50aee73 2470 unop = (UNOP*) CHECKOP(type, unop);
79072805
LW
2471 if (unop->op_next)
2472 return (OP*)unop;
2473
a0d0e21e 2474 return fold_constants((OP *) unop);
79072805
LW
2475}
2476
2477OP *
864dbfa3 2478Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
79072805
LW
2479{
2480 BINOP *binop;
b7dc083c 2481 NewOp(1101, binop, 1, BINOP);
79072805
LW
2482
2483 if (!first)
2484 first = newOP(OP_NULL, 0);
2485
2486 binop->op_type = type;
22c35a8c 2487 binop->op_ppaddr = PL_ppaddr[type];
79072805
LW
2488 binop->op_first = first;
2489 binop->op_flags = flags | OPf_KIDS;
2490 if (!last) {
2491 last = first;
c07a80fd 2492 binop->op_private = 1 | (flags >> 8);
79072805
LW
2493 }
2494 else {
c07a80fd 2495 binop->op_private = 2 | (flags >> 8);
79072805
LW
2496 first->op_sibling = last;
2497 }
2498
e50aee73 2499 binop = (BINOP*)CHECKOP(type, binop);
b162f9ea 2500 if (binop->op_next || binop->op_type != type)
79072805
LW
2501 return (OP*)binop;
2502
7284ab6f 2503 binop->op_last = binop->op_first->op_sibling;
79072805 2504
a0d0e21e 2505 return fold_constants((OP *)binop);
79072805
LW
2506}
2507
a0ed51b3
LW
2508static int
2509utf8compare(const void *a, const void *b)
2510{
2511 int i;
2512 for (i = 0; i < 10; i++) {
2513 if ((*(U8**)a)[i] < (*(U8**)b)[i])
2514 return -1;
2515 if ((*(U8**)a)[i] > (*(U8**)b)[i])
2516 return 1;
2517 }
2518 return 0;
2519}
2520
79072805 2521OP *
864dbfa3 2522Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
79072805 2523{
79072805
LW
2524 SV *tstr = ((SVOP*)expr)->op_sv;
2525 SV *rstr = ((SVOP*)repl)->op_sv;
463ee0b2
LW
2526 STRLEN tlen;
2527 STRLEN rlen;
ec49126f
PP
2528 register U8 *t = (U8*)SvPV(tstr, tlen);
2529 register U8 *r = (U8*)SvPV(rstr, rlen);
79072805
LW
2530 register I32 i;
2531 register I32 j;
a0ed51b3 2532 I32 del;
79072805 2533 I32 complement;
5d06d08e 2534 I32 squash;
79072805
LW
2535 register short *tbl;
2536
11343788 2537 complement = o->op_private & OPpTRANS_COMPLEMENT;
a0ed51b3 2538 del = o->op_private & OPpTRANS_DELETE;
5d06d08e 2539 squash = o->op_private & OPpTRANS_SQUASH;
79072805 2540
a0ed51b3 2541 if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
79cb57f6 2542 SV* listsv = newSVpvn("# comment\n",10);
a0ed51b3
LW
2543 SV* transv = 0;
2544 U8* tend = t + tlen;
2545 U8* rend = r + rlen;
2546 I32 ulen;
2547 U32 tfirst = 1;
2548 U32 tlast = 0;
2549 I32 tdiff;
2550 U32 rfirst = 1;
2551 U32 rlast = 0;
2552 I32 rdiff;
2553 I32 diff;
2554 I32 none = 0;
2555 U32 max = 0;
2556 I32 bits;
2557 I32 grows = 0;
2558 I32 havefinal = 0;
2559 U32 final;
2560 HV *hv;
2561 I32 from_utf = o->op_private & OPpTRANS_FROM_UTF;
2562 I32 to_utf = o->op_private & OPpTRANS_TO_UTF;
2563
2564 if (complement) {
2565 U8 tmpbuf[10];
2566 U8** cp;
2567 UV nextmin = 0;
2568 New(1109, cp, tlen, U8*);
2569 i = 0;
79cb57f6 2570 transv = newSVpvn("",0);
a0ed51b3
LW
2571 while (t < tend) {
2572 cp[i++] = t;
2573 t += UTF8SKIP(t);
2574 if (*t == 0xff) {
2575 t++;
2576 t += UTF8SKIP(t);
2577 }
2578 }
2579 qsort(cp, i, sizeof(U8*), utf8compare);
2580 for (j = 0; j < i; j++) {
2581 U8 *s = cp[j];
2582 UV val = utf8_to_uv(s, &ulen);
2583 s += ulen;
2584 diff = val - nextmin;
2585 if (diff > 0) {
2586 t = uv_to_utf8(tmpbuf,nextmin);
dfe13c55 2587 sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
a0ed51b3
LW
2588 if (diff > 1) {
2589 t = uv_to_utf8(tmpbuf, val - 1);
2590 sv_catpvn(transv, "\377", 1);
dfe13c55 2591 sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
a0ed51b3
LW
2592 }
2593 }
2594 if (*s == 0xff)
2595 val = utf8_to_uv(s+1, &ulen);
2596 if (val >= nextmin)
2597 nextmin = val + 1;
2598 }
2599 t = uv_to_utf8(tmpbuf,nextmin);
dfe13c55 2600 sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
a0ed51b3
LW
2601 t = uv_to_utf8(tmpbuf, 0x7fffffff);
2602 sv_catpvn(transv, "\377", 1);
dfe13c55
GS
2603 sv_catpvn(transv, (char*)tmpbuf, t - tmpbuf);
2604 t = (U8*)SvPVX(transv);
a0ed51b3
LW
2605 tlen = SvCUR(transv);
2606 tend = t + tlen;
2607 }
2608 else if (!rlen && !del) {
2609 r = t; rlen = tlen; rend = tend;
4757a243
LW
2610 }
2611 if (!squash) {
2612 if (to_utf && from_utf) { /* only counting characters */
2613 if (t == r || (tlen == rlen && memEQ(t, r, tlen)))
2614 o->op_private |= OPpTRANS_IDENTICAL;
2615 }
2616 else { /* straight latin-1 translation */
2617 if (tlen == 4 && memEQ(t, "\0\377\303\277", 4) &&
2618 rlen == 4 && memEQ(r, "\0\377\303\277", 4))
2619 o->op_private |= OPpTRANS_IDENTICAL;
2620 }
a0ed51b3
LW
2621 }
2622
2623 while (t < tend || tfirst <= tlast) {
2624 /* see if we need more "t" chars */
2625 if (tfirst > tlast) {
2626 tfirst = (I32)utf8_to_uv(t, &ulen);
2627 t += ulen;
2628 if (t < tend && *t == 0xff) { /* illegal utf8 val indicates range */
2629 tlast = (I32)utf8_to_uv(++t, &ulen);
2630 t += ulen;
2631 }
2632 else
2633 tlast = tfirst;
2634 }
2635
2636 /* now see if we need more "r" chars */
2637 if (rfirst > rlast) {
2638 if (r < rend) {
2639 rfirst = (I32)utf8_to_uv(r, &ulen);
2640 r += ulen;
2641 if (r < rend && *r == 0xff) { /* illegal utf8 val indicates range */
2642 rlast = (I32)utf8_to_uv(++r, &ulen);
2643 r += ulen;
2644 }
2645 else
2646 rlast = rfirst;
2647 }
2648 else {
2649 if (!havefinal++)
2650 final = rlast;
2651 rfirst = rlast = 0xffffffff;
2652 }
2653 }
2654
2655 /* now see which range will peter our first, if either. */
2656 tdiff = tlast - tfirst;
2657 rdiff = rlast - rfirst;
2658
2659 if (tdiff <= rdiff)
2660 diff = tdiff;
2661 else
2662 diff = rdiff;
2663
2664 if (rfirst == 0xffffffff) {
2665 diff = tdiff; /* oops, pretend rdiff is infinite */
2666 if (diff > 0)
cea2e8a9 2667 Perl_sv_catpvf(aTHX_ listsv, "%04x\t%04x\tXXXX\n", tfirst, tlast);
a0ed51b3 2668 else
cea2e8a9 2669 Perl_sv_catpvf(aTHX_ listsv, "%04x\t\tXXXX\n", tfirst);
a0ed51b3
LW
2670 }
2671 else {
2672 if (diff > 0)
cea2e8a9 2673 Perl_sv_catpvf(aTHX_ listsv, "%04x\t%04x\t%04x\n", tfirst, tfirst + diff, rfirst);
a0ed51b3 2674 else
cea2e8a9 2675 Perl_sv_catpvf(aTHX_ listsv, "%04x\t\t%04x\n", tfirst, rfirst);
a0ed51b3
LW
2676
2677 if (rfirst + diff > max)
2678 max = rfirst + diff;
2679 rfirst += diff + 1;
2680 if (!grows) {
2681 if (rfirst <= 0x80)
2682 ;
2683 else if (rfirst <= 0x800)
2684 grows |= (tfirst < 0x80);
2685 else if (rfirst <= 0x10000)
2686 grows |= (tfirst < 0x800);
2687 else if (rfirst <= 0x200000)
2688 grows |= (tfirst < 0x10000);
2689 else if (rfirst <= 0x4000000)
2690 grows |= (tfirst < 0x200000);
2691 else if (rfirst <= 0x80000000)
2692 grows |= (tfirst < 0x4000000);
2693 }
2694 }
2695 tfirst += diff + 1;
2696 }
2697
2698 none = ++max;
2699 if (del)
2700 del = ++max;
2701
2702 if (max > 0xffff)
2703 bits = 32;
2704 else if (max > 0xff)
2705 bits = 16;
2706 else
2707 bits = 8;
2708
2709 cSVOPo->op_sv = (SV*)swash_init("utf8", "", listsv, bits, none);
2710 SvREFCNT_dec(listsv);
2711 if (transv)
2712 SvREFCNT_dec(transv);
2713
2714 if (!del && havefinal)
2715 (void)hv_store((HV*)SvRV((cSVOPo->op_sv)), "FINAL", 5, newSViv((IV)final), 0);
2716
2717 if (grows && to_utf)
2718 o->op_private |= OPpTRANS_GROWS;
2719
2720 op_free(expr);
2721 op_free(repl);
2722 return o;
2723 }
2724
2725 tbl = (short*)cPVOPo->op_pv;
79072805
LW
2726 if (complement) {
2727 Zero(tbl, 256, short);
2728 for (i = 0; i < tlen; i++)
ec49126f 2729 tbl[t[i]] = -1;
79072805
LW
2730 for (i = 0, j = 0; i < 256; i++) {
2731 if (!tbl[i]) {
2732 if (j >= rlen) {
a0ed51b3 2733 if (del)
79072805
LW
2734 tbl[i] = -2;
2735 else if (rlen)
ec49126f 2736 tbl[i] = r[j-1];
79072805
LW
2737 else
2738 tbl[i] = i;
2739 }
2740 else
ec49126f 2741 tbl[i] = r[j++];
79072805
LW
2742 }
2743 }
2744 }
2745 else {
a0ed51b3 2746 if (!rlen && !del) {
79072805 2747 r = t; rlen = tlen;
5d06d08e 2748 if (!squash)
4757a243 2749 o->op_private |= OPpTRANS_IDENTICAL;
79072805
LW
2750 }
2751 for (i = 0; i < 256; i++)
2752 tbl[i] = -1;
2753 for (i = 0, j = 0; i < tlen; i++,j++) {
2754 if (j >= rlen) {
a0ed51b3 2755 if (del) {
ec49126f
PP
2756 if (tbl[t[i]] == -1)
2757 tbl[t[i]] = -2;
79072805
LW
2758 continue;
2759 }
2760 --j;
2761 }
ec49126f
PP
2762 if (tbl[t[i]] == -1)
2763 tbl[t[i]] = r[j];
79072805
LW
2764 }
2765 }
2766 op_free(expr);
2767 op_free(repl);
2768
11343788 2769 return o;
79072805
LW
2770}
2771
2772OP *
864dbfa3 2773Perl_newPMOP(pTHX_ I32 type, I32 flags)
79072805 2774{
11343788 2775 dTHR;
79072805
LW
2776 PMOP *pmop;
2777
b7dc083c 2778 NewOp(1101, pmop, 1, PMOP);
79072805 2779 pmop->op_type = type;
22c35a8c 2780 pmop->op_ppaddr = PL_ppaddr[type];
79072805 2781 pmop->op_flags = flags;
c07a80fd 2782 pmop->op_private = 0 | (flags >> 8);
79072805 2783
3280af22 2784 if (PL_hints & HINT_RE_TAINT)
b3eb6a9b 2785 pmop->op_pmpermflags |= PMf_RETAINT;
3280af22 2786 if (PL_hints & HINT_LOCALE)
b3eb6a9b
GS
2787 pmop->op_pmpermflags |= PMf_LOCALE;
2788 pmop->op_pmflags = pmop->op_pmpermflags;
36477c24 2789
79072805 2790 /* link into pm list */
3280af22
NIS
2791 if (type != OP_TRANS && PL_curstash) {
2792 pmop->op_pmnext = HvPMROOT(PL_curstash);
2793 HvPMROOT(PL_curstash) = pmop;
79072805
LW
2794 }
2795
2796 return (OP*)pmop;
2797}
2798
2799OP *
864dbfa3 2800Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl)
79072805 2801{
5c0ca799 2802 dTHR;
79072805
LW
2803 PMOP *pm;
2804 LOGOP *rcop;
ce862d02 2805 I32 repl_has_vars = 0;
79072805 2806
11343788
MB
2807 if (o->op_type == OP_TRANS)
2808 return pmtrans(o, expr, repl);
79072805 2809
3280af22 2810 PL_hints |= HINT_BLOCK_SCOPE;
11343788 2811 pm = (PMOP*)o;
79072805
LW
2812
2813 if (expr->op_type == OP_CONST) {
463ee0b2 2814 STRLEN plen;
79072805 2815 SV *pat = ((SVOP*)expr)->op_sv;
463ee0b2 2816 char *p = SvPV(pat, plen);
11343788 2817 if ((o->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
93a17b20 2818 sv_setpvn(pat, "\\s+", 3);
463ee0b2 2819 p = SvPV(pat, plen);
79072805
LW
2820 pm->op_pmflags |= PMf_SKIPWHITE;
2821 }
cea2e8a9 2822 pm->op_pmregexp = CALLREGCOMP(aTHX_ p, p + plen, pm);
aeea060c 2823 if (strEQ("\\s+", pm->op_pmregexp->precomp))
85e6fe83 2824 pm->op_pmflags |= PMf_WHITE;
79072805
LW
2825 op_free(expr);
2826 }
2827 else {
3280af22
NIS
2828 if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL))
2829 expr = newUNOP((!(PL_hints & HINT_RE_EVAL)
2cd61cdb
IZ
2830 ? OP_REGCRESET
2831 : OP_REGCMAYBE),0,expr);
463ee0b2 2832
b7dc083c 2833 NewOp(1101, rcop, 1, LOGOP);
79072805 2834 rcop->op_type = OP_REGCOMP;
22c35a8c 2835 rcop->op_ppaddr = PL_ppaddr[OP_REGCOMP];
79072805 2836 rcop->op_first = scalar(expr);
3280af22 2837 rcop->op_flags |= ((PL_hints & HINT_RE_EVAL)
2cd61cdb
IZ
2838 ? (OPf_SPECIAL | OPf_KIDS)
2839 : OPf_KIDS);
79072805 2840 rcop->op_private = 1;
11343788 2841 rcop->op_other = o;
79072805
LW
2842
2843 /* establish postfix order */
3280af22 2844 if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL)) {
463ee0b2
LW
2845 LINKLIST(expr);
2846 rcop->op_next = expr;
2847 ((UNOP*)expr)->op_first->op_next = (OP*)rcop;
2848 }
2849 else {
2850 rcop->op_next = LINKLIST(expr);
2851 expr->op_next = (OP*)rcop;
2852 }
79072805 2853
11343788 2854 prepend_elem(o->op_type, scalar((OP*)rcop), o);
79072805
LW
2855 }
2856
2857 if (repl) {
748a9306 2858 OP *curop;
0244c3a4 2859 if (pm->op_pmflags & PMf_EVAL) {
748a9306 2860 curop = 0;
57843af0
GS
2861 if (CopLINE(PL_curcop) < PL_multi_end)
2862 CopLINE_set(PL_curcop, PL_multi_end);
0244c3a4 2863 }
554b3eca 2864#ifdef USE_THREADS
2faa37cc 2865 else if (repl->op_type == OP_THREADSV
554b3eca 2866 && strchr("&`'123456789+",
533c011a 2867 PL_threadsv_names[repl->op_targ]))
554b3eca
MB
2868 {
2869 curop = 0;
2870 }
2871#endif /* USE_THREADS */
748a9306
LW
2872 else if (repl->op_type == OP_CONST)
2873 curop = repl;
79072805 2874 else {
79072805
LW
2875 OP *lastop = 0;
2876 for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
22c35a8c 2877 if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
554b3eca 2878#ifdef USE_THREADS
ce862d02
IZ
2879 if (curop->op_type == OP_THREADSV) {
2880 repl_has_vars = 1;
be949f6f 2881 if (strchr("&`'123456789+", curop->op_private))
ce862d02 2882 break;
554b3eca
MB
2883 }
2884#else
79072805 2885 if (curop->op_type == OP_GV) {
638eceb6 2886 GV *gv = cGVOPx_gv(curop);
ce862d02 2887 repl_has_vars = 1;
93a17b20 2888 if (strchr("&`'123456789+", *GvENAME(gv)))
79072805
LW
2889 break;
2890 }
554b3eca 2891#endif /* USE_THREADS */
79072805
LW
2892 else if (curop->op_type == OP_RV2CV)
2893 break;
2894 else if (curop->op_type == OP_RV2SV ||
2895 curop->op_type == OP_RV2AV ||
2896 curop->op_type == OP_RV2HV ||
2897 curop->op_type == OP_RV2GV) {
2898 if (lastop && lastop->op_type != OP_GV) /*funny deref?*/
2899 break;
2900 }
748a9306
LW
2901 else if (curop->op_type == OP_PADSV ||
2902 curop->op_type == OP_PADAV ||
2903 curop->op_type == OP_PADHV ||
554b3eca 2904 curop->op_type == OP_PADANY) {
ce862d02 2905 repl_has_vars = 1;
748a9306 2906 }
1167e5da
SM
2907 else if (curop->op_type == OP_PUSHRE)
2908 ; /* Okay here, dangerous in newASSIGNOP */
79072805
LW
2909 else
2910 break;
2911 }
2912 lastop = curop;
2913 }
748a9306 2914 }
ce862d02
IZ
2915 if (curop == repl
2916 && !(repl_has_vars
2917 && (!pm->op_pmregexp
2918 || pm->op_pmregexp->reganch & ROPT_EVAL_SEEN))) {
748a9306 2919 pm->op_pmflags |= PMf_CONST; /* const for long enough */
4633a7c4 2920 pm->op_pmpermflags |= PMf_CONST; /* const for long enough */
11343788 2921 prepend_elem(o->op_type, scalar(repl), o);
748a9306
LW
2922 }
2923 else {
ce862d02
IZ
2924 if (curop == repl && !pm->op_pmregexp) { /* Has variables. */
2925 pm->op_pmflags |= PMf_MAYBE_CONST;
2926 pm->op_pmpermflags |= PMf_MAYBE_CONST;
2927 }
b7dc083c 2928 NewOp(1101, rcop, 1, LOGOP);
748a9306 2929 rcop->op_type = OP_SUBSTCONT;
22c35a8c 2930 rcop->op_ppaddr = PL_ppaddr[OP_SUBSTCONT];
748a9306
LW
2931 rcop->op_first = scalar(repl);
2932 rcop->op_flags |= OPf_KIDS;
2933 rcop->op_private = 1;
11343788 2934 rcop->op_other = o;
748a9306
LW
2935
2936 /* establish postfix order */
2937 rcop->op_next = LINKLIST(repl);
2938 repl->op_next = (OP*)rcop;
2939
2940 pm->op_pmreplroot = scalar((OP*)rcop);
2941 pm->op_pmreplstart = LINKLIST(rcop);
2942 rcop->op_next = 0;
79072805
LW
2943 }
2944 }
2945
2946 return (OP*)pm;
2947}
2948
2949OP *
864dbfa3 2950Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
79072805
LW
2951{
2952 SVOP *svop;
b7dc083c 2953 NewOp(1101, svop, 1, SVOP);
79072805 2954 svop->op_type = type;
22c35a8c 2955 svop->op_ppaddr = PL_ppaddr[type];
79072805
LW
2956 svop->op_sv = sv;
2957 svop->op_next = (OP*)svop;
2958 svop->op_flags = flags;
22c35a8c 2959 if (PL_opargs[type] & OA_RETSCALAR)
463ee0b2 2960 scalar((OP*)svop);
22c35a8c 2961 if (PL_opargs[type] & OA_TARGET)
ed6116ce 2962 svop->op_targ = pad_alloc(type, SVs_PADTMP);
e50aee73 2963 return CHECKOP(type, svop);
79072805
LW
2964}
2965
2966OP *
350de78d
GS
2967Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
2968{
2969 PADOP *padop;
2970 NewOp(1101, padop, 1, PADOP);
2971 padop->op_type = type;
2972 padop->op_ppaddr = PL_ppaddr[type];
2973 padop->op_padix = pad_alloc(type, SVs_PADTMP);
7766f137 2974 SvREFCNT_dec(PL_curpad[padop->op_padix]);
350de78d 2975 PL_curpad[padop->op_padix] = sv;
7766f137 2976 SvPADTMP_on(sv);
350de78d
GS
2977 padop->op_next = (OP*)padop;
2978 padop->op_flags = flags;
2979 if (PL_opargs[type] & OA_RETSCALAR)
2980 scalar((OP*)padop);
2981 if (PL_opargs[type] & OA_TARGET)
2982 padop->op_targ = pad_alloc(type, SVs_PADTMP);
2983 return CHECKOP(type, padop);
2984}
2985
2986OP *
864dbfa3 2987Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
79072805 2988{
11343788 2989 dTHR;
350de78d 2990#ifdef USE_ITHREADS
743e66e6 2991 GvIN_PAD_on(gv);
350de78d
GS
2992 return newPADOP(type, flags, SvREFCNT_inc(gv));
2993#else
7934575e 2994 return newSVOP(type, flags, SvREFCNT_inc(gv));
350de78d 2995#endif
79072805
LW
2996}
2997
2998OP *
864dbfa3 2999Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv)
79072805
LW
3000{
3001 PVOP *pvop;
b7dc083c 3002 NewOp(1101, pvop, 1, PVOP);
79072805 3003 pvop->op_type = type;
22c35a8c 3004 pvop->op_ppaddr = PL_ppaddr[type];
79072805
LW
3005 pvop->op_pv = pv;
3006 pvop->op_next = (OP*)pvop;
3007 pvop->op_flags = flags;
22c35a8c 3008 if (PL_opargs[type] & OA_RETSCALAR)
463ee0b2 3009 scalar((OP*)pvop);
22c35a8c 3010 if (PL_opargs[type] & OA_TARGET)
ed6116ce 3011 pvop->op_targ = pad_alloc(type, SVs_PADTMP);
e50aee73 3012 return CHECKOP(type, pvop);
79072805
LW
3013}
3014
79072805 3015void
864dbfa3 3016Perl_package(pTHX_ OP *o)
79072805 3017{
11343788 3018 dTHR;
93a17b20 3019 SV *sv;
79072805 3020
3280af22
NIS
3021 save_hptr(&PL_curstash);
3022 save_item(PL_curstname);
11343788 3023 if (o) {
463ee0b2
LW
3024 STRLEN len;
3025 char *name;
11343788 3026 sv = cSVOPo->op_sv;
463ee0b2 3027 name = SvPV(sv, len);
3280af22
NIS
3028 PL_curstash = gv_stashpvn(name,len,TRUE);
3029 sv_setpvn(PL_curstname, name, len);
11343788 3030 op_free(o);
93a17b20
LW
3031 }
3032 else {
3280af22
NIS
3033 sv_setpv(PL_curstname,"<none>");
3034 PL_curstash = Nullhv;
93a17b20 3035 }
7ad382f4 3036 PL_hints |= HINT_BLOCK_SCOPE;
3280af22
NIS
3037 PL_copline = NOLINE;
3038 PL_expect = XSTATE;
79072805
LW
3039}
3040
85e6fe83 3041void
864dbfa3 3042Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *id, OP *arg)
85e6fe83 3043{
a0d0e21e
LW
3044 OP *pack;
3045 OP *meth;
3046 OP *rqop;
3047 OP *imop;
b1cb66bf 3048 OP *veop;
78ca652e 3049 GV *gv;
85e6fe83 3050
a0d0e21e 3051 if (id->op_type != OP_CONST)
cea2e8a9 3052 Perl_croak(aTHX_ "Module name must be constant");
85e6fe83 3053
b1cb66bf
PP
3054 veop = Nullop;
3055
3056 if(version != Nullop) {
3057 SV *vesv = ((SVOP*)version)->op_sv;
3058
3059 if (arg == Nullop && !SvNIOK(vesv)) {
3060 arg = version;
3061 }
3062 else {
3063 OP *pack;
b1cb66bf
PP
3064
3065 if (version->op_type != OP_CONST || !SvNIOK(vesv))
cea2e8a9 3066 Perl_croak(aTHX_ "Version number must be constant number");
b1cb66bf
PP
3067
3068 /* Make copy of id so we don't free it twice */
3069 pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
3070
3071 /* Fake up a method call to VERSION */
b1cb66bf
PP
3072 veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
3073 append_elem(OP_LIST,
3074 prepend_elem(OP_LIST, pack, list(version)),
f5d5a27c
CS
3075 newSVOP(OP_METHOD_NAMED, 0,
3076 newSVpvn("VERSION", 7))));
b1cb66bf
PP
3077 }
3078 }
aeea060c 3079
a0d0e21e 3080 /* Fake up an import/unimport */
4633a7c4
LW
3081 if (arg && arg->op_type == OP_STUB)
3082 imop = arg; /* no import on explicit () */
b1cb66bf
PP
3083 else if(SvNIOK(((SVOP*)id)->op_sv)) {
3084 imop = Nullop; /* use 5.0; */
3085 }
4633a7c4
LW
3086 else {
3087 /* Make copy of id so we don't free it twice */
3088 pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
4633a7c4 3089 imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
a0d0e21e
LW
3090 append_elem(OP_LIST,
3091 prepend_elem(OP_LIST, pack, list(arg)),
f5d5a27c
CS
3092 newSVOP(OP_METHOD_NAMED, 0,
3093 aver ? newSVpvn("import", 6)
3094 : newSVpvn("unimport", 8))));
4633a7c4
LW
3095 }
3096
78ca652e
GS
3097 /* Fake up a require, handle override, if any */
3098 gv = gv_fetchpv("require", FALSE, SVt_PVCV);
3099 if (!(gv && GvIMPORTED_CV(gv)))
3100 gv = gv_fetchpv("CORE::GLOBAL::require", FALSE, SVt_PVCV);
3101
3102 if (gv && GvIMPORTED_CV(gv)) {
3103 rqop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
3104 append_elem(OP_LIST, id,
3105 scalar(newUNOP(OP_RV2CV, 0,
3106 newGVOP(OP_GV, 0,
3107 gv))))));
3108 }
3109 else {
3110 rqop = newUNOP(OP_REQUIRE, 0, id);
3111 }
a0d0e21e
LW
3112
3113 /* Fake up the BEGIN {}, which does its thing immediately. */
09bef843 3114 newATTRSUB(floor,
79cb57f6 3115 newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)),
4633a7c4 3116 Nullop,
09bef843 3117 Nullop,
a0d0e21e 3118 append_elem(OP_LINESEQ,
b1cb66bf
PP
3119 append_elem(OP_LINESEQ,
3120 newSTATEOP(0, Nullch, rqop),
3121 newSTATEOP(0, Nullch, veop)),
a0d0e21e 3122 newSTATEOP(0, Nullch, imop) ));
85e6fe83 3123
c305c6a0 3124 PL_hints |= HINT_BLOCK_SCOPE;
3280af22
NIS
3125 PL_copline = NOLINE;
3126 PL_expect = XSTATE;
85e6fe83
LW
3127}
3128
79072805 3129OP *
864dbfa3 3130Perl_dofile(pTHX_ OP *term)
78ca652e
GS
3131{
3132 OP *doop;
3133 GV *gv;
3134
3135 gv = gv_fetchpv("do", FALSE, SVt_PVCV);
3136 if (!(gv && GvIMPORTED_CV(gv)))
3137 gv = gv_fetchpv("CORE::GLOBAL::do", FALSE, SVt_PVCV);
3138
3139 if (gv && GvIMPORTED_CV(gv)) {
3140 doop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
3141 append_elem(OP_LIST, term,
3142 scalar(newUNOP(OP_RV2CV, 0,
3143 newGVOP(OP_GV, 0,
3144 gv))))));
3145 }
3146 else {
3147 doop = newUNOP(OP_DOFILE, 0, scalar(term));
3148 }
3149 return doop;
3150}
3151
3152OP *
864dbfa3 3153Perl_newSLICEOP(pTHX_ I32 flags, OP *subscript, OP *listval)
79072805
LW
3154{
3155 return newBINOP(OP_LSLICE, flags,
8990e307
LW
3156 list(force_list(subscript)),
3157 list(force_list(listval)) );
79072805
LW
3158}
3159
76e3520e 3160STATIC I32
cea2e8a9 3161S_list_assignment(pTHX_ register OP *o)
79072805 3162{
11343788 3163 if (!o)
79072805
LW
3164 return TRUE;
3165
11343788
MB
3166 if (o->op_type == OP_NULL && o->op_flags & OPf_KIDS)
3167 o = cUNOPo->op_first;
79072805 3168
11343788 3169 if (o->op_type == OP_COND_EXPR) {
1a67a97c
SM
3170 I32 t = list_assignment(cLOGOPo->op_first->op_sibling);
3171 I32 f = list_assignment(cLOGOPo->op_first->op_sibling->op_sibling);
79072805
LW
3172
3173 if (t && f)
3174 return TRUE;
3175 if (t || f)
3176 yyerror("Assignment to both a list and a scalar");
3177 return FALSE;
3178 }
3179
11343788
MB
3180 if (o->op_type == OP_LIST || o->op_flags & OPf_PARENS ||
3181 o->op_type == OP_RV2AV || o->op_type == OP_RV2HV ||
3182 o->op_type == OP_ASLICE || o->op_type == OP_HSLICE)
79072805
LW
3183 return TRUE;
3184
11343788 3185 if (o->op_type == OP_PADAV || o->op_type == OP_PADHV)
93a17b20
LW
3186 return TRUE;
3187
11343788 3188 if (o->op_type == OP_RV2SV)
79072805
LW
3189 return FALSE;
3190
3191 return FALSE;
3192}
3193
3194OP *
864dbfa3 3195Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
79072805 3196{
11343788 3197 OP *o;
79072805 3198
a0d0e21e
LW
3199 if (optype) {
3200 if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) {
3201 return newLOGOP(optype, 0,
3202 mod(scalar(left), optype),
3203 newUNOP(OP_SASSIGN, 0, scalar(right)));
3204 }
3205 else {
3206 return newBINOP(optype, OPf_STACKED,
3207 mod(scalar(left), optype), scalar(right));
3208 }
3209 }
3210
79072805 3211 if (list_assignment(left)) {
6ee623d5 3212 dTHR;
3280af22
NIS
3213 PL_modcount = 0;
3214 PL_eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
463ee0b2 3215 left = mod(left, OP_AASSIGN);
3280af22
NIS
3216 if (PL_eval_start)
3217 PL_eval_start = 0;
748a9306 3218 else {
a0d0e21e
LW
3219 op_free(left);
3220 op_free(right);
3221 return Nullop;
3222 }
11343788 3223 o = newBINOP(OP_AASSIGN, flags,
8990e307
LW
3224 list(force_list(right)),
3225 list(force_list(left)) );
11343788 3226 o->op_private = 0 | (flags >> 8);
a0d0e21e 3227 if (!(left->op_private & OPpLVAL_INTRO)) {
79072805 3228 OP *curop;
11343788 3229 OP *lastop = o;
3280af22 3230 PL_generation++;
11343788 3231 for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
22c35a8c 3232 if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
79072805 3233 if (curop->op_type == OP_GV) {
638eceb6 3234 GV *gv = cGVOPx_gv(curop);
3280af22 3235 if (gv == PL_defgv || SvCUR(gv) == PL_generation)
79072805 3236 break;
3280af22 3237 SvCUR(gv) = PL_generation;
79072805 3238 }
748a9306
LW
3239 else if (curop->op_type == OP_PADSV ||
3240 curop->op_type == OP_PADAV ||
3241 curop->op_type == OP_PADHV ||
3242 curop->op_type == OP_PADANY) {
3280af22 3243 SV **svp = AvARRAY(PL_comppad_name);
8e07c86e 3244 SV *sv = svp[curop->op_targ];
3280af22 3245 if (SvCUR(sv) == PL_generation)
748a9306 3246 break;
3280af22 3247 SvCUR(sv) = PL_generation; /* (SvCUR not used any more) */
748a9306 3248 }
79072805
LW
3249 else if (curop->op_type == OP_RV2CV)
3250 break;
3251 else if (curop->op_type == OP_RV2SV ||
3252 curop->op_type == OP_RV2AV ||
3253 curop->op_type == OP_RV2HV ||
3254 curop->op_type == OP_RV2GV) {
3255 if (lastop->op_type != OP_GV) /* funny deref? */
3256 break;
3257 }
1167e5da
SM
3258 else if (curop->op_type == OP_PUSHRE) {
3259 if (((PMOP*)curop)->op_pmreplroot) {
3260 GV *gv = (GV*)((PMOP*)curop)->op_pmreplroot;
3280af22 3261 if (gv == PL_defgv || SvCUR(gv) == PL_generation)
1167e5da 3262 break;
3280af22 3263 SvCUR(gv) = PL_generation;
1167e5da
SM
3264 }
3265 }
79072805
LW
3266 else
3267 break;
3268 }
3269 lastop = curop;
3270 }
11343788
MB
3271 if (curop != o)
3272 o->op_private = OPpASSIGN_COMMON;
79072805 3273 }
c07a80fd
PP
3274 if (right && right->op_type == OP_SPLIT) {
3275 OP* tmpop;
3276 if ((tmpop = ((LISTOP*)right)->op_first) &&
3277 tmpop->op_type == OP_PUSHRE)
3278 {
3279 PMOP *pm = (PMOP*)tmpop;
3280 if (left->op_type == OP_RV2AV &&
3281 !(left->op_private & OPpLVAL_INTRO) &&
11343788 3282 !(o->op_private & OPpASSIGN_COMMON) )
c07a80fd
PP
3283 {
3284 tmpop = ((UNOP*)left)->op_first;
3285 if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
971a9dd3
GS
3286#ifdef USE_ITHREADS
3287 pm->op_pmreplroot = (OP*)cPADOPx(tmpop)->op_padix;
3288 cPADOPx(tmpop)->op_padix = 0; /* steal it */
3289#else
3290 pm->op_pmreplroot = (OP*)cSVOPx(tmpop)->op_sv;
3291 cSVOPx(tmpop)->op_sv = Nullsv; /* steal it */
3292#endif
c07a80fd 3293 pm->op_pmflags |= PMf_ONCE;
11343788 3294 tmpop = cUNOPo->op_first; /* to list (nulled) */
c07a80fd
PP
3295 tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
3296 tmpop->op_sibling = Nullop; /* don't free split */
3297 right->op_next = tmpop->op_next; /* fix starting loc */
11343788 3298 op_free(o); /* blow off assign */
54310121 3299 right->op_flags &= ~OPf_WANT;
a5f75d66 3300 /* "I don't know and I don't care." */
c07a80fd
PP
3301 return right;
3302 }
3303 }
3304 else {
3280af22 3305 if (PL_modcount < 10000 &&
c07a80fd
PP
3306 ((LISTOP*)right)->op_last->op_type == OP_CONST)
3307 {
3308 SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
3309 if (SvIVX(sv) == 0)
3280af22 3310 sv_setiv(sv, PL_modcount+1);
c07a80fd
PP
3311 }
3312 }
3313 }
3314 }
11343788 3315 return o;
79072805
LW
3316 }
3317 if (!right)
3318 right = newOP(OP_UNDEF, 0);
3319 if (right->op_type == OP_READLINE) {
3320 right->op_flags |= OPf_STACKED;
463ee0b2 3321 return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right));
79072805 3322 }
a0d0e21e 3323 else {
3280af22 3324 PL_eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
11343788 3325 o = newBINOP(OP_SASSIGN, flags,
463ee0b2 3326 scalar(right), mod(scalar(left), OP_SASSIGN) );
3280af22
NIS
3327 if (PL_eval_start)
3328 PL_eval_start = 0;
748a9306 3329 else {
11343788 3330 op_free(o);
a0d0e21e
LW
3331 return Nullop;
3332 }
3333 }
11343788 3334 return o;
79072805
LW
3335}
3336
3337OP *
864dbfa3 3338Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
79072805 3339{
11343788 3340 dTHR;
bbce6d69 3341 U32 seq = intro_my();
79072805
LW
3342 register COP *cop;
3343
b7dc083c 3344 NewOp(1101, cop, 1, COP);
57843af0 3345 if (PERLDB_LINE && CopLINE(PL_curcop) && PL_curstash != PL_debstash) {
8990e307 3346 cop->op_type = OP_DBSTATE;
22c35a8c 3347 cop->op_ppaddr = PL_ppaddr[ OP_DBSTATE ];
8990e307
LW
3348 }
3349 else {
3350 cop->op_type = OP_NEXTSTATE;
22c35a8c 3351 cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ];
8990e307 3352 }
79072805 3353 cop->op_flags = flags;
a0ed51b3 3354 cop->op_private = (PL_hints & HINT_UTF8);
ff0cee69
PP
3355#ifdef NATIVE_HINTS
3356 cop->op_private |= NATIVE_HINTS;
3357#endif
e24b16f9 3358 PL_compiling.op_private = cop->op_private;
79072805
LW
3359 cop->op_next = (OP*)cop;
3360
463ee0b2
LW
3361 if (label) {
3362 cop->cop_label = label;
3280af22 3363 PL_hints |= HINT_BLOCK_SCOPE;
463ee0b2 3364 }
bbce6d69 3365 cop->cop_seq = seq;
3280af22 3366 cop->cop_arybase = PL_curcop->cop_arybase;
0453d815 3367 if (specialWARN(PL_curcop->cop_warnings))
599cee73
PM
3368 cop->cop_warnings = PL_curcop->cop_warnings ;
3369 else
3370 cop->cop_warnings = newSVsv(PL_curcop->cop_warnings) ;
3371
79072805 3372
3280af22 3373 if (PL_copline == NOLINE)
57843af0 3374 CopLINE_set(cop, CopLINE(PL_curcop));
79072805 3375 else {
57843af0 3376 CopLINE_set(cop, PL_copline);
3280af22 3377 PL_copline = NOLINE;
79072805 3378 }
57843af0
GS
3379#ifdef USE_ITHREADS
3380 CopFILE_set(cop, CopFILE(PL_curcop)); /* XXXXX share in a pvtable? */
3381#else
cc49e20b 3382 CopFILEGV_set(cop, (GV*)SvREFCNT_inc(CopFILEGV(PL_curcop)));
57843af0 3383#endif
11faa288 3384 CopSTASH_set(cop, PL_curstash);
79072805 3385
3280af22 3386 if (PERLDB_LINE && PL_curstash != PL_debstash) {
cc49e20b 3387 SV **svp = av_fetch(CopFILEAV(PL_curcop), (I32)CopLINE(cop), FALSE);
3280af22 3388 if (svp && *svp != &PL_sv_undef && !SvIOK(*svp)) {
a0d0e21e 3389 (void)SvIOK_on(*svp);
57b2e452 3390 SvIVX(*svp) = PTR2IV(cop);
93a17b20
LW
3391 }
3392 }
3393
11343788 3394 return prepend_elem(OP_LINESEQ, (OP*)cop, o);
79072805
LW
3395}
3396
bbce6d69
PP
3397/* "Introduce" my variables to visible status. */
3398U32
864dbfa3 3399Perl_intro_my(pTHX)
bbce6d69
PP
3400{
3401 SV **svp;
3402 SV *sv;
3403 I32 i;
3404
3280af22
NIS
3405 if (! PL_min_intro_pending)
3406 return PL_cop_seqmax;
bbce6d69 3407
3280af22
NIS
3408 svp = AvARRAY(PL_comppad_name);
3409 for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
3410 if ((sv = svp[i]) && sv != &PL_sv_undef && !SvIVX(sv)) {
c53d7c7d 3411 SvIVX(sv) = PAD_MAX; /* Don't know scope end yet. */
65202027 3412 SvNVX(sv) = (NV)PL_cop_seqmax;
bbce6d69
PP
3413 }
3414 }
3280af22
NIS
3415 PL_min_intro_pending = 0;
3416 PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
3417 return PL_cop_seqmax++;
bbce6d69
PP
3418}
3419
79072805 3420OP *
864dbfa3 3421Perl_newLOGOP(pTHX_ I32 type, I32 flags, OP *first, OP *other)
79072805 3422{
883ffac3
CS
3423 return new_logop(type, flags, &first, &other);
3424}
3425
3bd495df 3426STATIC OP *
cea2e8a9 3427S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
883ffac3 3428{
11343788 3429 dTHR;
79072805 3430 LOGOP *logop;
11343788 3431 OP *o;
883ffac3
CS
3432 OP *first = *firstp;
3433 OP *other = *otherp;
79072805 3434
a0d0e21e
LW
3435 if (type == OP_XOR) /* Not short circuit, but here by precedence. */
3436 return newBINOP(type, flags, scalar(first), scalar(other));
3437
8990e307 3438 scalarboolean(first);
79072805
LW
3439 /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
3440 if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) {
3441 if (type == OP_AND || type == OP_OR) {
3442 if (type == OP_AND)
3443 type = OP_OR;
3444 else
3445 type = OP_AND;
11343788 3446 o = first;
883ffac3 3447 first = *firstp = cUNOPo->op_first;
11343788
MB
3448 if (o->op_next)
3449 first->op_next = o->op_next;
3450 cUNOPo->op_first = Nullop;
3451 op_free(o);
79072805
LW
3452 }
3453 }
3454 if (first->op_type == OP_CONST) {
599cee73 3455 if (ckWARN(WARN_PRECEDENCE) && (first->op_private & OPpCONST_BARE))
cea2e8a9 3456 Perl_warner(aTHX_ WARN_PRECEDENCE, "Probable precedence problem on %s",
22c35a8c 3457 PL_op_desc[type]);
79072805
LW
3458 if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
3459 op_free(first);
883ffac3 3460 *firstp = Nullop;
79072805
LW
3461 return other;
3462 }
3463 else {
3464 op_free(other);
883ffac3 3465 *otherp = Nullop;
79072805
LW
3466 return first;
3467 }
3468 }
3469 else if (first->op_type == OP_WANTARRAY) {
3470 if (type == OP_AND)
3471 list(other);
3472 else
3473 scalar(other);
3474 }
599cee73 3475 else if (ckWARN(WARN_UNSAFE) && (first->op_flags & OPf_KIDS)) {
a6006777
PP
3476 OP *k1 = ((UNOP*)first)->op_first;
3477 OP *k2 = k1->op_sibling;
3478 OPCODE warnop = 0;
3479 switch (first->op_type)
3480 {
3481 case OP_NULL:
3482 if (k2 && k2->op_type == OP_READLINE
3483 && (k2->op_flags & OPf_STACKED)
55d729e4 3484 && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR))
72b16652 3485 {
a6006777 3486 warnop = k2->op_type;
72b16652 3487 }
a6006777
PP
3488 break;
3489
3490 case OP_SASSIGN:
68dc0745
PP
3491 if (k1->op_type == OP_READDIR
3492 || k1->op_type == OP_GLOB
72b16652 3493 || (k1->op_type == OP_NULL && k1->op_targ == OP_GLOB)
68dc0745 3494 || k1->op_type == OP_EACH)
72b16652
GS
3495 {
3496 warnop = ((k1->op_type == OP_NULL)
3497 ? k1->op_targ : k1->op_type);
3498 }
a6006777
PP
3499 break;
3500 }
8ebc5c01 3501 if (warnop) {
57843af0
GS
3502 line_t oldline = CopLINE(PL_curcop);
3503 CopLINE_set(PL_curcop, PL_copline);
cea2e8a9 3504 Perl_warner(aTHX_ WARN_UNSAFE,
599cee73 3505 "Value of %s%s can be \"0\"; test with defined()",
22c35a8c 3506 PL_op_desc[warnop],
68dc0745
PP
3507 ((warnop == OP_READLINE || warnop == OP_GLOB)
3508 ? " construct" : "() operator"));
57843af0 3509 CopLINE_set(PL_curcop, oldline);
8ebc5c01 3510 }
a6006777 3511 }
79072805
LW
3512
3513 if (!other)
3514 return first;
3515
a0d0e21e
LW
3516 if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
3517 other->op_private |= OPpASSIGN_BACKWARDS; /* other is an OP_SASSIGN */
3518
b7dc083c 3519 NewOp(1101, logop, 1, LOGOP);
79072805
LW
3520
3521 logop->op_type = type;
22c35a8c 3522 logop->op_ppaddr = PL_ppaddr[type];
79072805
LW
3523 logop->op_first = first;
3524 logop->op_flags = flags | OPf_KIDS;
3525 logop->op_other = LINKLIST(other);
c07a80fd 3526 logop->op_private = 1 | (flags >> 8);
79072805
LW
3527
3528 /* establish postfix order */
3529 logop->op_next = LINKLIST(first);
3530 first->op_next = (OP*)logop;
3531 first->op_sibling = other;
3532
11343788
MB
3533 o = newUNOP(OP_NULL, 0, (OP*)logop);
3534 other->op_next = o;
79072805 3535
11343788 3536 return o;
79072805
LW
3537}
3538
3539OP *
864dbfa3 3540Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
79072805 3541{
11343788 3542 dTHR;
1a67a97c
SM
3543 LOGOP *logop;
3544 OP *start;
11343788 3545 OP *o;
79072805 3546
b1cb66bf
PP
3547 if (!falseop)
3548 return newLOGOP(OP_AND, 0, first, trueop);
3549 if (!trueop)
3550 return newLOGOP(OP_OR, 0, first, falseop);