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