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