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