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