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
Threading fixups for Digital UNIX.
[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 }
b1cb66bf 122 if (AvFILL(comppad_name) >= 0) {
123 SV **svp = AvARRAY(comppad_name);
124 for (off = AvFILL(comppad_name); off > comppad_name_floor; off--) {
125 if ((sv = svp[off])
126 && sv != &sv_undef
127 && SvIVX(sv) == 999999999 /* var is in open scope */
128 && strEQ(name, SvPVX(sv)))
129 {
130 warn("\"my\" variable %s masks earlier declaration in same scope", name);
131 break;
132 }
133 }
134 }
a0d0e21e
LW		 135 off = pad_alloc(OP_PADSV, SVs_PADMY);
136 sv = NEWSV(1102,0);
93a17b20
LW		 137 sv_upgrade(sv, SVt_PVNV);
138 sv_setpv(sv, name);
c750a3ec
MB		 139 if (in_my_stash) {
140 if (*name != '$')
141 croak("Can't declare class for non-scalar %s in \"my\"",name);
142 SvOBJECT_on(sv);
143 (void)SvUPGRADE(sv, SVt_PVMG);
144 SvSTASH(sv) = (HV*)SvREFCNT_inc(in_my_stash);
145 sv_objcount++;
146 }
8990e307 147 av_store(comppad_name, off, sv);
748a9306 148 SvNVX(sv) = (double)999999999;
8990e307
LW		 149 SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */
150 if (!min_intro_pending)
151 min_intro_pending = off;
152 max_intro_pending = off;
93a17b20 153 if (*name == '@')
463ee0b2 154 av_store(comppad, off, (SV*)newAV());
93a17b20 155 else if (*name == '%')
463ee0b2 156 av_store(comppad, off, (SV*)newHV());
ed6116ce 157 SvPADMY_on(curpad[off]);
93a17b20
LW		 158 return off;
159}
160
748a9306 161static PADOFFSET
e9a444f0 162#ifndef CAN_PROTOTYPE
748a9306 163pad_findlex(name, newoff, seq, startcv, cx_ix)
93a17b20 164char *name;
748a9306 165PADOFFSET newoff;
bbce6d69 166U32 seq;
748a9306
LW		 167CV* startcv;
168I32 cx_ix;
e9a444f0 169#else
bbce6d69 170pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
e9a444f0 171#endif
93a17b20 172{
11343788 173 dTHR;
748a9306 174 CV *cv;
93a17b20
LW		 175 I32 off;
176 SV *sv;
93a17b20
LW		 177 register I32 i;
178 register CONTEXT *cx;
a0d0e21e 179 int saweval;
93a17b20 180
748a9306 181 for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
4fdae800 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
LW		 249 }
250 av_store(comppad, newoff, SvREFCNT_inc(oldsv));
748a9306
LW		 251 return newoff;
252 }
93a17b20
LW		 253 }
254 }
255
256 /* Nothing in current lexical context--try eval's context, if any.
257 * This is necessary to let the perldb get at lexically scoped variables.
258 * XXX This will also probably interact badly with eval tree caching.
259 */
260
a0d0e21e 261 saweval = 0;
748a9306 262 for (i = cx_ix; i >= 0; i--) {
93a17b20
LW		 263 cx = &cxstack[i];
264 switch (cx->cx_type) {
265 default:
748a9306
LW		 266 if (i == 0 && saweval) {
267 seq = cxstack[saweval].blk_oldcop->cop_seq;
268 return pad_findlex(name, newoff, seq, main_cv, 0);
269 }
93a17b20
LW		 270 break;
271 case CXt_EVAL:
44a8e56a 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
514/* Destructor */
515
516void
11343788
MB		 517op_free(o)
518OP *o;
79072805 519{
85e6fe83 520 register OP *kid, *nextkid;
79072805 521
5dc0d613 522 if (!o || o->op_seq == (U16)-1)
79072805
LW		 523 return;
524
11343788
MB		 525 if (o->op_flags & OPf_KIDS) {
526 for (kid = cUNOPo->op_first; kid; kid = nextkid) {
85e6fe83 527 nextkid = kid->op_sibling; /* Get before next freeing kid */
79072805 528 op_free(kid);
85e6fe83 529 }
79072805
LW		 530 }
531
11343788 532 switch (o->op_type) {
8990e307 533 case OP_NULL:
11343788 534 o->op_targ = 0; /* Was holding old type, if any. */
8990e307 535 break;
a0d0e21e 536 case OP_ENTEREVAL:
11343788 537 o->op_targ = 0; /* Was holding hints. */
a0d0e21e 538 break;
a6006777 539 default:
5196be3e 540 if (!(o->op_flags & OPf_REF) || (check[o->op_type] != ck_ftst))
a6006777 541 break;
542 /* FALL THROUGH */
463ee0b2 543 case OP_GVSV:
79072805 544 case OP_GV:
a6006777 545 case OP_AELEMFAST:
11343788 546 SvREFCNT_dec(cGVOPo->op_gv);
8990e307
LW		 547 break;
548 case OP_NEXTSTATE:
549 case OP_DBSTATE:
5196be3e 550 Safefree(cCOPo->cop_label);
11343788 551 SvREFCNT_dec(cCOPo->cop_filegv);
79072805
LW		 552 break;
553 case OP_CONST:
11343788 554 SvREFCNT_dec(cSVOPo->op_sv);
79072805 555 break;
748a9306
LW		 556 case OP_GOTO:
557 case OP_NEXT:
558 case OP_LAST:
559 case OP_REDO:
11343788 560 if (o->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
748a9306
LW		 561 break;
562 /* FALL THROUGH */
a0d0e21e 563 case OP_TRANS:
11343788 564 Safefree(cPVOPo->op_pv);
a0d0e21e
LW		 565 break;
566 case OP_SUBST:
11343788 567 op_free(cPMOPo->op_pmreplroot);
a0d0e21e 568 /* FALL THROUGH */
748a9306 569 case OP_PUSHRE:
a0d0e21e 570 case OP_MATCH:
11343788
MB		 571 pregfree(cPMOPo->op_pmregexp);
572 SvREFCNT_dec(cPMOPo->op_pmshort);
a0d0e21e 573 break;
79072805
LW		 574 }
575
11343788
MB		 576 if (o->op_targ > 0)
577 pad_free(o->op_targ);
8990e307 578
11343788 579 Safefree(o);
79072805
LW		 580}
581
8990e307 582static void
11343788
MB		 583null(o)
584OP* o;
8990e307 585{
11343788
MB		 586 if (o->op_type != OP_NULL && o->op_targ > 0)
587 pad_free(o->op_targ);
588 o->op_targ = o->op_type;
589 o->op_type = OP_NULL;
590 o->op_ppaddr = ppaddr[OP_NULL];
8990e307
LW		 591}
592
79072805
LW		 593/* Contextualizers */
594
463ee0b2 595#define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
79072805
LW		 596
597OP *
11343788
MB		 598linklist(o)
599OP *o;
79072805
LW		 600{
601 register OP *kid;
602
11343788
MB		 603 if (o->op_next)
604 return o->op_next;
79072805
LW		 605
606 /* establish postfix order */
11343788
MB		 607 if (cUNOPo->op_first) {
608 o->op_next = LINKLIST(cUNOPo->op_first);
609 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
79072805
LW		 610 if (kid->op_sibling)
611 kid->op_next = LINKLIST(kid->op_sibling);
612 else
11343788 613 kid->op_next = o;
79072805
LW		 614 }
615 }
616 else
11343788 617 o->op_next = o;
79072805 618
11343788 619 return o->op_next;
79072805
LW		 620}
621
622OP *
11343788
MB		 623scalarkids(o)
624OP *o;
79072805
LW		 625{
626 OP *kid;
11343788
MB		 627 if (o && o->op_flags & OPf_KIDS) {
628 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
79072805
LW		 629 scalar(kid);
630 }
11343788 631 return o;
79072805
LW		 632}
633
a0d0e21e 634static OP *
11343788
MB		 635scalarboolean(o)
636OP *o;
8990e307
LW		 637{
638 if (dowarn &&
11343788 639 o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
0f15f207 640 dTHR;
a0d0e21e
LW		 641 line_t oldline = curcop->cop_line;
642
643 if (copline != NOLINE)
644 curcop->cop_line = copline;
645 warn("Found = in conditional, should be ==");
646 curcop->cop_line = oldline;
647 }
11343788 648 return scalar(o);
8990e307
LW		 649}
650
651OP *
11343788
MB		 652scalar(o)
653OP *o;
79072805
LW		 654{
655 OP *kid;
656
a0d0e21e 657 /* assumes no premature commitment */
5dc0d613
MB		 658 if (!o || (o->op_flags & OPf_WANT) || error_count
659 || o->op_type == OP_RETURN)
11343788 660 return o;
79072805 661
5dc0d613 662 o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_SCALAR;
79072805 663
11343788 664 switch (o->op_type) {
79072805 665 case OP_REPEAT:
11343788
MB		 666 if (o->op_private & OPpREPEAT_DOLIST)
667 null(((LISTOP*)cBINOPo->op_first)->op_first);
668 scalar(cBINOPo->op_first);
8990e307 669 break;
79072805
LW		 670 case OP_OR:
671 case OP_AND:
672 case OP_COND_EXPR:
11343788 673 for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
8990e307 674 scalar(kid);
79072805 675 break;
a0d0e21e 676 case OP_SPLIT:
11343788 677 if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
a0d0e21e
LW		 678 if (!kPMOP->op_pmreplroot)
679 deprecate("implicit split to @_");
680 }
681 /* FALL THROUGH */
79072805
LW		 682 case OP_MATCH:
683 case OP_SUBST:
684 case OP_NULL:
8990e307 685 default:
11343788
MB		 686 if (o->op_flags & OPf_KIDS) {
687 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
8990e307
LW		 688 scalar(kid);
689 }
79072805
LW		 690 break;
691 case OP_LEAVE:
692 case OP_LEAVETRY:
5dc0d613 693 kid = cLISTOPo->op_first;
54310121 694 scalar(kid);
695 while (kid = kid->op_sibling) {
696 if (kid->op_sibling)
697 scalarvoid(kid);
698 else
699 scalar(kid);
700 }
0f15f207 701 WITH_THR(curcop = &compiling);
54310121 702 break;
748a9306 703 case OP_SCOPE:
79072805 704 case OP_LINESEQ:
8990e307 705 case OP_LIST:
11343788 706 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
79072805
LW		 707 if (kid->op_sibling)
708 scalarvoid(kid);
709 else
710 scalar(kid);
711 }
0f15f207 712 WITH_THR(curcop = &compiling);
79072805
LW		 713 break;
714 }
11343788 715 return o;
79072805
LW		 716}
717
718OP *
11343788
MB		 719scalarvoid(o)
720OP *o;
79072805
LW		 721{
722 OP *kid;
8990e307
LW		 723 char* useless = 0;
724 SV* sv;
79072805 725
54310121 726 /* assumes no premature commitment */
5dc0d613
MB		 727 if (!o || (o->op_flags & OPf_WANT) == OPf_WANT_LIST || error_count
728 || o->op_type == OP_RETURN)
11343788 729 return o;
79072805 730
5dc0d613 731 o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
79072805 732
11343788 733 switch (o->op_type) {
79072805 734 default:
11343788 735 if (!(opargs[o->op_type] & OA_FOLDCONST))
8990e307 736 break;
36477c24 737 /* FALL THROUGH */
738 case OP_REPEAT:
11343788 739 if (o->op_flags & OPf_STACKED)
8990e307
LW		 740 break;
741 /* FALL THROUGH */
742 case OP_GVSV:
743 case OP_WANTARRAY:
744 case OP_GV:
745 case OP_PADSV:
746 case OP_PADAV:
747 case OP_PADHV:
748 case OP_PADANY:
749 case OP_AV2ARYLEN:
8990e307 750 case OP_REF:
a0d0e21e
LW		 751 case OP_REFGEN:
752 case OP_SREFGEN:
8990e307
LW		 753 case OP_DEFINED:
754 case OP_HEX:
755 case OP_OCT:
756 case OP_LENGTH:
757 case OP_SUBSTR:
758 case OP_VEC:
759 case OP_INDEX:
760 case OP_RINDEX:
761 case OP_SPRINTF:
762 case OP_AELEM:
763 case OP_AELEMFAST:
764 case OP_ASLICE:
8990e307
LW		 765 case OP_HELEM:
766 case OP_HSLICE:
767 case OP_UNPACK:
768 case OP_PACK:
8990e307
LW		 769 case OP_JOIN:
770 case OP_LSLICE:
771 case OP_ANONLIST:
772 case OP_ANONHASH:
773 case OP_SORT:
774 case OP_REVERSE:
775 case OP_RANGE:
776 case OP_FLIP:
777 case OP_FLOP:
778 case OP_CALLER:
779 case OP_FILENO:
780 case OP_EOF:
781 case OP_TELL:
782 case OP_GETSOCKNAME:
783 case OP_GETPEERNAME:
784 case OP_READLINK:
785 case OP_TELLDIR:
786 case OP_GETPPID:
787 case OP_GETPGRP:
788 case OP_GETPRIORITY:
789 case OP_TIME:
790 case OP_TMS:
791 case OP_LOCALTIME:
792 case OP_GMTIME:
793 case OP_GHBYNAME:
794 case OP_GHBYADDR:
795 case OP_GHOSTENT:
796 case OP_GNBYNAME:
797 case OP_GNBYADDR:
798 case OP_GNETENT:
799 case OP_GPBYNAME:
800 case OP_GPBYNUMBER:
801 case OP_GPROTOENT:
802 case OP_GSBYNAME:
803 case OP_GSBYPORT:
804 case OP_GSERVENT:
805 case OP_GPWNAM:
806 case OP_GPWUID:
807 case OP_GGRNAM:
808 case OP_GGRGID:
809 case OP_GETLOGIN:
11343788
MB		 810 if (!(o->op_private & OPpLVAL_INTRO))
811 useless = op_desc[o->op_type];
8990e307
LW		 812 break;
813
814 case OP_RV2GV:
815 case OP_RV2SV:
816 case OP_RV2AV:
817 case OP_RV2HV:
11343788
MB		 818 if (!(o->op_private & OPpLVAL_INTRO) &&
819 (!o->op_sibling || o->op_sibling->op_type != OP_READLINE))
8990e307
LW		 820 useless = "a variable";
821 break;
79072805 822
93a17b20 823 case OP_NEXTSTATE:
8990e307 824 case OP_DBSTATE:
0f15f207 825 WITH_THR(curcop = ((COP*)o)); /* for warning below */
93a17b20
LW		 826 break;
827
79072805 828 case OP_CONST:
11343788 829 sv = cSVOPo->op_sv;
8990e307
LW		 830 if (dowarn) {
831 useless = "a constant";
832 if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
833 useless = 0;
834 else if (SvPOK(sv)) {
835 if (strnEQ(SvPVX(sv), "di", 2) ||
a0d0e21e 836 strnEQ(SvPVX(sv), "ds", 2) ||
8990e307
LW		 837 strnEQ(SvPVX(sv), "ig", 2))
838 useless = 0;
839 }
840 }
11343788 841 null(o); /* don't execute a constant */
8990e307 842 SvREFCNT_dec(sv); /* don't even remember it */
79072805
LW		 843 break;
844
845 case OP_POSTINC:
11343788
MB		 846 o->op_type = OP_PREINC; /* pre-increment is faster */
847 o->op_ppaddr = ppaddr[OP_PREINC];
79072805
LW		 848 break;
849
850 case OP_POSTDEC:
11343788
MB		 851 o->op_type = OP_PREDEC; /* pre-decrement is faster */
852 o->op_ppaddr = ppaddr[OP_PREDEC];
79072805
LW		 853 break;
854
79072805
LW		 855 case OP_OR:
856 case OP_AND:
857 case OP_COND_EXPR:
11343788 858 for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
79072805
LW		 859 scalarvoid(kid);
860 break;
5aabfad6 861
a0d0e21e 862 case OP_NULL:
11343788 863 if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
0f15f207 864 WITH_THR(curcop = ((COP*)o)); /* for warning below */
11343788 865 if (o->op_flags & OPf_STACKED)
a0d0e21e 866 break;
5aabfad6 867 /* FALL THROUGH */
79072805
LW		 868 case OP_ENTERTRY:
869 case OP_ENTER:
870 case OP_SCALAR:
11343788 871 if (!(o->op_flags & OPf_KIDS))
79072805 872 break;
54310121 873 /* FALL THROUGH */
463ee0b2 874 case OP_SCOPE:
79072805
LW		 875 case OP_LEAVE:
876 case OP_LEAVETRY:
a0d0e21e 877 case OP_LEAVELOOP:
79072805 878 case OP_LINESEQ:
79072805 879 case OP_LIST:
11343788 880 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
79072805
LW		 881 scalarvoid(kid);
882 break;
c90c0ff4 883 case OP_ENTEREVAL:
5196be3e 884 scalarkids(o);
c90c0ff4 885 break;
5aabfad6 886 case OP_REQUIRE:
c90c0ff4 887 /* all requires must return a boolean value */
5196be3e
MB		 888 o->op_flags &= ~OPf_WANT;
889 return scalar(o);
a0d0e21e 890 case OP_SPLIT:
11343788 891 if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
a0d0e21e
LW		 892 if (!kPMOP->op_pmreplroot)
893 deprecate("implicit split to @_");
894 }
895 break;
79072805 896 }
8990e307
LW		 897 if (useless && dowarn)
898 warn("Useless use of %s in void context", useless);
11343788 899 return o;
79072805
LW		 900}
901
902OP *
11343788
MB		 903listkids(o)
904OP *o;
79072805
LW		 905{
906 OP *kid;
11343788
MB		 907 if (o && o->op_flags & OPf_KIDS) {
908 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
79072805
LW		 909 list(kid);
910 }
11343788 911 return o;
79072805
LW		 912}
913
914OP *
11343788
MB		 915list(o)
916OP *o;
79072805
LW		 917{
918 OP *kid;
919
a0d0e21e 920 /* assumes no premature commitment */
5dc0d613
MB		 921 if (!o || (o->op_flags & OPf_WANT) || error_count
922 || o->op_type == OP_RETURN)
11343788 923 return o;
79072805 924
5dc0d613 925 o->op_flags = (o->op_flags & ~OPf_WANT) | OPf_WANT_LIST;
79072805 926
11343788 927 switch (o->op_type) {
79072805
LW		 928 case OP_FLOP:
929 case OP_REPEAT:
11343788 930 list(cBINOPo->op_first);
79072805
LW		 931 break;
932 case OP_OR:
933 case OP_AND:
934 case OP_COND_EXPR:
11343788 935 for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
79072805
LW		 936 list(kid);
937 break;
938 default:
939 case OP_MATCH:
940 case OP_SUBST:
941 case OP_NULL:
11343788 942 if (!(o->op_flags & OPf_KIDS))
79072805 943 break;
11343788
MB		 944 if (!o->op_next && cUNOPo->op_first->op_type == OP_FLOP) {
945 list(cBINOPo->op_first);
946 return gen_constant_list(o);
79072805
LW		 947 }
948 case OP_LIST:
11343788 949 listkids(o);
79072805
LW		 950 break;
951 case OP_LEAVE:
952 case OP_LEAVETRY:
5dc0d613 953 kid = cLISTOPo->op_first;
54310121 954 list(kid);
955 while (kid = kid->op_sibling) {
956 if (kid->op_sibling)
957 scalarvoid(kid);
958 else
959 list(kid);
960 }
0f15f207 961 WITH_THR(curcop = &compiling);
54310121 962 break;
748a9306 963 case OP_SCOPE:
79072805 964 case OP_LINESEQ:
11343788 965 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
79072805
LW		 966 if (kid->op_sibling)
967 scalarvoid(kid);
968 else
969 list(kid);
970 }
0f15f207 971 WITH_THR(curcop = &compiling);
79072805 972 break;
c90c0ff4 973 case OP_REQUIRE:
974 /* all requires must return a boolean value */
5196be3e
MB		 975 o->op_flags &= ~OPf_WANT;
976 return scalar(o);
79072805 977 }
11343788 978 return o;
79072805
LW		 979}
980
981OP *
11343788
MB		 982scalarseq(o)
983OP *o;
79072805
LW		 984{
985 OP *kid;
986
11343788
MB		 987 if (o) {
988 if (o->op_type == OP_LINESEQ ||
989 o->op_type == OP_SCOPE ||
990 o->op_type == OP_LEAVE ||
991 o->op_type == OP_LEAVETRY)
463ee0b2 992 {
0f15f207 993 dTHR;
11343788 994 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
ed6116ce 995 if (kid->op_sibling) {
463ee0b2 996 scalarvoid(kid);
ed6116ce 997 }
463ee0b2
LW		 998 }
999 curcop = &compiling;
79072805 1000 }
11343788 1001 o->op_flags &= ~OPf_PARENS;
85e6fe83 1002 if (hints & HINT_BLOCK_SCOPE)
11343788 1003 o->op_flags |= OPf_PARENS;
79072805 1004 }
8990e307 1005 else
11343788
MB		 1006 o = newOP(OP_STUB, 0);
1007 return o;
79072805
LW		 1008}
1009
a0d0e21e 1010static OP *
11343788
MB		 1011modkids(o, type)
1012OP *o;
79072805
LW		 1013I32 type;
1014{
1015 OP *kid;
11343788
MB		 1016 if (o && o->op_flags & OPf_KIDS) {
1017 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
463ee0b2 1018 mod(kid, type);
79072805 1019 }
11343788 1020 return o;
79072805
LW		 1021}
1022
463ee0b2 1023static I32 modcount;
79072805
LW		 1024
1025OP *
11343788
MB		 1026mod(o, type)
1027OP *o;
79072805
LW		 1028I32 type;
1029{
11343788 1030 dTHR;
79072805
LW		 1031 OP *kid;
1032 SV *sv;
1033
11343788
MB		 1034 if (!o || error_count)
1035 return o;
79072805 1036
11343788 1037 switch (o->op_type) {
68dc0745 1038 case OP_UNDEF:
5dc0d613 1039 return o;
a0d0e21e 1040 case OP_CONST:
11343788 1041 if (!(o->op_private & (OPpCONST_ARYBASE)))
a0d0e21e
LW		 1042 goto nomod;
1043 if (eval_start && eval_start->op_type == OP_CONST) {
1044 compiling.cop_arybase = (I32)SvIV(((SVOP*)eval_start)->op_sv);
1045 eval_start = 0;
1046 }
1047 else if (!type) {
1048 SAVEI32(compiling.cop_arybase);
748a9306 1049 compiling.cop_arybase = 0;
a0d0e21e
LW		 1050 }
1051 else if (type == OP_REFGEN)
1052 goto nomod;
1053 else
1054 croak("That use of $[ is unsupported");
1055 break;
5f05dabc 1056 case OP_STUB:
5196be3e 1057 if (o->op_flags & OPf_PARENS)
5f05dabc 1058 break;
1059 goto nomod;
a0d0e21e
LW		 1060 case OP_ENTERSUB:
1061 if ((type == OP_UNDEF || type == OP_REFGEN) &&
11343788
MB		 1062 !(o->op_flags & OPf_STACKED)) {
1063 o->op_type = OP_RV2CV; /* entersub => rv2cv */
1064 o->op_ppaddr = ppaddr[OP_RV2CV];
1065 assert(cUNOPo->op_first->op_type == OP_NULL);
1066 null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
79072805
LW		 1067 break;
1068 }
1069 /* FALL THROUGH */
1070 default:
a0d0e21e
LW		 1071 nomod:
1072 /* grep, foreach, subcalls, refgen */
1073 if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
1074 break;
46fc3d4c 1075 yyerror(form("Can't modify %s in %s",
5dc0d613 1076 op_desc[o->op_type],
46fc3d4c 1077 type ? op_desc[type] : "local"));
11343788 1078 return o;
79072805 1079
a0d0e21e
LW		 1080 case OP_PREINC:
1081 case OP_PREDEC:
1082 case OP_POW:
1083 case OP_MULTIPLY:
1084 case OP_DIVIDE:
1085 case OP_MODULO:
1086 case OP_REPEAT:
1087 case OP_ADD:
1088 case OP_SUBTRACT:
1089 case OP_CONCAT:
1090 case OP_LEFT_SHIFT:
1091 case OP_RIGHT_SHIFT:
1092 case OP_BIT_AND:
1093 case OP_BIT_XOR:
1094 case OP_BIT_OR:
1095 case OP_I_MULTIPLY:
1096 case OP_I_DIVIDE:
1097 case OP_I_MODULO:
1098 case OP_I_ADD:
1099 case OP_I_SUBTRACT:
11343788 1100 if (!(o->op_flags & OPf_STACKED))
a0d0e21e
LW		 1101 goto nomod;
1102 modcount++;
1103 break;
1104
79072805 1105 case OP_COND_EXPR:
11343788 1106 for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
463ee0b2 1107 mod(kid, type);
79072805
LW		 1108 break;
1109
1110 case OP_RV2AV:
1111 case OP_RV2HV:
11343788 1112 if (type == OP_REFGEN && o->op_flags & OPf_PARENS) {
748a9306 1113 modcount = 10000;
11343788 1114 return o; /* Treat \(@foo) like ordinary list. */
748a9306
LW		 1115 }
1116 /* FALL THROUGH */
79072805 1117 case OP_RV2GV:
5dc0d613 1118 if (scalar_mod_type(o, type))
3fe9a6f1 1119 goto nomod;
11343788 1120 ref(cUNOPo->op_first, o->op_type);
79072805
LW		 1121 /* FALL THROUGH */
1122 case OP_AASSIGN:
1123 case OP_ASLICE:
1124 case OP_HSLICE:
93a17b20
LW		 1125 case OP_NEXTSTATE:
1126 case OP_DBSTATE:
a0d0e21e
LW		 1127 case OP_REFGEN:
1128 case OP_CHOMP:
463ee0b2 1129 modcount = 10000;
79072805 1130 break;
463ee0b2 1131 case OP_RV2SV:
11343788 1132 if (!type && cUNOPo->op_first->op_type != OP_GV)
4633a7c4 1133 croak("Can't localize a reference");
11343788 1134 ref(cUNOPo->op_first, o->op_type);
463ee0b2 1135 /* FALL THROUGH */
79072805 1136 case OP_GV:
463ee0b2
LW		 1137 case OP_AV2ARYLEN:
1138 case OP_SASSIGN:
8990e307
LW		 1139 case OP_AELEMFAST:
1140 modcount++;
1141 break;
1142
748a9306
LW		 1143 case OP_PADAV:
1144 case OP_PADHV:
1145 modcount = 10000;
5196be3e
MB		 1146 if (type == OP_REFGEN && o->op_flags & OPf_PARENS)
1147 return o; /* Treat \(@foo) like ordinary list. */
1148 if (scalar_mod_type(o, type))
3fe9a6f1 1149 goto nomod;
748a9306
LW		 1150 /* FALL THROUGH */
1151 case OP_PADSV:
1152 modcount++;
1153 if (!type)
1154 croak("Can't localize lexical variable %s",
11343788 1155 SvPV(*av_fetch(comppad_name, o->op_targ, 4), na));
463ee0b2
LW		 1156 break;
1157
748a9306
LW		 1158 case OP_PUSHMARK:
1159 break;
a0d0e21e 1160
69969c6f
SB		 1161 case OP_KEYS:
1162 if (type != OP_SASSIGN)
1163 goto nomod;
5f05dabc 1164 /* FALL THROUGH */
a0d0e21e 1165 case OP_POS:
463ee0b2 1166 case OP_VEC:
a0d0e21e 1167 case OP_SUBSTR:
11343788
MB		 1168 pad_free(o->op_targ);
1169 o->op_targ = pad_alloc(o->op_type, SVs_PADMY);
5dc0d613 1170 assert(SvTYPE(PAD_SV(o->op_targ)) == SVt_NULL);
11343788
MB		 1171 if (o->op_flags & OPf_KIDS)
1172 mod(cBINOPo->op_first->op_sibling, type);
463ee0b2 1173 break;
a0d0e21e 1174
463ee0b2
LW		 1175 case OP_AELEM:
1176 case OP_HELEM:
11343788 1177 ref(cBINOPo->op_first, o->op_type);
68dc0745 1178 if (type == OP_ENTERSUB &&
5dc0d613
MB		 1179 !(o->op_private & (OPpLVAL_INTRO | OPpDEREF)))
1180 o->op_private |= OPpLVAL_DEFER;
a0d0e21e 1181 modcount++;
463ee0b2
LW		 1182 break;
1183
1184 case OP_SCOPE:
1185 case OP_LEAVE:
1186 case OP_ENTER:
11343788
MB		 1187 if (o->op_flags & OPf_KIDS)
1188 mod(cLISTOPo->op_last, type);
a0d0e21e
LW		 1189 break;
1190
1191 case OP_NULL:
11343788 1192 if (!(o->op_flags & OPf_KIDS))
463ee0b2 1193 break;
11343788
MB		 1194 if (o->op_targ != OP_LIST) {
1195 mod(cBINOPo->op_first, type);
a0d0e21e
LW		 1196 break;
1197 }
1198 /* FALL THROUGH */
463ee0b2 1199 case OP_LIST:
11343788 1200 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
463ee0b2
LW		 1201 mod(kid, type);
1202 break;
1203 }
11343788 1204 o->op_flags |= OPf_MOD;
a0d0e21e
LW		 1205
1206 if (type == OP_AASSIGN || type == OP_SASSIGN)
11343788 1207 o->op_flags |= OPf_SPECIAL|OPf_REF;
a0d0e21e 1208 else if (!type) {
11343788
MB		 1209 o->op_private |= OPpLVAL_INTRO;
1210 o->op_flags &= ~OPf_SPECIAL;
463ee0b2 1211 }
a0d0e21e 1212 else if (type != OP_GREPSTART && type != OP_ENTERSUB)
11343788
MB		 1213 o->op_flags |= OPf_REF;
1214 return o;
463ee0b2
LW		 1215}
1216
3fe9a6f1 1217static bool
5196be3e
MB		 1218scalar_mod_type(o, type)
1219OP *o;
3fe9a6f1 1220I32 type;
1221{
1222 switch (type) {
1223 case OP_SASSIGN:
5196be3e 1224 if (o->op_type == OP_RV2GV)
3fe9a6f1 1225 return FALSE;
1226 /* FALL THROUGH */
1227 case OP_PREINC:
1228 case OP_PREDEC:
1229 case OP_POSTINC:
1230 case OP_POSTDEC:
1231 case OP_I_PREINC:
1232 case OP_I_PREDEC:
1233 case OP_I_POSTINC:
1234 case OP_I_POSTDEC:
1235 case OP_POW:
1236 case OP_MULTIPLY:
1237 case OP_DIVIDE:
1238 case OP_MODULO:
1239 case OP_REPEAT:
1240 case OP_ADD:
1241 case OP_SUBTRACT:
1242 case OP_I_MULTIPLY:
1243 case OP_I_DIVIDE:
1244 case OP_I_MODULO:
1245 case OP_I_ADD:
1246 case OP_I_SUBTRACT:
1247 case OP_LEFT_SHIFT:
1248 case OP_RIGHT_SHIFT:
1249 case OP_BIT_AND:
1250 case OP_BIT_XOR:
1251 case OP_BIT_OR:
1252 case OP_CONCAT:
1253 case OP_SUBST:
1254 case OP_TRANS:
1255 case OP_ANDASSIGN: /* may work later */
1256 case OP_ORASSIGN: /* may work later */
1257 return TRUE;
1258 default:
1259 return FALSE;
1260 }
1261}
1262
463ee0b2 1263OP *
11343788
MB		 1264refkids(o, type)
1265OP *o;
463ee0b2
LW		 1266I32 type;
1267{
1268 OP *kid;
11343788
MB		 1269 if (o && o->op_flags & OPf_KIDS) {
1270 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
463ee0b2
LW		 1271 ref(kid, type);
1272 }
11343788 1273 return o;
463ee0b2
LW		 1274}
1275
1276OP *
11343788
MB		 1277ref(o, type)
1278OP *o;
463ee0b2
LW		 1279I32 type;
1280{
1281 OP *kid;
463ee0b2 1282
11343788
MB		 1283 if (!o || error_count)
1284 return o;
463ee0b2 1285
11343788 1286 switch (o->op_type) {
a0d0e21e
LW		 1287 case OP_ENTERSUB:
1288 if ((type == OP_DEFINED) &&
11343788
MB		 1289 !(o->op_flags & OPf_STACKED)) {
1290 o->op_type = OP_RV2CV; /* entersub => rv2cv */
1291 o->op_ppaddr = ppaddr[OP_RV2CV];
1292 assert(cUNOPo->op_first->op_type == OP_NULL);
1293 null(((LISTOP*)cUNOPo->op_first)->op_first); /* disable pushmark */
1294 o->op_flags |= OPf_SPECIAL;
8990e307
LW		 1295 }
1296 break;
1297
463ee0b2 1298 case OP_COND_EXPR:
11343788 1299 for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
463ee0b2
LW		 1300 ref(kid, type);
1301 break;
8990e307 1302 case OP_RV2SV:
11343788 1303 ref(cUNOPo->op_first, o->op_type);
4633a7c4
LW		 1304 /* FALL THROUGH */
1305 case OP_PADSV:
5f05dabc 1306 if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
5dc0d613
MB		 1307 o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
1308 : type == OP_RV2HV ? OPpDEREF_HV
1309 : OPpDEREF_SV);
11343788 1310 o->op_flags |= OPf_MOD;
a0d0e21e 1311 }
8990e307
LW		 1312 break;
1313
463ee0b2
LW		 1314 case OP_RV2AV:
1315 case OP_RV2HV:
11343788 1316 o->op_flags |= OPf_REF;
8990e307 1317 /* FALL THROUGH */
463ee0b2 1318 case OP_RV2GV:
11343788 1319 ref(cUNOPo->op_first, o->op_type);
463ee0b2 1320 break;
8990e307 1321
463ee0b2
LW		 1322 case OP_PADAV:
1323 case OP_PADHV:
11343788 1324 o->op_flags |= OPf_REF;
79072805 1325 break;
8990e307
LW		 1326
1327 case OP_SCALAR:
79072805 1328 case OP_NULL:
11343788 1329 if (!(o->op_flags & OPf_KIDS))
463ee0b2 1330 break;
11343788 1331 ref(cBINOPo->op_first, type);
79072805
LW		 1332 break;
1333 case OP_AELEM:
1334 case OP_HELEM:
11343788 1335 ref(cBINOPo->op_first, o->op_type);
5f05dabc 1336 if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
5dc0d613
MB		 1337 o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
1338 : type == OP_RV2HV ? OPpDEREF_HV
1339 : OPpDEREF_SV);
11343788 1340 o->op_flags |= OPf_MOD;
8990e307 1341 }
79072805
LW		 1342 break;
1343
463ee0b2 1344 case OP_SCOPE:
79072805
LW		 1345 case OP_LEAVE:
1346 case OP_ENTER:
8990e307 1347 case OP_LIST:
11343788 1348 if (!(o->op_flags & OPf_KIDS))
79072805 1349 break;
11343788 1350 ref(cLISTOPo->op_last, type);
79072805 1351 break;
a0d0e21e
LW		 1352 default:
1353 break;
79072805 1354 }
11343788 1355 return scalar(o);
8990e307 1356
79072805
LW		 1357}
1358
1359OP *
11343788
MB		 1360my(o)
1361OP *o;
93a17b20
LW		 1362{
1363 OP *kid;
93a17b20
LW		 1364 I32 type;
1365
11343788
MB		 1366 if (!o || error_count)
1367 return o;
93a17b20 1368
11343788 1369 type = o->op_type;
93a17b20 1370 if (type == OP_LIST) {
11343788 1371 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
93a17b20
LW		 1372 my(kid);
1373 }
1374 else if (type != OP_PADSV &&
1375 type != OP_PADAV &&
1376 type != OP_PADHV &&
1377 type != OP_PUSHMARK)
1378 {
5dc0d613 1379 yyerror(form("Can't declare %s in my", op_desc[o->op_type]));
11343788 1380 return o;
93a17b20 1381 }
11343788
MB		 1382 o->op_flags |= OPf_MOD;
1383 o->op_private |= OPpLVAL_INTRO;
1384 return o;
93a17b20
LW		 1385}
1386
1387OP *
79072805
LW		 1388sawparens(o)
1389OP *o;
1390{
1391 if (o)
1392 o->op_flags |= OPf_PARENS;
1393 return o;
1394}
1395
1396OP *
1397bind_match(type, left, right)
1398I32 type;
1399OP *left;
1400OP *right;
1401{
11343788 1402 OP *o;
79072805 1403
2ae324a7 1404 if (dowarn &&
1405 (left->op_type == OP_RV2AV ||
1406 left->op_type == OP_RV2HV ||
1407 left->op_type == OP_PADAV ||
1408 left->op_type == OP_PADHV)) {
1409 char *desc = op_desc[(right->op_type == OP_SUBST ||
1410 right->op_type == OP_TRANS)
1411 ? right->op_type : OP_MATCH];
1412 char *sample = ((left->op_type == OP_RV2AV ||
1413 left->op_type == OP_PADAV)
1414 ? "@array" : "%hash");
1415 warn("Applying %s to %s will act on scalar(%s)", desc, sample, sample);
1416 }
1417
79072805
LW		 1418 if (right->op_type == OP_MATCH ||
1419 right->op_type == OP_SUBST ||
1420 right->op_type == OP_TRANS) {
1421 right->op_flags |= OPf_STACKED;
1422 if (right->op_type != OP_MATCH)
463ee0b2 1423 left = mod(left, right->op_type);
79072805 1424 if (right->op_type == OP_TRANS)
11343788 1425 o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
79072805 1426 else
11343788 1427 o = prepend_elem(right->op_type, scalar(left), right);
79072805 1428 if (type == OP_NOT)
11343788
MB		 1429 return newUNOP(OP_NOT, 0, scalar(o));
1430 return o;
79072805
LW		 1431 }
1432 else
1433 return bind_match(type, left,
1434 pmruntime(newPMOP(OP_MATCH, 0), right, Nullop));
1435}
1436
1437OP *
11343788
MB		 1438invert(o)
1439OP *o;
79072805 1440{
11343788
MB		 1441 if (!o)
1442 return o;
79072805 1443 /* XXX need to optimize away NOT NOT here? Or do we let optimizer do it? */
11343788 1444 return newUNOP(OP_NOT, OPf_SPECIAL, scalar(o));
79072805
LW		 1445}
1446
1447OP *
1448scope(o)
1449OP *o;
1450{
1451 if (o) {
4633a7c4 1452 if (o->op_flags & OPf_PARENS || perldb || tainting) {
463ee0b2
LW		 1453 o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
1454 o->op_type = OP_LEAVE;
1455 o->op_ppaddr = ppaddr[OP_LEAVE];
1456 }
1457 else {
1458 if (o->op_type == OP_LINESEQ) {
1459 OP *kid;
1460 o->op_type = OP_SCOPE;
1461 o->op_ppaddr = ppaddr[OP_SCOPE];
1462 kid = ((LISTOP*)o)->op_first;
748a9306
LW		 1463 if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
1464 SvREFCNT_dec(((COP*)kid)->cop_filegv);
8990e307 1465 null(kid);
748a9306 1466 }
463ee0b2
LW		 1467 }
1468 else
748a9306 1469 o = newLISTOP(OP_SCOPE, 0, o, Nullop);
463ee0b2 1470 }
79072805
LW		 1471 }
1472 return o;
1473}
1474
a0d0e21e 1475int
55497cff 1476block_start(full)
1477int full;
79072805 1478{
11343788 1479 dTHR;
a0d0e21e 1480 int retval = savestack_ix;
55497cff 1481 SAVEI32(comppad_name_floor);
1482 if (full) {
1483 if ((comppad_name_fill = AvFILL(comppad_name)) > 0)
1484 comppad_name_floor = comppad_name_fill;
1485 else
1486 comppad_name_floor = 0;
1487 }
1488 SAVEI32(min_intro_pending);
1489 SAVEI32(max_intro_pending);
a0d0e21e 1490 min_intro_pending = 0;
55497cff 1491 SAVEI32(comppad_name_fill);
1492 SAVEI32(padix_floor);
a0d0e21e
LW		 1493 padix_floor = padix;
1494 pad_reset_pending = FALSE;
55497cff 1495 SAVEI32(hints);
a0d0e21e
LW		 1496 hints &= ~HINT_BLOCK_SCOPE;
1497 return retval;
1498}
1499
1500OP*
36477c24 1501block_end(floor, seq)
1502I32 floor;
a0d0e21e
LW		 1503OP* seq;
1504{
11343788 1505 dTHR;
a0d0e21e
LW		 1506 int needblockscope = hints & HINT_BLOCK_SCOPE;
1507 OP* retval = scalarseq(seq);
a0d0e21e
LW		 1508 LEAVE_SCOPE(floor);
1509 pad_reset_pending = FALSE;
1510 if (needblockscope)
1511 hints |= HINT_BLOCK_SCOPE; /* propagate out */
1512 pad_leavemy(comppad_name_fill);
bbce6d69 1513 cop_seqmax++;
a0d0e21e
LW		 1514 return retval;
1515}
1516
1517void
11343788
MB		 1518newPROG(o)
1519OP *o;
a0d0e21e 1520{
11343788 1521 dTHR;
a0d0e21e 1522 if (in_eval) {
5dc0d613 1523 eval_root = newUNOP(OP_LEAVEEVAL, ((in_eval & 4) ? OPf_SPECIAL : 0), o);
a0d0e21e
LW		 1524 eval_start = linklist(eval_root);
1525 eval_root->op_next = 0;
1526 peep(eval_start);
1527 }
1528 else {
5dc0d613 1529 if (!o)
a0d0e21e 1530 return;
11343788 1531 main_root = scope(sawparens(scalarvoid(o)));
a0d0e21e
LW		 1532 curcop = &compiling;
1533 main_start = LINKLIST(main_root);
1534 main_root->op_next = 0;
1535 peep(main_start);
748a9306 1536 compcv = 0;
3841441e 1537
4fdae800 1538 /* Register with debugger */
3841441e
CS		 1539 if (perldb) {
1540 CV *cv = perl_get_cv("DB::postponed", FALSE);
3841441e
CS		 1541 if (cv) {
1542 dSP;
1543 PUSHMARK(sp);
1544 XPUSHs((SV*)compiling.cop_filegv);
1545 PUTBACK;
1546 perl_call_sv((SV*)cv, G_DISCARD);
1547 }
1548 }
79072805 1549 }
79072805
LW		 1550}
1551
1552OP *
93a17b20 1553localize(o, lex)
79072805 1554OP *o;
93a17b20 1555I32 lex;
79072805
LW		 1556{
1557 if (o->op_flags & OPf_PARENS)
1558 list(o);
8990e307 1559 else {
79072805 1560 scalar(o);
8990e307
LW		 1561 if (dowarn && bufptr > oldbufptr && bufptr[-1] == ',') {
1562 char *s;
1563 for (s = bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
a0d0e21e 1564 if (*s == ';' || *s == '=')
8990e307
LW		 1565 warn("Parens missing around \"%s\" list", lex ? "my" : "local");
1566 }
1567 }
93a17b20 1568 in_my = FALSE;
c750a3ec 1569 in_my_stash = Nullhv;
93a17b20
LW		 1570 if (lex)
1571 return my(o);
1572 else
463ee0b2 1573 return mod(o, OP_NULL); /* a bit kludgey */
79072805
LW		 1574}
1575
1576OP *
1577jmaybe(o)
1578OP *o;
1579{
1580 if (o->op_type == OP_LIST) {
1581 o = convert(OP_JOIN, 0,
1582 prepend_elem(OP_LIST,
85e6fe83 1583 newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
79072805
LW		 1584 o));
1585 }
1586 return o;
1587}
1588
1589OP *
1590fold_constants(o)
1591register OP *o;
1592{
11343788 1593 dTHR;
79072805
LW		 1594 register OP *curop;
1595 I32 type = o->op_type;
748a9306 1596 SV *sv;
79072805
LW		 1597
1598 if (opargs[type] & OA_RETSCALAR)
1599 scalar(o);
1600 if (opargs[type] & OA_TARGET)
ed6116ce 1601 o->op_targ = pad_alloc(type, SVs_PADTMP);
79072805 1602
85e6fe83 1603 if ((opargs[type] & OA_OTHERINT) && (hints & HINT_INTEGER))
a0d0e21e 1604 o->op_ppaddr = ppaddr[type = ++(o->op_type)];
85e6fe83 1605
79072805
LW		 1606 if (!(opargs[type] & OA_FOLDCONST))
1607 goto nope;
1608
a0d0e21e
LW		 1609 if (error_count)
1610 goto nope; /* Don't try to run w/ errors */
1611
79072805 1612 for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
93a17b20
LW		 1613 if (curop->op_type != OP_CONST &&
1614 curop->op_type != OP_LIST &&
1615 curop->op_type != OP_SCALAR &&
a0d0e21e 1616 curop->op_type != OP_NULL &&
93a17b20 1617 curop->op_type != OP_PUSHMARK) {
79072805
LW		 1618 goto nope;
1619 }
1620 }
1621
1622 curop = LINKLIST(o);
1623 o->op_next = 0;
1624 op = curop;
8da795c6 1625 runops();
748a9306
LW		 1626 sv = *(stack_sp--);
1627 if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */
79072805 1628 pad_swipe(o->op_targ);
748a9306
LW		 1629 else if (SvTEMP(sv)) { /* grab mortal temp? */
1630 (void)SvREFCNT_inc(sv);
1631 SvTEMP_off(sv);
85e6fe83 1632 }
79072805
LW		 1633 op_free(o);
1634 if (type == OP_RV2GV)
b1cb66bf 1635 return newGVOP(OP_GV, 0, (GV*)sv);
748a9306
LW		 1636 else {
1637 if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK) {
1638 IV iv = SvIV(sv);
1639 if ((double)iv == SvNV(sv)) { /* can we smush double to int */
1640 SvREFCNT_dec(sv);
1641 sv = newSViv(iv);
1642 }
b1cb66bf 1643 else
1644 SvIOK_off(sv); /* undo SvIV() damage */
748a9306
LW		 1645 }
1646 return newSVOP(OP_CONST, 0, sv);
1647 }
79072805
LW		 1648
1649 nope:
1650 if (!(opargs[type] & OA_OTHERINT))
1651 return o;
79072805 1652
85e6fe83 1653 if (!(hints & HINT_INTEGER)) {
a0d0e21e 1654 if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS))
85e6fe83
LW		 1655 return o;
1656
1657 for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
1658 if (curop->op_type == OP_CONST) {
b1cb66bf 1659 if (SvIOK(((SVOP*)curop)->op_sv))
85e6fe83
LW		 1660 continue;
1661 return o;
1662 }
1663 if (opargs[curop->op_type] & OA_RETINTEGER)
79072805
LW		 1664 continue;
1665 return o;
1666 }
a0d0e21e 1667 o->op_ppaddr = ppaddr[++(o->op_type)];
79072805
LW		 1668 }
1669
79072805
LW		 1670 return o;
1671}
1672
1673OP *
1674gen_constant_list(o)
1675register OP *o;
1676{
11343788 1677 dTHR;
79072805 1678 register OP *curop;
79072805 1679 I32 oldtmps_floor = tmps_floor;
79072805 1680
a0d0e21e
LW		 1681 list(o);
1682 if (error_count)
1683 return o; /* Don't attempt to run with errors */
1684
1685 op = curop = LINKLIST(o);
1686 o->op_next = 0;
11343788 1687 pp_pushmark(ARGS);
8da795c6 1688 runops();
a0d0e21e 1689 op = curop;
11343788 1690 pp_anonlist(ARGS);
79072805 1691 tmps_floor = oldtmps_floor;
79072805
LW		 1692
1693 o->op_type = OP_RV2AV;
1694 o->op_ppaddr = ppaddr[OP_RV2AV];
79072805 1695 curop = ((UNOP*)o)->op_first;
a0d0e21e 1696 ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*stack_sp--));
79072805 1697 op_free(curop);
79072805
LW		 1698 linklist(o);
1699 return list(o);
1700}
1701
1702OP *
11343788 1703convert(type, flags, o)
79072805
LW		 1704I32 type;
1705I32 flags;
11343788 1706OP* o;
79072805
LW		 1707{
1708 OP *kid;
a0d0e21e 1709 OP *last = 0;
79072805 1710
11343788
MB		 1711 if (!o || o->op_type != OP_LIST)
1712 o = newLISTOP(OP_LIST, 0, o, Nullop);
748a9306 1713 else
5dc0d613 1714 o->op_flags &= ~OPf_WANT;
79072805 1715
8990e307 1716 if (!(opargs[type] & OA_MARK))
11343788 1717 null(cLISTOPo->op_first);
8990e307 1718
11343788
MB		 1719 o->op_type = type;
1720 o->op_ppaddr = ppaddr[type];
1721 o->op_flags |= flags;
79072805 1722
11343788
MB		 1723 o = CHECKOP(type, o);
1724 if (o->op_type != type)
1725 return o;
79072805 1726
11343788 1727 if (cLISTOPo->op_children < 7) {
79072805 1728 /* XXX do we really need to do this if we're done appending?? */
11343788 1729 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
79072805 1730 last = kid;
11343788 1731 cLISTOPo->op_last = last; /* in case check substituted last arg */
79072805
LW		 1732 }
1733
11343788 1734 return fold_constants(o);
79072805
LW		 1735}
1736
1737/* List constructors */
1738
1739OP *
1740append_elem(type, first, last)
1741I32 type;
1742OP* first;
1743OP* last;
1744{
1745 if (!first)
1746 return last;
8990e307
LW		 1747
1748 if (!last)
79072805 1749 return first;
8990e307 1750
a0d0e21e
LW		 1751 if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS)
1752 return newLISTOP(type, 0, first, last);
79072805 1753
a0d0e21e
LW		 1754 if (first->op_flags & OPf_KIDS)
1755 ((LISTOP*)first)->op_last->op_sibling = last;
1756 else {
1757 first->op_flags |= OPf_KIDS;
1758 ((LISTOP*)first)->op_first = last;
1759 }
1760 ((LISTOP*)first)->op_last = last;
1761 ((LISTOP*)first)->op_children++;
1762 return first;
79072805
LW		 1763}
1764
1765OP *
1766append_list(type, first, last)
1767I32 type;
1768LISTOP* first;
1769LISTOP* last;
1770{
1771 if (!first)
1772 return (OP*)last;
8990e307
LW		 1773
1774 if (!last)
79072805 1775 return (OP*)first;
8990e307
LW		 1776
1777 if (first->op_type != type)
79072805 1778 return prepend_elem(type, (OP*)first, (OP*)last);
8990e307
LW		 1779
1780 if (last->op_type != type)
79072805
LW		 1781 return append_elem(type, (OP*)first, (OP*)last);
1782
1783 first->op_last->op_sibling = last->op_first;
1784 first->op_last = last->op_last;
1785 first->op_children += last->op_children;
1786 if (first->op_children)
1787 last->op_flags |= OPf_KIDS;
1788
1789 Safefree(last);
1790 return (OP*)first;
1791}
1792
1793OP *
1794prepend_elem(type, first, last)
1795I32 type;
1796OP* first;
1797OP* last;
1798{
1799 if (!first)
1800 return last;
8990e307
LW		 1801
1802 if (!last)
79072805 1803 return first;
8990e307
LW		 1804
1805 if (last->op_type == type) {
1806 if (type == OP_LIST) { /* already a PUSHMARK there */
1807 first->op_sibling = ((LISTOP*)last)->op_first->op_sibling;
1808 ((LISTOP*)last)->op_first->op_sibling = first;
1809 }
1810 else {
1811 if (!(last->op_flags & OPf_KIDS)) {
1812 ((LISTOP*)last)->op_last = first;
1813 last->op_flags |= OPf_KIDS;
1814 }
1815 first->op_sibling = ((LISTOP*)last)->op_first;
1816 ((LISTOP*)last)->op_first = first;
79072805 1817 }
79072805
LW		 1818 ((LISTOP*)last)->op_children++;
1819 return last;
1820 }
1821
1822 return newLISTOP(type, 0, first, last);
1823}
1824
1825/* Constructors */
1826
1827OP *
1828newNULLLIST()
1829{
8990e307
LW		 1830 return newOP(OP_STUB, 0);
1831}
1832
1833OP *
11343788
MB		 1834force_list(o)
1835OP *o;
8990e307 1836{
11343788
MB		 1837 if (!o || o->op_type != OP_LIST)
1838 o = newLISTOP(OP_LIST, 0, o, Nullop);
1839 null(o);
1840 return o;
79072805
LW		 1841}
1842
1843OP *
1844newLISTOP(type, flags, first, last)
1845I32 type;
1846I32 flags;
1847OP* first;
1848OP* last;
1849{
1850 LISTOP *listop;
1851
1852 Newz(1101, listop, 1, LISTOP);
1853
1854 listop->op_type = type;
1855 listop->op_ppaddr = ppaddr[type];
1856 listop->op_children = (first != 0) + (last != 0);
1857 listop->op_flags = flags;
79072805
LW		 1858
1859 if (!last && first)
1860 last = first;
1861 else if (!first && last)
1862 first = last;
8990e307
LW		 1863 else if (first)
1864 first->op_sibling = last;
79072805
LW		 1865 listop->op_first = first;
1866 listop->op_last = last;
8990e307
LW		 1867 if (type == OP_LIST) {
1868 OP* pushop;
1869 pushop = newOP(OP_PUSHMARK, 0);
1870 pushop->op_sibling = first;
1871 listop->op_first = pushop;
1872 listop->op_flags |= OPf_KIDS;
1873 if (!last)
1874 listop->op_last = pushop;
1875 }
1876 else if (listop->op_children)
1877 listop->op_flags |= OPf_KIDS;
79072805
LW		 1878
1879 return (OP*)listop;
1880}
1881
1882OP *
1883newOP(type, flags)
1884I32 type;
1885I32 flags;
1886{
11343788
MB		 1887 OP *o;
1888 Newz(1101, o, 1, OP);
1889 o->op_type = type;
1890 o->op_ppaddr = ppaddr[type];
1891 o->op_flags = flags;
79072805 1892
11343788
MB		 1893 o->op_next = o;
1894 o->op_private = 0 + (flags >> 8);
79072805 1895 if (opargs[type] & OA_RETSCALAR)
11343788 1896 scalar(o);
79072805 1897 if (opargs[type] & OA_TARGET)
11343788
MB		 1898 o->op_targ = pad_alloc(type, SVs_PADTMP);
1899 return CHECKOP(type, o);
79072805
LW		 1900}
1901
1902OP *
1903newUNOP(type, flags, first)
1904I32 type;
1905I32 flags;
1906OP* first;
1907{
1908 UNOP *unop;
1909
93a17b20
LW		 1910 if (!first)
1911 first = newOP(OP_STUB, 0);
8990e307
LW		 1912 if (opargs[type] & OA_MARK)
1913 first = force_list(first);
93a17b20 1914
79072805
LW		 1915 Newz(1101, unop, 1, UNOP);
1916 unop->op_type = type;
1917 unop->op_ppaddr = ppaddr[type];
1918 unop->op_first = first;
1919 unop->op_flags = flags | OPf_KIDS;
c07a80fd 1920 unop->op_private = 1 | (flags >> 8);
79072805 1921
e50aee73 1922 unop = (UNOP*) CHECKOP(type, unop);
79072805
LW		 1923 if (unop->op_next)
1924 return (OP*)unop;
1925
a0d0e21e 1926 return fold_constants((OP *) unop);
79072805
LW		 1927}
1928
1929OP *
1930newBINOP(type, flags, first, last)
1931I32 type;
1932I32 flags;
1933OP* first;
1934OP* last;
1935{
1936 BINOP *binop;
1937 Newz(1101, binop, 1, BINOP);
1938
1939 if (!first)
1940 first = newOP(OP_NULL, 0);
1941
1942 binop->op_type = type;
1943 binop->op_ppaddr = ppaddr[type];
1944 binop->op_first = first;
1945 binop->op_flags = flags | OPf_KIDS;
1946 if (!last) {
1947 last = first;
c07a80fd 1948 binop->op_private = 1 | (flags >> 8);
79072805
LW		 1949 }
1950 else {
c07a80fd 1951 binop->op_private = 2 | (flags >> 8);
79072805
LW		 1952 first->op_sibling = last;
1953 }
1954
e50aee73 1955 binop = (BINOP*)CHECKOP(type, binop);
79072805
LW		 1956 if (binop->op_next)
1957 return (OP*)binop;
1958
1959 binop->op_last = last = binop->op_first->op_sibling;
1960
a0d0e21e 1961 return fold_constants((OP *)binop);
79072805
LW		 1962}
1963
1964OP *
11343788
MB		 1965pmtrans(o, expr, repl)
1966OP *o;
79072805
LW		 1967OP *expr;
1968OP *repl;
1969{
79072805
LW		 1970 SV *tstr = ((SVOP*)expr)->op_sv;
1971 SV *rstr = ((SVOP*)repl)->op_sv;
463ee0b2
LW		 1972 STRLEN tlen;
1973 STRLEN rlen;
ec49126f 1974 register U8 *t = (U8*)SvPV(tstr, tlen);
1975 register U8 *r = (U8*)SvPV(rstr, rlen);
79072805
LW		 1976 register I32 i;
1977 register I32 j;
79072805
LW		 1978 I32 delete;
1979 I32 complement;
1980 register short *tbl;
1981
11343788
MB		 1982 tbl = (short*)cPVOPo->op_pv;
1983 complement = o->op_private & OPpTRANS_COMPLEMENT;
1984 delete = o->op_private & OPpTRANS_DELETE;
1985 /* squash = o->op_private & OPpTRANS_SQUASH; */
79072805
LW		 1986
1987 if (complement) {
1988 Zero(tbl, 256, short);
1989 for (i = 0; i < tlen; i++)
ec49126f 1990 tbl[t[i]] = -1;
79072805
LW		 1991 for (i = 0, j = 0; i < 256; i++) {
1992 if (!tbl[i]) {
1993 if (j >= rlen) {
1994 if (delete)
1995 tbl[i] = -2;
1996 else if (rlen)
ec49126f 1997 tbl[i] = r[j-1];
79072805
LW		 1998 else
1999 tbl[i] = i;
2000 }
2001 else
ec49126f 2002 tbl[i] = r[j++];
79072805
LW		 2003 }
2004 }
2005 }
2006 else {
2007 if (!rlen && !delete) {
2008 r = t; rlen = tlen;
2009 }
2010 for (i = 0; i < 256; i++)
2011 tbl[i] = -1;
2012 for (i = 0, j = 0; i < tlen; i++,j++) {
2013 if (j >= rlen) {
2014 if (delete) {
ec49126f 2015 if (tbl[t[i]] == -1)
2016 tbl[t[i]] = -2;
79072805
LW		 2017 continue;
2018 }
2019 --j;
2020 }
ec49126f 2021 if (tbl[t[i]] == -1)
2022 tbl[t[i]] = r[j];
79072805
LW		 2023 }
2024 }
2025 op_free(expr);
2026 op_free(repl);
2027
11343788 2028 return o;
79072805
LW		 2029}
2030
2031OP *
2032newPMOP(type, flags)
2033I32 type;
2034I32 flags;
2035{
11343788 2036 dTHR;
79072805
LW		 2037 PMOP *pmop;
2038
2039 Newz(1101, pmop, 1, PMOP);
2040 pmop->op_type = type;
2041 pmop->op_ppaddr = ppaddr[type];
2042 pmop->op_flags = flags;
c07a80fd 2043 pmop->op_private = 0 | (flags >> 8);
79072805 2044
36477c24 2045 if (hints & HINT_LOCALE)
2046 pmop->op_pmpermflags = (pmop->op_pmflags |= PMf_LOCALE);
2047
79072805 2048 /* link into pm list */
a0d0e21e 2049 if (type != OP_TRANS && curstash) {
79072805
LW		 2050 pmop->op_pmnext = HvPMROOT(curstash);
2051 HvPMROOT(curstash) = pmop;
2052 }
2053
2054 return (OP*)pmop;
2055}
2056
2057OP *
11343788
MB		 2058pmruntime(o, expr, repl)
2059OP *o;
79072805
LW		 2060OP *expr;
2061OP *repl;
2062{
2063 PMOP *pm;
2064 LOGOP *rcop;
2065
11343788
MB		 2066 if (o->op_type == OP_TRANS)
2067 return pmtrans(o, expr, repl);
79072805 2068
11343788 2069 pm = (PMOP*)o;
79072805
LW		 2070
2071 if (expr->op_type == OP_CONST) {
463ee0b2 2072 STRLEN plen;
79072805 2073 SV *pat = ((SVOP*)expr)->op_sv;
463ee0b2 2074 char *p = SvPV(pat, plen);
11343788 2075 if ((o->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
93a17b20 2076 sv_setpvn(pat, "\\s+", 3);
463ee0b2 2077 p = SvPV(pat, plen);
79072805
LW		 2078 pm->op_pmflags |= PMf_SKIPWHITE;
2079 }
e50aee73 2080 pm->op_pmregexp = pregcomp(p, p + plen, pm);
85e6fe83
LW		 2081 if (strEQ("\\s+", pm->op_pmregexp->precomp))
2082 pm->op_pmflags |= PMf_WHITE;
79072805
LW		 2083 hoistmust(pm);
2084 op_free(expr);
2085 }
2086 else {
463ee0b2
LW		 2087 if (pm->op_pmflags & PMf_KEEP)
2088 expr = newUNOP(OP_REGCMAYBE,0,expr);
2089
79072805
LW		 2090 Newz(1101, rcop, 1, LOGOP);
2091 rcop->op_type = OP_REGCOMP;
2092 rcop->op_ppaddr = ppaddr[OP_REGCOMP];
2093 rcop->op_first = scalar(expr);
2094 rcop->op_flags |= OPf_KIDS;
2095 rcop->op_private = 1;
11343788 2096 rcop->op_other = o;
79072805
LW		 2097
2098 /* establish postfix order */
463ee0b2
LW		 2099 if (pm->op_pmflags & PMf_KEEP) {
2100 LINKLIST(expr);
2101 rcop->op_next = expr;
2102 ((UNOP*)expr)->op_first->op_next = (OP*)rcop;
2103 }
2104 else {
2105 rcop->op_next = LINKLIST(expr);
2106 expr->op_next = (OP*)rcop;
2107 }
79072805 2108
11343788 2109 prepend_elem(o->op_type, scalar((OP*)rcop), o);
79072805
LW		 2110 }
2111
2112 if (repl) {
748a9306
LW		 2113 OP *curop;
2114 if (pm->op_pmflags & PMf_EVAL)
2115 curop = 0;
2116 else if (repl->op_type == OP_CONST)
2117 curop = repl;
79072805 2118 else {
79072805
LW		 2119 OP *lastop = 0;
2120 for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
2121 if (opargs[curop->op_type] & OA_DANGEROUS) {
2122 if (curop->op_type == OP_GV) {
2123 GV *gv = ((GVOP*)curop)->op_gv;
93a17b20 2124 if (strchr("&`'123456789+", *GvENAME(gv)))
79072805
LW		 2125 break;
2126 }
2127 else if (curop->op_type == OP_RV2CV)
2128 break;
2129 else if (curop->op_type == OP_RV2SV ||
2130 curop->op_type == OP_RV2AV ||
2131 curop->op_type == OP_RV2HV ||
2132 curop->op_type == OP_RV2GV) {
2133 if (lastop && lastop->op_type != OP_GV) /*funny deref?*/
2134 break;
2135 }
748a9306
LW		 2136 else if (curop->op_type == OP_PADSV ||
2137 curop->op_type == OP_PADAV ||
2138 curop->op_type == OP_PADHV ||
2139 curop->op_type == OP_PADANY) {
2140 /* is okay */
2141 }
79072805
LW		 2142 else
2143 break;
2144 }
2145 lastop = curop;
2146 }
748a9306
LW		 2147 }
2148 if (curop == repl) {
2149 pm->op_pmflags |= PMf_CONST; /* const for long enough */
4633a7c4 2150 pm->op_pmpermflags |= PMf_CONST; /* const for long enough */
11343788 2151 prepend_elem(o->op_type, scalar(repl), o);
748a9306
LW		 2152 }
2153 else {
2154 Newz(1101, rcop, 1, LOGOP);
2155 rcop->op_type = OP_SUBSTCONT;
2156 rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
2157 rcop->op_first = scalar(repl);
2158 rcop->op_flags |= OPf_KIDS;
2159 rcop->op_private = 1;
11343788 2160 rcop->op_other = o;
748a9306
LW		 2161
2162 /* establish postfix order */
2163 rcop->op_next = LINKLIST(repl);
2164 repl->op_next = (OP*)rcop;
2165
2166 pm->op_pmreplroot = scalar((OP*)rcop);
2167 pm->op_pmreplstart = LINKLIST(rcop);
2168 rcop->op_next = 0;
79072805
LW		 2169 }
2170 }
2171
2172 return (OP*)pm;
2173}
2174
2175OP *
2176newSVOP(type, flags, sv)
2177I32 type;
2178I32 flags;
2179SV *sv;
2180{
2181 SVOP *svop;
2182 Newz(1101, svop, 1, SVOP);
2183 svop->op_type = type;
2184 svop->op_ppaddr = ppaddr[type];
2185 svop->op_sv = sv;
2186 svop->op_next = (OP*)svop;
2187 svop->op_flags = flags;
2188 if (opargs[type] & OA_RETSCALAR)
463ee0b2 2189 scalar((OP*)svop);
79072805 2190 if (opargs[type] & OA_TARGET)
ed6116ce 2191 svop->op_targ = pad_alloc(type, SVs_PADTMP);
e50aee73 2192 return CHECKOP(type, svop);
79072805
LW		 2193}
2194
2195OP *
2196newGVOP(type, flags, gv)
2197I32 type;
2198I32 flags;
2199GV *gv;
2200{
11343788 2201 dTHR;
79072805
LW		 2202 GVOP *gvop;
2203 Newz(1101, gvop, 1, GVOP);
2204 gvop->op_type = type;
2205 gvop->op_ppaddr = ppaddr[type];
8990e307 2206 gvop->op_gv = (GV*)SvREFCNT_inc(gv);
79072805
LW		 2207 gvop->op_next = (OP*)gvop;
2208 gvop->op_flags = flags;
2209 if (opargs[type] & OA_RETSCALAR)
463ee0b2 2210 scalar((OP*)gvop);
79072805 2211 if (opargs[type] & OA_TARGET)
ed6116ce 2212 gvop->op_targ = pad_alloc(type, SVs_PADTMP);
e50aee73 2213 return CHECKOP(type, gvop);
79072805
LW		 2214}
2215
2216OP *
2217newPVOP(type, flags, pv)
2218I32 type;
2219I32 flags;
2220char *pv;
2221{
2222 PVOP *pvop;
2223 Newz(1101, pvop, 1, PVOP);
2224 pvop->op_type = type;
2225 pvop->op_ppaddr = ppaddr[type];
2226 pvop->op_pv = pv;
2227 pvop->op_next = (OP*)pvop;
2228 pvop->op_flags = flags;
2229 if (opargs[type] & OA_RETSCALAR)
463ee0b2 2230 scalar((OP*)pvop);
79072805 2231 if (opargs[type] & OA_TARGET)
ed6116ce 2232 pvop->op_targ = pad_alloc(type, SVs_PADTMP);
e50aee73 2233 return CHECKOP(type, pvop);
79072805
LW		 2234}
2235
79072805 2236void
11343788
MB		 2237package(o)
2238OP *o;
79072805 2239{
11343788 2240 dTHR;
93a17b20 2241 SV *sv;
79072805
LW		 2242
2243 save_hptr(&curstash);
2244 save_item(curstname);
11343788 2245 if (o) {
463ee0b2
LW		 2246 STRLEN len;
2247 char *name;
11343788 2248 sv = cSVOPo->op_sv;
463ee0b2 2249 name = SvPV(sv, len);
b1cb66bf 2250 curstash = gv_stashpvn(name,len,TRUE);
463ee0b2 2251 sv_setpvn(curstname, name, len);
11343788 2252 op_free(o);
93a17b20
LW		 2253 }
2254 else {
2255 sv_setpv(curstname,"<none>");
2256 curstash = Nullhv;
2257 }
79072805 2258 copline = NOLINE;
8990e307 2259 expect = XSTATE;
79072805
LW		 2260}
2261
85e6fe83 2262void
b1cb66bf 2263utilize(aver, floor, version, id, arg)
85e6fe83 2264int aver;
c07a80fd 2265I32 floor;
b1cb66bf 2266OP *version;
85e6fe83
LW		 2267OP *id;
2268OP *arg;
2269{
a0d0e21e
LW		 2270 OP *pack;
2271 OP *meth;
2272 OP *rqop;
2273 OP *imop;
b1cb66bf 2274 OP *veop;
85e6fe83 2275
a0d0e21e
LW		 2276 if (id->op_type != OP_CONST)
2277 croak("Module name must be constant");
85e6fe83 2278
b1cb66bf 2279 veop = Nullop;
2280
2281 if(version != Nullop) {
2282 SV *vesv = ((SVOP*)version)->op_sv;
2283
2284 if (arg == Nullop && !SvNIOK(vesv)) {
2285 arg = version;
2286 }
2287 else {
2288 OP *pack;
2289 OP *meth;
2290
2291 if (version->op_type != OP_CONST || !SvNIOK(vesv))
2292 croak("Version number must be constant number");
2293
2294 /* Make copy of id so we don't free it twice */
2295 pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
2296
2297 /* Fake up a method call to VERSION */
2298 meth = newSVOP(OP_CONST, 0, newSVpv("VERSION", 7));
2299 veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
2300 append_elem(OP_LIST,
2301 prepend_elem(OP_LIST, pack, list(version)),
2302 newUNOP(OP_METHOD, 0, meth)));
2303 }
2304 }
2305
a0d0e21e 2306 /* Fake up an import/unimport */
4633a7c4
LW		 2307 if (arg && arg->op_type == OP_STUB)
2308 imop = arg; /* no import on explicit () */
b1cb66bf 2309 else if(SvNIOK(((SVOP*)id)->op_sv)) {
2310 imop = Nullop; /* use 5.0; */
2311 }
4633a7c4
LW		 2312 else {
2313 /* Make copy of id so we don't free it twice */
2314 pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
4633a7c4
LW		 2315 meth = newSVOP(OP_CONST, 0,
2316 aver
2317 ? newSVpv("import", 6)
2318 : newSVpv("unimport", 8)
2319 );
2320 imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
a0d0e21e
LW		 2321 append_elem(OP_LIST,
2322 prepend_elem(OP_LIST, pack, list(arg)),
2323 newUNOP(OP_METHOD, 0, meth)));
4633a7c4
LW		 2324 }
2325
2326 /* Fake up a require */
2327 rqop = newUNOP(OP_REQUIRE, 0, id);
a0d0e21e
LW		 2328
2329 /* Fake up the BEGIN {}, which does its thing immediately. */
c07a80fd 2330 newSUB(floor,
a0d0e21e 2331 newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)),
4633a7c4 2332 Nullop,
a0d0e21e 2333 append_elem(OP_LINESEQ,
b1cb66bf 2334 append_elem(OP_LINESEQ,
2335 newSTATEOP(0, Nullch, rqop),
2336 newSTATEOP(0, Nullch, veop)),
a0d0e21e 2337 newSTATEOP(0, Nullch, imop) ));
85e6fe83 2338
85e6fe83
LW		 2339 copline = NOLINE;
2340 expect = XSTATE;
2341}
2342
79072805
LW		 2343OP *
2344newSLICEOP(flags, subscript, listval)
2345I32 flags;
2346OP *subscript;
2347OP *listval;
2348{
2349 return newBINOP(OP_LSLICE, flags,
8990e307
LW		 2350 list(force_list(subscript)),
2351 list(force_list(listval)) );
79072805
LW		 2352}
2353
2354static I32
11343788
MB		 2355list_assignment(o)
2356register OP *o;
79072805 2357{
11343788 2358 if (!o)
79072805
LW		 2359 return TRUE;
2360
11343788
MB		 2361 if (o->op_type == OP_NULL && o->op_flags & OPf_KIDS)
2362 o = cUNOPo->op_first;
79072805 2363
11343788
MB		 2364 if (o->op_type == OP_COND_EXPR) {
2365 I32 t = list_assignment(cCONDOPo->op_first->op_sibling);
2366 I32 f = list_assignment(cCONDOPo->op_first->op_sibling->op_sibling);
79072805
LW		 2367
2368 if (t && f)
2369 return TRUE;
2370 if (t || f)
2371 yyerror("Assignment to both a list and a scalar");
2372 return FALSE;
2373 }
2374
11343788
MB		 2375 if (o->op_type == OP_LIST || o->op_flags & OPf_PARENS ||
2376 o->op_type == OP_RV2AV || o->op_type == OP_RV2HV ||
2377 o->op_type == OP_ASLICE || o->op_type == OP_HSLICE)
79072805
LW		 2378 return TRUE;
2379
11343788 2380 if (o->op_type == OP_PADAV || o->op_type == OP_PADHV)
93a17b20
LW		 2381 return TRUE;
2382
11343788 2383 if (o->op_type == OP_RV2SV)
79072805
LW		 2384 return FALSE;
2385
2386 return FALSE;
2387}
2388
2389OP *
a0d0e21e 2390newASSIGNOP(flags, left, optype, right)
79072805
LW		 2391I32 flags;
2392OP *left;
a0d0e21e 2393I32 optype;
79072805
LW		 2394OP *right;
2395{
11343788 2396 OP *o;
79072805 2397
a0d0e21e
LW		 2398 if (optype) {
2399 if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) {
2400 return newLOGOP(optype, 0,
2401 mod(scalar(left), optype),
2402 newUNOP(OP_SASSIGN, 0, scalar(right)));
2403 }
2404 else {
2405 return newBINOP(optype, OPf_STACKED,
2406 mod(scalar(left), optype), scalar(right));
2407 }
2408 }
2409
79072805 2410 if (list_assignment(left)) {
463ee0b2 2411 modcount = 0;
748a9306 2412 eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
463ee0b2 2413 left = mod(left, OP_AASSIGN);
748a9306
LW		 2414 if (eval_start)
2415 eval_start = 0;
2416 else {
a0d0e21e
LW		 2417 op_free(left);
2418 op_free(right);
2419 return Nullop;
2420 }
11343788 2421 o = newBINOP(OP_AASSIGN, flags,
8990e307
LW		 2422 list(force_list(right)),
2423 list(force_list(left)) );
11343788 2424 o->op_private = 0 | (flags >> 8);
a0d0e21e 2425 if (!(left->op_private & OPpLVAL_INTRO)) {
748a9306 2426 static int generation = 100;
79072805 2427 OP *curop;
11343788 2428 OP *lastop = o;
79072805 2429 generation++;
11343788 2430 for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
79072805
LW		 2431 if (opargs[curop->op_type] & OA_DANGEROUS) {
2432 if (curop->op_type == OP_GV) {
2433 GV *gv = ((GVOP*)curop)->op_gv;
2434 if (gv == defgv || SvCUR(gv) == generation)
2435 break;
2436 SvCUR(gv) = generation;
2437 }
748a9306
LW		 2438 else if (curop->op_type == OP_PADSV ||
2439 curop->op_type == OP_PADAV ||
2440 curop->op_type == OP_PADHV ||
2441 curop->op_type == OP_PADANY) {
2442 SV **svp = AvARRAY(comppad_name);
8e07c86e 2443 SV *sv = svp[curop->op_targ];
748a9306
LW		 2444 if (SvCUR(sv) == generation)
2445 break;
2446 SvCUR(sv) = generation; /* (SvCUR not used any more) */
2447 }
79072805
LW		 2448 else if (curop->op_type == OP_RV2CV)
2449 break;
2450 else if (curop->op_type == OP_RV2SV ||
2451 curop->op_type == OP_RV2AV ||
2452 curop->op_type == OP_RV2HV ||
2453 curop->op_type == OP_RV2GV) {
2454 if (lastop->op_type != OP_GV) /* funny deref? */
2455 break;
2456 }
2457 else
2458 break;
2459 }
2460 lastop = curop;
2461 }
11343788
MB		 2462 if (curop != o)
2463 o->op_private = OPpASSIGN_COMMON;
79072805 2464 }
c07a80fd 2465 if (right && right->op_type == OP_SPLIT) {
2466 OP* tmpop;
2467 if ((tmpop = ((LISTOP*)right)->op_first) &&
2468 tmpop->op_type == OP_PUSHRE)
2469 {
2470 PMOP *pm = (PMOP*)tmpop;
2471 if (left->op_type == OP_RV2AV &&
2472 !(left->op_private & OPpLVAL_INTRO) &&
11343788 2473 !(o->op_private & OPpASSIGN_COMMON) )
c07a80fd 2474 {
2475 tmpop = ((UNOP*)left)->op_first;
2476 if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
2477 pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv;
2478 pm->op_pmflags |= PMf_ONCE;
11343788 2479 tmpop = cUNOPo->op_first; /* to list (nulled) */
c07a80fd 2480 tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
2481 tmpop->op_sibling = Nullop; /* don't free split */
2482 right->op_next = tmpop->op_next; /* fix starting loc */
11343788 2483 op_free(o); /* blow off assign */
54310121 2484 right->op_flags &= ~OPf_WANT;
a5f75d66 2485 /* "I don't know and I don't care." */
c07a80fd 2486 return right;
2487 }
2488 }
2489 else {
2490 if (modcount < 10000 &&
2491 ((LISTOP*)right)->op_last->op_type == OP_CONST)
2492 {
2493 SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
2494 if (SvIVX(sv) == 0)
2495 sv_setiv(sv, modcount+1);
2496 }
2497 }
2498 }
2499 }
11343788 2500 return o;
79072805
LW		 2501 }
2502 if (!right)
2503 right = newOP(OP_UNDEF, 0);
2504 if (right->op_type == OP_READLINE) {
2505 right->op_flags |= OPf_STACKED;
463ee0b2 2506 return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right));
79072805 2507 }
a0d0e21e 2508 else {
748a9306 2509 eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
11343788 2510 o = newBINOP(OP_SASSIGN, flags,
463ee0b2 2511 scalar(right), mod(scalar(left), OP_SASSIGN) );
748a9306
LW		 2512 if (eval_start)
2513 eval_start = 0;
2514 else {
11343788 2515 op_free(o);
a0d0e21e
LW		 2516 return Nullop;
2517 }
2518 }
11343788 2519 return o;
79072805
LW		 2520}
2521
2522OP *
11343788 2523newSTATEOP(flags, label, o)
79072805
LW		 2524I32 flags;
2525char *label;
11343788 2526OP *o;
79072805 2527{
11343788 2528 dTHR;
bbce6d69 2529 U32 seq = intro_my();
79072805
LW		 2530 register COP *cop;
2531
2532 Newz(1101, cop, 1, COP);
8990e307
LW		 2533 if (perldb && curcop->cop_line && curstash != debstash) {
2534 cop->op_type = OP_DBSTATE;
2535 cop->op_ppaddr = ppaddr[ OP_DBSTATE ];
2536 }
2537 else {
2538 cop->op_type = OP_NEXTSTATE;
2539 cop->op_ppaddr = ppaddr[ OP_NEXTSTATE ];
2540 }
79072805 2541 cop->op_flags = flags;
c07a80fd 2542 cop->op_private = 0 | (flags >> 8);
ff0cee69 2543#ifdef NATIVE_HINTS
2544 cop->op_private |= NATIVE_HINTS;
2545#endif
79072805
LW		 2546 cop->op_next = (OP*)cop;
2547
463ee0b2
LW		 2548 if (label) {
2549 cop->cop_label = label;
85e6fe83 2550 hints |= HINT_BLOCK_SCOPE;
463ee0b2 2551 }
bbce6d69 2552 cop->cop_seq = seq;
a0d0e21e 2553 cop->cop_arybase = curcop->cop_arybase;
79072805
LW		 2554
2555 if (copline == NOLINE)
2556 cop->cop_line = curcop->cop_line;
2557 else {
2558 cop->cop_line = copline;
2559 copline = NOLINE;
2560 }
44a8e56a 2561 cop->cop_filegv = (GV*)SvREFCNT_inc(curcop->cop_filegv);
79072805
LW		 2562 cop->cop_stash = curstash;
2563
8990e307 2564 if (perldb && curstash != debstash) {
93a17b20
LW		 2565 SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE);
2566 if (svp && *svp != &sv_undef && !SvIOK(*svp)) {
a0d0e21e 2567 (void)SvIOK_on(*svp);
a5f75d66 2568 SvIVX(*svp) = 1;
93a17b20
LW		 2569 SvSTASH(*svp) = (HV*)cop;
2570 }
2571 }
2572
11343788 2573 return prepend_elem(OP_LINESEQ, (OP*)cop, o);
79072805
LW		 2574}
2575
bbce6d69 2576/* "Introduce" my variables to visible status. */
2577U32
2578intro_my()
2579{
2580 SV **svp;
2581 SV *sv;
2582 I32 i;
2583
2584 if (! min_intro_pending)
2585 return cop_seqmax;
2586
2587 svp = AvARRAY(comppad_name);
2588 for (i = min_intro_pending; i <= max_intro_pending; i++) {
2589 if ((sv = svp[i]) && sv != &sv_undef && !SvIVX(sv)) {
2590 SvIVX(sv) = 999999999; /* Don't know scope end yet. */
2591 SvNVX(sv) = (double)cop_seqmax;
2592 }
2593 }
2594 min_intro_pending = 0;
2595 comppad_name_fill = max_intro_pending; /* Needn't search higher */
2596 return cop_seqmax++;
2597}
2598
79072805
LW		 2599OP *
2600newLOGOP(type, flags, first, other)
2601I32 type;
2602I32 flags;
2603OP* first;
2604OP* other;
2605{
11343788 2606 dTHR;
79072805 2607 LOGOP *logop;
11343788 2608 OP *o;
79072805 2609
a0d0e21e
LW		 2610 if (type == OP_XOR) /* Not short circuit, but here by precedence. */
2611 return newBINOP(type, flags, scalar(first), scalar(other));
2612
8990e307 2613 scalarboolean(first);
79072805
LW		 2614 /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
2615 if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) {
2616 if (type == OP_AND || type == OP_OR) {
2617 if (type == OP_AND)
2618 type = OP_OR;
2619 else
2620 type = OP_AND;
11343788
MB		 2621 o = first;
2622 first = cUNOPo->op_first;
2623 if (o->op_next)
2624 first->op_next = o->op_next;
2625 cUNOPo->op_first = Nullop;
2626 op_free(o);
79072805
LW		 2627 }
2628 }
2629 if (first->op_type == OP_CONST) {
93a17b20 2630 if (dowarn && (first->op_private & OPpCONST_BARE))
c07a80fd 2631 warn("Probable precedence problem on %s", op_desc[type]);
79072805
LW		 2632 if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
2633 op_free(first);
2634 return other;
2635 }
2636 else {
2637 op_free(other);
2638 return first;
2639 }
2640 }
2641 else if (first->op_type == OP_WANTARRAY) {
2642 if (type == OP_AND)
2643 list(other);
2644 else
2645 scalar(other);
2646 }
a6006777 2647 else if (dowarn && (first->op_flags & OPf_KIDS)) {
2648 OP *k1 = ((UNOP*)first)->op_first;
2649 OP *k2 = k1->op_sibling;
2650 OPCODE warnop = 0;
2651 switch (first->op_type)
2652 {
2653 case OP_NULL:
2654 if (k2 && k2->op_type == OP_READLINE
2655 && (k2->op_flags & OPf_STACKED)
2656 && (k1->op_type == OP_RV2SV || k1->op_type == OP_PADSV))
2657 warnop = k2->op_type;
2658 break;
2659
2660 case OP_SASSIGN:
68dc0745 2661 if (k1->op_type == OP_READDIR
2662 || k1->op_type == OP_GLOB
2663 || k1->op_type == OP_EACH)
a6006777 2664 warnop = k1->op_type;
2665 break;
2666 }
8ebc5c01 2667 if (warnop) {
2668 line_t oldline = curcop->cop_line;
2669 curcop->cop_line = copline;
68dc0745 2670 warn("Value of %s%s can be \"0\"; test with defined()",
2671 op_desc[warnop],
2672 ((warnop == OP_READLINE || warnop == OP_GLOB)
2673 ? " construct" : "() operator"));
2674 curcop->cop_line = oldline;
8ebc5c01 2675 }
a6006777 2676 }
79072805
LW		 2677
2678 if (!other)
2679 return first;
2680
a0d0e21e
LW		 2681 if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
2682 other->op_private |= OPpASSIGN_BACKWARDS; /* other is an OP_SASSIGN */
2683
79072805
LW		 2684 Newz(1101, logop, 1, LOGOP);
2685
2686 logop->op_type = type;
2687 logop->op_ppaddr = ppaddr[type];
2688 logop->op_first = first;
2689 logop->op_flags = flags | OPf_KIDS;
2690 logop->op_other = LINKLIST(other);
c07a80fd 2691 logop->op_private = 1 | (flags >> 8);
79072805
LW		 2692
2693 /* establish postfix order */
2694 logop->op_next = LINKLIST(first);
2695 first->op_next = (OP*)logop;
2696 first->op_sibling = other;
2697
11343788
MB		 2698 o = newUNOP(OP_NULL, 0, (OP*)logop);
2699 other->op_next = o;
79072805 2700
11343788 2701 return o;
79072805
LW		 2702}
2703
2704OP *
b1cb66bf 2705newCONDOP(flags, first, trueop, falseop)
79072805
LW		 2706I32 flags;
2707OP* first;
b1cb66bf 2708OP* trueop;
2709OP* falseop;
79072805 2710{
11343788 2711 dTHR;
79072805 2712 CONDOP *condop;
11343788 2713 OP *o;
79072805 2714
b1cb66bf 2715 if (!falseop)
2716 return newLOGOP(OP_AND, 0, first, trueop);
2717 if (!trueop)
2718 return newLOGOP(OP_OR, 0, first, falseop);
79072805 2719
8990e307 2720 scalarboolean(first);
79072805
LW		 2721 if (first->op_type == OP_CONST) {
2722 if (SvTRUE(((SVOP*)first)->op_sv)) {
2723 op_free(first);
b1cb66bf 2724 op_free(falseop);
2725 return trueop;
79072805
LW		 2726 }
2727 else {
2728 op_free(first);
b1cb66bf 2729 op_free(trueop);
2730 return falseop;
79072805
LW		 2731 }
2732 }
2733 else if (first->op_type == OP_WANTARRAY) {
b1cb66bf 2734 list(trueop);
2735 scalar(falseop);
79072805
LW		 2736 }
2737 Newz(1101, condop, 1, CONDOP);
2738
2739 condop->op_type = OP_COND_EXPR;
2740 condop->op_ppaddr = ppaddr[OP_COND_EXPR];
2741 condop->op_first = first;
2742 condop->op_flags = flags | OPf_KIDS;
b1cb66bf 2743 condop->op_true = LINKLIST(trueop);
2744 condop->op_false = LINKLIST(falseop);
c07a80fd 2745 condop->op_private = 1 | (flags >> 8);
79072805
LW		 2746
2747 /* establish postfix order */
2748 condop->op_next = LINKLIST(first);
2749 first->op_next = (OP*)condop;
2750
b1cb66bf 2751 first->op_sibling = trueop;
2752 trueop->op_sibling = falseop;
11343788 2753 o = newUNOP(OP_NULL, 0, (OP*)condop);
79072805 2754
5dc0d613
MB		 2755 trueop->op_next = o;
2756 falseop->op_next = o;
79072805 2757
11343788 2758 return o;
79072805
LW		 2759}
2760
2761OP *
2762newRANGE(flags, left, right)
2763I32 flags;
2764OP *left;
2765OP *right;
2766{
b35b2403 2767 dTHR;
79072805
LW		 2768 CONDOP *condop;
2769 OP *flip;
2770 OP *flop;
11343788 2771 OP *o;
79072805
LW		 2772
2773 Newz(1101, condop, 1, CONDOP);
2774
2775 condop->op_type = OP_RANGE;
2776 condop->op_ppaddr = ppaddr[OP_RANGE];
2777 condop->op_first = left;
2778 condop->op_flags = OPf_KIDS;
2779 condop->op_true = LINKLIST(left);
2780 condop->op_false = LINKLIST(right);
c07a80fd 2781 condop->op_private = 1 | (flags >> 8);
79072805
LW		 2782
2783 left->op_sibling = right;
2784
2785 condop->op_next = (OP*)condop;
2786 flip = newUNOP(OP_FLIP, flags, (OP*)condop);
2787 flop = newUNOP(OP_FLOP, 0, flip);
11343788 2788 o = newUNOP(OP_NULL, 0, flop);
79072805
LW		 2789 linklist(flop);
2790
2791 left->op_next = flip;
2792 right->op_next = flop;
2793
ed6116ce 2794 condop->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
79072805 2795 sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV);
ed6116ce 2796 flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
79072805
LW		 2797 sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
2798
2799 flip->op_private = left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
2800 flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
2801
11343788 2802 flip->op_next = o;
79072805 2803 if (!flip->op_private || !flop->op_private)
11343788 2804 linklist(o); /* blow off optimizer unless constant */
79072805 2805
11343788 2806 return o;
79072805
LW		 2807}
2808
2809OP *
2810newLOOPOP(flags, debuggable, expr, block)
2811I32 flags;
2812I32 debuggable;
2813OP *expr;
2814OP *block;
2815{
11343788 2816 dTHR;
463ee0b2 2817 OP* listop;
11343788 2818 OP* o;
463ee0b2 2819 int once = block && block->op_flags & OPf_SPECIAL &&
a0d0e21e 2820 (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
93a17b20 2821
463ee0b2
LW		 2822 if (expr) {
2823 if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
2824 return block; /* do {} while 0 does once */
774d564b 2825 if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB) {
2826 expr = newUNOP(OP_DEFINED, 0,
2827 newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
2828 }
463ee0b2 2829 }
93a17b20 2830
8990e307 2831 listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
11343788 2832 o = newLOGOP(OP_AND, 0, expr, listop);
463ee0b2 2833
11343788 2834 ((LISTOP*)listop)->op_last->op_next = LINKLIST(o);
79072805 2835
11343788
MB		 2836 if (once && o != listop)
2837 o->op_next = ((LOGOP*)cUNOPo->op_first)->op_other;
79072805 2838
11343788
MB		 2839 if (o == listop)
2840 o = newUNOP(OP_NULL, 0, o); /* or do {} while 1 loses outer block */
748a9306 2841
11343788
MB		 2842 o->op_flags |= flags;
2843 o = scope(o);
2844 o->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/
2845 return o;
79072805
LW		 2846}
2847
2848OP *
2849newWHILEOP(flags, debuggable, loop, expr, block, cont)
2850I32 flags;
2851I32 debuggable;
2852LOOP *loop;
2853OP *expr;
2854OP *block;
2855OP *cont;
2856{
11343788 2857 dTHR;
79072805
LW		 2858 OP *redo;
2859 OP *next = 0;
2860 OP *listop;
11343788 2861 OP *o;
79072805
LW		 2862 OP *condop;
2863
748a9306
LW		 2864 if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) {
2865 expr = newUNOP(OP_DEFINED, 0,
2866 newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
2867 }
79072805
LW		 2868
2869 if (!block)
2870 block = newOP(OP_NULL, 0);
2871
2872 if (cont)
2873 next = LINKLIST(cont);
2874 if (expr)
2875 cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
2876
463ee0b2 2877 listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
79072805
LW		 2878 redo = LINKLIST(listop);
2879
2880 if (expr) {
11343788
MB		 2881 o = newLOGOP(OP_AND, 0, expr, scalar(listop));
2882 if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) {
85e6fe83 2883 op_free(expr); /* oops, it's a while (0) */
463ee0b2
LW		 2884 op_free((OP*)loop);
2885 return Nullop; /* (listop already freed by newLOGOP) */
2886 }
79072805 2887 ((LISTOP*)listop)->op_last->op_next = condop =
11343788 2888 (o == listop ? redo : LINKLIST(o));
79072805
LW		 2889 if (!next)
2890 next = condop;
2891 }
2892 else
11343788 2893 o = listop;
79072805
LW		 2894
2895 if (!loop) {
2896 Newz(1101,loop,1,LOOP);
2897 loop->op_type = OP_ENTERLOOP;
2898 loop->op_ppaddr = ppaddr[OP_ENTERLOOP];
2899 loop->op_private = 0;
2900 loop->op_next = (OP*)loop;
2901 }
2902
11343788 2903 o = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, o);
79072805
LW		 2904
2905 loop->op_redoop = redo;
11343788 2906 loop->op_lastop = o;
79072805
LW		 2907
2908 if (next)
2909 loop->op_nextop = next;
2910 else
11343788 2911 loop->op_nextop = o;
79072805 2912
11343788
MB		 2913 o->op_flags |= flags;
2914 o->op_private |= (flags >> 8);
2915 return o;
79072805
LW		 2916}
2917
2918OP *
a0d0e21e 2919#ifndef CAN_PROTOTYPE
79072805
LW		 2920newFOROP(flags,label,forline,sv,expr,block,cont)
2921I32 flags;
2922char *label;
2923line_t forline;
2924OP* sv;
2925OP* expr;
2926OP*block;
2927OP*cont;
8990e307
LW		 2928#else
2929newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
a0d0e21e 2930#endif /* CAN_PROTOTYPE */
79072805
LW		 2931{
2932 LOOP *loop;
85e6fe83 2933 int padoff = 0;
4633a7c4 2934 I32 iterflags = 0;
79072805
LW		 2935
2936 copline = forline;
2937 if (sv) {
85e6fe83 2938 if (sv->op_type == OP_RV2SV) { /* symbol table variable */
748a9306
LW		 2939 sv->op_type = OP_RV2GV;
2940 sv->op_ppaddr = ppaddr[OP_RV2GV];
79072805 2941 }
85e6fe83
LW		 2942 else if (sv->op_type == OP_PADSV) { /* private variable */
2943 padoff = sv->op_targ;
2944 op_free(sv);
2945 sv = Nullop;
2946 }
79072805 2947 else
c07a80fd 2948 croak("Can't use %s for loop variable", op_desc[sv->op_type]);
79072805
LW		 2949 }
2950 else {
2951 sv = newGVOP(OP_GV, 0, defgv);
2952 }
5f05dabc 2953 if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
4633a7c4
LW		 2954 expr = scalar(ref(expr, OP_ITER));
2955 iterflags |= OPf_STACKED;
2956 }
2957 loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
a0d0e21e
LW		 2958 append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART),
2959 scalar(sv))));
85e6fe83
LW		 2960 assert(!loop->op_next);
2961 Renew(loop, 1, LOOP);
2962 loop->op_targ = padoff;
2963 return newSTATEOP(0, label, newWHILEOP(flags, 1, loop,
2964 newOP(OP_ITER, 0), block, cont));
79072805
LW		 2965}
2966
8990e307
LW		 2967OP*
2968newLOOPEX(type, label)
2969I32 type;
2970OP* label;
2971{
11343788
MB		 2972 dTHR;
2973 OP *o;
8990e307 2974 if (type != OP_GOTO || label->op_type == OP_CONST) {
11343788 2975 o = newPVOP(type, 0, savepv(
a0d0e21e
LW		 2976 label->op_type == OP_CONST
2977 ? SvPVx(((SVOP*)label)->op_sv, na)
2978 : "" ));
8990e307
LW		 2979 op_free(label);
2980 }
2981 else {
a0d0e21e
LW		 2982 if (label->op_type == OP_ENTERSUB)
2983 label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
11343788 2984 o = newUNOP(type, OPf_STACKED, label);
8990e307 2985 }
85e6fe83 2986 hints |= HINT_BLOCK_SCOPE;
11343788 2987 return o;
8990e307
LW		 2988}
2989
79072805 2990void
85e6fe83 2991cv_undef(cv)
79072805
LW		 2992CV *cv;
2993{
11343788
MB		 2994 dTHR;
2995#ifdef USE_THREADS
e858de61
MB		 2996 if (CvMUTEXP(cv)) {
2997 MUTEX_DESTROY(CvMUTEXP(cv));
2998 Safefree(CvMUTEXP(cv));
2999 CvMUTEXP(cv) = 0;
3000 }
11343788
MB		 3001 if (CvCONDP(cv)) {
3002 COND_DESTROY(CvCONDP(cv));
3003 Safefree(CvCONDP(cv));
e858de61 3004 CvCONDP(cv) = 0;
11343788
MB		 3005 }
3006#endif /* USE_THREADS */
3007
a0d0e21e 3008 if (!CvXSUB(cv) && CvROOT(cv)) {
11343788
MB		 3009#ifdef USE_THREADS
3010 if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr))
3011 croak("Can't undef active subroutine");
3012#else
a0d0e21e
LW		 3013 if (CvDEPTH(cv))
3014 croak("Can't undef active subroutine");
11343788 3015#endif /* USE_THREADS */
8990e307 3016 ENTER;
a0d0e21e
LW		 3017
3018 SAVESPTR(curpad);
3019 curpad = 0;
3020
a5f75d66 3021 if (!CvCLONED(cv))
748a9306 3022 op_free(CvROOT(cv));
79072805 3023 CvROOT(cv) = Nullop;
8990e307 3024 LEAVE;
79072805 3025 }
1d5db326 3026 SvPOK_off((SV*)cv); /* forget prototype */
44a8e56a 3027 CvFLAGS(cv) = 0;
8e07c86e
AD		 3028 SvREFCNT_dec(CvGV(cv));
3029 CvGV(cv) = Nullgv;
3030 SvREFCNT_dec(CvOUTSIDE(cv));
3031 CvOUTSIDE(cv) = Nullcv;
3032 if (CvPADLIST(cv)) {
8ebc5c01 3033 /* may be during global destruction */
3034 if (SvREFCNT(CvPADLIST(cv))) {
3035 I32 i = AvFILL(CvPADLIST(cv));
3036 while (i >= 0) {
3037 SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
46fc3d4c 3038 SV* sv = svp ? *svp : Nullsv;
3039 if (!sv)
3040 continue;
3041 if (sv == (SV*)comppad_name)
3042 comppad_name = Nullav;
3043 else if (sv == (SV*)comppad) {
3044 comppad = Nullav;
3045 curpad = Null(SV**);
3046 }
3047 SvREFCNT_dec(sv);
8ebc5c01 3048 }
3049 SvREFCNT_dec((SV*)CvPADLIST(cv));
8e07c86e 3050 }
8e07c86e
AD		 3051 CvPADLIST(cv) = Nullav;
3052 }
79072805
LW		 3053}
3054
5f05dabc 3055#ifdef DEBUG_CLOSURES
3056static void
3057cv_dump(cv)
3058CV* cv;
3059{
3060 CV *outside = CvOUTSIDE(cv);
3061 AV* padlist = CvPADLIST(cv);
4fdae800 3062 AV* pad_name;
3063 AV* pad;
3064 SV** pname;
3065 SV** ppad;
5f05dabc 3066 I32 ix;
3067
3068 PerlIO_printf(Perl_debug_log, "\tCV=0x%p (%s), OUTSIDE=0x%p (%s)\n",
ab50184a
CS		 3069 cv,
3070 (CvANON(cv) ? "ANON"
3071 : (cv == main_cv) ? "MAIN"
07055b4c 3072 : CvUNIQUE(outside) ? "UNIQUE"
44a8e56a 3073 : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
ab50184a
CS		 3074 outside,
3075 (!outside ? "null"
3076 : CvANON(outside) ? "ANON"
3077 : (outside == main_cv) ? "MAIN"
07055b4c 3078 : CvUNIQUE(outside) ? "UNIQUE"
44a8e56a 3079 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
5f05dabc 3080
4fdae800 3081 if (!padlist)
3082 return;
3083
3084 pad_name = (AV*)*av_fetch(padlist, 0, FALSE);
3085 pad = (AV*)*av_fetch(padlist, 1, FALSE);
3086 pname = AvARRAY(pad_name);
3087 ppad = AvARRAY(pad);
3088
9607fc9c 3089 for (ix = 1; ix <= AvFILL(pad_name); ix++) {
5f05dabc 3090 if (SvPOK(pname[ix]))
4fdae800 3091 PerlIO_printf(Perl_debug_log, "\t%4d. 0x%p (%s\"%s\" %ld-%ld)\n",
3092 ix, ppad[ix],
3093 SvFAKE(pname[ix]) ? "FAKE " : "",
3094 SvPVX(pname[ix]),
ab50184a
CS		 3095 (long)I_32(SvNVX(pname[ix])),
3096 (long)SvIVX(pname[ix]));
5f05dabc 3097 }
3098}
3099#endif /* DEBUG_CLOSURES */
3100
3101static CV *
3102cv_clone2(proto, outside)
748a9306 3103CV* proto;
5f05dabc 3104CV* outside;
748a9306 3105{
11343788 3106 dTHR;
748a9306
LW		 3107 AV* av;
3108 I32 ix;
3109 AV* protopadlist = CvPADLIST(proto);
3110 AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
3111 AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
5f05dabc 3112 SV** pname = AvARRAY(protopad_name);
3113 SV** ppad = AvARRAY(protopad);
9607fc9c 3114 I32 fname = AvFILL(protopad_name);
3115 I32 fpad = AvFILL(protopad);
748a9306
LW		 3116 AV* comppadlist;
3117 CV* cv;
3118
07055b4c
CS		 3119 assert(!CvUNIQUE(proto));
3120
748a9306
LW		 3121 ENTER;
3122 SAVESPTR(curpad);
3123 SAVESPTR(comppad);
46fc3d4c 3124 SAVESPTR(comppad_name);
748a9306
LW		 3125 SAVESPTR(compcv);
3126
3127 cv = compcv = (CV*)NEWSV(1104,0);
fa83b5b6 3128 sv_upgrade((SV *)cv, SvTYPE(proto));
a5f75d66 3129 CvCLONED_on(cv);
5f05dabc 3130 if (CvANON(proto))
3131 CvANON_on(cv);
748a9306 3132
11343788 3133#ifdef USE_THREADS
12ca11f6 3134 New(666, CvMUTEXP(cv), 1, perl_mutex);
11343788 3135 MUTEX_INIT(CvMUTEXP(cv));
12ca11f6 3136 New(666, CvCONDP(cv), 1, perl_cond);
11343788
MB		 3137 COND_INIT(CvCONDP(cv));
3138 CvOWNER(cv) = 0;
3139#endif /* USE_THREADS */
748a9306 3140 CvFILEGV(cv) = CvFILEGV(proto);
44a8e56a 3141 CvGV(cv) = (GV*)SvREFCNT_inc(CvGV(proto));
748a9306
LW		 3142 CvSTASH(cv) = CvSTASH(proto);
3143 CvROOT(cv) = CvROOT(proto);
3144 CvSTART(cv) = CvSTART(proto);
5f05dabc 3145 if (outside)
3146 CvOUTSIDE(cv) = (CV*)SvREFCNT_inc(outside);
748a9306 3147
68dc0745 3148 if (SvPOK(proto))
3149 sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
3150
46fc3d4c 3151 comppad_name = newAV();
3152 for (ix = fname; ix >= 0; ix--)
3153 av_store(comppad_name, ix, SvREFCNT_inc(pname[ix]));
748a9306
LW		 3154
3155 comppad = newAV();
3156
3157 comppadlist = newAV();
3158 AvREAL_off(comppadlist);
46fc3d4c 3159 av_store(comppadlist, 0, (SV*)comppad_name);
b355b4e0 3160 av_store(comppadlist, 1, (SV*)comppad);
748a9306 3161 CvPADLIST(cv) = comppadlist;
5f05dabc 3162 av_fill(comppad, AvFILL(protopad));
748a9306
LW		 3163 curpad = AvARRAY(comppad);
3164
3165 av = newAV(); /* will be @_ */
3166 av_extend(av, 0);
3167 av_store(comppad, 0, (SV*)av);
3168 AvFLAGS(av) = AVf_REIFY;
3169
9607fc9c 3170 for (ix = fpad; ix > 0; ix--) {
3171 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
aa689395 3172 if (namesv && namesv != &sv_undef) {
3173 char *name = SvPVX(namesv); /* XXX */
3174 if (SvFLAGS(namesv) & SVf_FAKE) { /* lexical from outside? */
3175 I32 off = pad_findlex(name, ix, SvIVX(namesv),
5f05dabc 3176 CvOUTSIDE(cv), cxstack_ix);
3177 if (!off)
3178 curpad[ix] = SvREFCNT_inc(ppad[ix]);
3179 else if (off != ix)
748a9306
LW		 3180 croak("panic: cv_clone: %s", name);
3181 }
3182 else { /* our own lexical */
aa689395 3183 SV* sv;
5f05dabc 3184 if (*name == '&') {
3185 /* anon code -- we'll come back for it */
3186 sv = SvREFCNT_inc(ppad[ix]);
3187 }
3188 else if (*name == '@')
3189 sv = (SV*)newAV();
748a9306 3190 else if (*name == '%')
5f05dabc 3191 sv = (SV*)newHV();
748a9306 3192 else
5f05dabc 3193 sv = NEWSV(0,0);
3194 if (!SvPADBUSY(sv))
3195 SvPADMY_on(sv);
3196 curpad[ix] = sv;
748a9306
LW		 3197 }
3198 }
3199 else {
aa689395 3200 SV* sv = NEWSV(0,0);
748a9306 3201 SvPADTMP_on(sv);
5f05dabc 3202 curpad[ix] = sv;
748a9306
LW		 3203 }
3204 }
3205
5f05dabc 3206 /* Now that vars are all in place, clone nested closures. */
3207
9607fc9c 3208 for (ix = fpad; ix > 0; ix--) {
3209 SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
aa689395 3210 if (namesv
3211 && namesv != &sv_undef
3212 && !(SvFLAGS(namesv) & SVf_FAKE)
3213 && *SvPVX(namesv) == '&'
5f05dabc 3214 && CvCLONE(ppad[ix]))
3215 {
3216 CV *kid = cv_clone2((CV*)ppad[ix], cv);
3217 SvREFCNT_dec(ppad[ix]);
3218 CvCLONE_on(kid);
3219 SvPADMY_on(kid);
3220 curpad[ix] = (SV*)kid;
748a9306
LW		 3221 }
3222 }
3223
5f05dabc 3224#ifdef DEBUG_CLOSURES
ab50184a
CS		 3225 PerlIO_printf(Perl_debug_log, "Cloned inside:\n");
3226 cv_dump(outside);
3227 PerlIO_printf(Perl_debug_log, " from:\n");
5f05dabc 3228 cv_dump(proto);
ab50184a 3229 PerlIO_printf(Perl_debug_log, " to:\n");
5f05dabc 3230 cv_dump(cv);
3231#endif
3232
748a9306
LW		 3233 LEAVE;
3234 return cv;
3235}
3236
3237CV *
5f05dabc 3238cv_clone(proto)
3239CV* proto;
3240{
3241 return cv_clone2(proto, CvOUTSIDE(proto));
3242}
3243
3fe9a6f1 3244void
3245cv_ckproto(cv, gv, p)
3246CV* cv;
3247GV* gv;
3248char* p;
3249{
3250 if ((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX(cv)))) {
46fc3d4c 3251 SV* msg = sv_newmortal();
3fe9a6f1 3252 SV* name = Nullsv;
3253
3254 if (gv)
46fc3d4c 3255 gv_efullname3(name = sv_newmortal(), gv, Nullch);
3256 sv_setpv(msg, "Prototype mismatch:");
3257 if (name)
fc36a67e 3258 sv_catpvf(msg, " sub %_", name);
3fe9a6f1 3259 if (SvPOK(cv))
46fc3d4c 3260 sv_catpvf(msg, " (%s)", SvPVX(cv));
3261 sv_catpv(msg, " vs ");
3262 if (p)
3263 sv_catpvf(msg, "(%s)", p);
3264 else
3265 sv_catpv(msg, "none");
fc36a67e 3266 warn("%_", msg);
3fe9a6f1 3267 }
3268}
3269
760ac839
LW		 3270SV *
3271cv_const_sv(cv)
3fe9a6f1 3272CV* cv;
760ac839
LW		 3273{
3274 OP *o;
54310121 3275 SV *sv;
760ac839 3276
54310121 3277 if (!cv || !SvPOK(cv) || SvCUR(cv))
3278 return Nullsv;
760ac839 3279
54310121 3280 sv = Nullsv;
3281 for (o = CvSTART(cv); o; o = o->op_next) {
3282 OPCODE type = o->op_type;
3283
3284 if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
3285 continue;
3286 if (type == OP_LEAVESUB || type == OP_RETURN)
3287 break;
3288 if (sv)
3289 return Nullsv;
3290 if (type == OP_CONST)
5dc0d613 3291 sv = cSVOPo->op_sv;
54310121 3292 else if (type == OP_PADSV) {
e858de61
MB		 3293 AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]);
3294 sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv;
5aabfad6 3295 if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1))
54310121 3296 return Nullsv;
760ac839 3297 }
54310121 3298 else
3299 return Nullsv;
760ac839 3300 }
5aabfad6 3301 if (sv)
3302 SvREADONLY_on(sv);
760ac839
LW		 3303 return sv;
3304}
3305
748a9306 3306CV *
11343788 3307newSUB(floor,o,proto,block)
79072805 3308I32 floor;
11343788 3309OP *o;
4633a7c4 3310OP *proto;
79072805
LW		 3311OP *block;
3312{
11343788 3313 dTHR;
5dc0d613 3314 char *name = o ? SvPVx(cSVOPo->op_sv, na) : Nullch;
44a8e56a 3315 GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
3fe9a6f1 3316 char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch;
79072805 3317 register CV *cv;
a0d0e21e 3318 I32 ix;
79072805 3319
11343788 3320 if (o)
5dc0d613 3321 SAVEFREEOP(o);
3fe9a6f1 3322 if (proto)
3323 SAVEFREEOP(proto);
3324
68dc0745 3325 if (!name || GvCVGEN(gv))
3326 cv = Nullcv;
3327 else if (cv = GvCV(gv)) {
3fe9a6f1 3328 cv_ckproto(cv, gv, ps);
68dc0745 3329 /* already defined (or promised)? */
3330 if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
3331 SV* const_sv;
aa689395 3332 if (!block) {
3333 /* just a "sub foo;" when &foo is already defined */
3334 SAVEFREESV(compcv);
3335 goto done;
3336 }
7bac28a0 3337 /* ahem, death to those who redefine active sort subs */
3338 if (curstack == sortstack && sortcop == CvSTART(cv))
3339 croak("Can't redefine active sort subroutine %s", name);
68dc0745 3340 const_sv = cv_const_sv(cv);
44a8e56a 3341 if (const_sv || dowarn) {
79072805 3342 line_t oldline = curcop->cop_line;
79072805 3343 curcop->cop_line = copline;
760ac839 3344 warn(const_sv ? "Constant subroutine %s redefined"
68dc0745 3345 : "Subroutine %s redefined", name);
79072805
LW		 3346 curcop->cop_line = oldline;
3347 }
8990e307 3348 SvREFCNT_dec(cv);
68dc0745 3349 cv = Nullcv;
79072805
LW		 3350 }
3351 }
a0d0e21e 3352 if (cv) { /* must reuse cv if autoloaded */
4633a7c4 3353 cv_undef(cv);
44a8e56a 3354 CvFLAGS(cv) = CvFLAGS(compcv);
748a9306 3355 CvOUTSIDE(cv) = CvOUTSIDE(compcv);
e9a444f0 3356 CvOUTSIDE(compcv) = 0;
748a9306 3357 CvPADLIST(cv) = CvPADLIST(compcv);
4aa0a1f7 3358 CvPADLIST(compcv) = 0;
4633a7c4
LW		 3359 if (SvREFCNT(compcv) > 1) /* XXX Make closures transit through stub. */
3360 CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)cv);
748a9306 3361 SvREFCNT_dec(compcv);
a0d0e21e
LW		 3362 }
3363 else {
748a9306 3364 cv = compcv;
44a8e56a 3365 if (name) {
3366 GvCV(gv) = cv;
3367 GvCVGEN(gv) = 0;
3368 sub_generation++;
3369 }
a0d0e21e 3370 }
44a8e56a 3371 CvGV(cv) = (GV*)SvREFCNT_inc(gv);
79072805 3372 CvFILEGV(cv) = curcop->cop_filegv;
8990e307 3373 CvSTASH(cv) = curstash;
11343788
MB		 3374#ifdef USE_THREADS
3375 CvOWNER(cv) = 0;
12ca11f6 3376 New(666, CvMUTEXP(cv), 1, perl_mutex);
11343788 3377 MUTEX_INIT(CvMUTEXP(cv));
12ca11f6 3378 New(666, CvCONDP(cv), 1, perl_cond);
11343788
MB		 3379 COND_INIT(CvCONDP(cv));
3380#endif /* USE_THREADS */
8990e307 3381
3fe9a6f1 3382 if (ps)
3383 sv_setpv((SV*)cv, ps);
4633a7c4 3384
c07a80fd 3385 if (error_count) {
3386 op_free(block);
3387 block = Nullop;
68dc0745 3388 if (name) {
3389 char *s = strrchr(name, ':');
3390 s = s ? s+1 : name;
6d4c2119
CS		 3391 if (strEQ(s, "BEGIN")) {
3392 char *not_safe =
3393 "BEGIN not safe after errors--compilation aborted";
3394 if (in_eval & 4)
3395 croak(not_safe);
3396 else {
3397 /* force display of errors found but not reported */
3398 sv_catpv(GvSV(errgv), not_safe);
3399 croak("%s", SvPVx(GvSV(errgv), na));
3400 }
3401 }
68dc0745 3402 }
c07a80fd 3403 }
a0d0e21e 3404 if (!block) {
a0d0e21e
LW		 3405 copline = NOLINE;
3406 LEAVE_SCOPE(floor);
3407 return cv;
3408 }
3409
54310121 3410 if (AvFILL(comppad_name) < AvFILL(comppad))
3411 av_store(comppad_name, AvFILL(comppad), Nullsv);
a0d0e21e 3412
54310121 3413 if (CvCLONE(cv)) {
3414 SV **namep = AvARRAY(comppad_name);
3415 for (ix = AvFILL(comppad); ix > 0; ix--) {
3416 SV *namesv;
3417
3418 if (SvIMMORTAL(curpad[ix]))
3419 continue;
3420 /*
3421 * The only things that a clonable function needs in its
3422 * pad are references to outer lexicals and anonymous subs.
3423 * The rest are created anew during cloning.
3424 */
3425 if (!((namesv = namep[ix]) != Nullsv &&
3426 namesv != &sv_undef &&
3427 (SvFAKE(namesv) ||
3428 *SvPVX(namesv) == '&')))
3429 {
3430 SvREFCNT_dec(curpad[ix]);
3431 curpad[ix] = Nullsv;
3432 }
3433 }
a0d0e21e 3434 }
54310121 3435 else {
3436 AV *av = newAV(); /* Will be @_ */
3437 av_extend(av, 0);
3438 av_store(comppad, 0, (SV*)av);
3439 AvFLAGS(av) = AVf_REIFY;
79072805 3440
54310121 3441 for (ix = AvFILL(comppad); ix > 0; ix--) {
3442 if (SvIMMORTAL(curpad[ix]))
3443 continue;
3444 if (!SvPADMY(curpad[ix]))
3445 SvPADTMP_on(curpad[ix]);
3446 }
3447 }
79072805 3448
a0d0e21e 3449 CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
79072805
LW		 3450 CvSTART(cv) = LINKLIST(CvROOT(cv));
3451 CvROOT(cv)->op_next = 0;
3452 peep(CvSTART(cv));
93a17b20 3453
44a8e56a 3454 if (name) {
3455 char *s;
3456
3457 if (perldb && curstash != debstash) {
46fc3d4c 3458 SV *sv = NEWSV(0,0);
44a8e56a 3459 SV *tmpstr = sv_newmortal();
3460 static GV *db_postponed;
3461 CV *cv;
3462 HV *hv;
3463
fc36a67e 3464 sv_setpvf(sv, "%_:%ld-%ld",
46fc3d4c 3465 GvSV(curcop->cop_filegv),
3466 (long)subline, (long)curcop->cop_line);
44a8e56a 3467 gv_efullname3(tmpstr, gv, Nullch);
3468 hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
3469 if (!db_postponed) {
6bbcb22c 3470 db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
44a8e56a 3471 }
3472 hv = GvHVn(db_postponed);
9607fc9c 3473 if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
3474 && (cv = GvCV(db_postponed))) {
44a8e56a 3475 dSP;
3476 PUSHMARK(sp);
3477 XPUSHs(tmpstr);
3478 PUTBACK;
3479 perl_call_sv((SV*)cv, G_DISCARD);
3480 }
3481 }
79072805 3482
44a8e56a 3483 if ((s = strrchr(name,':')))
28757baa 3484 s++;
3485 else
3486 s = name;
68dc0745 3487 if (strEQ(s, "BEGIN")) {
2ae324a7 3488 I32 oldscope = scopestack_ix;
28757baa 3489 ENTER;
3490 SAVESPTR(compiling.cop_filegv);
3491 SAVEI16(compiling.cop_line);
3492 SAVEI32(perldb);
3493 save_svref(&rs);
3494 sv_setsv(rs, nrs);
3495
3496 if (!beginav)
3497 beginav = newAV();
3498 DEBUG_x( dump_sub(gv) );
3499 av_push(beginav, (SV *)cv);
3500 GvCV(gv) = 0;
68dc0745 3501 call_list(oldscope, beginav);
a6006777 3502
28757baa 3503 curcop = &compiling;
3504 LEAVE;
3505 }
3506 else if (strEQ(s, "END") && !error_count) {
3507 if (!endav)
3508 endav = newAV();
3509 av_unshift(endav, 1);
3510 av_store(endav, 0, (SV *)cv);
3511 GvCV(gv) = 0;
3512 }
ae77835f
MB		 3513 else if (strEQ(s, "RESTART") && !error_count) {
3514 if (!restartav)
3515 restartav = newAV();
3516 av_push(restartav, SvREFCNT_inc(cv));
3517 }
79072805 3518 }
a6006777 3519
aa689395 3520 done:
79072805 3521 copline = NOLINE;
8990e307 3522 LEAVE_SCOPE(floor);
a0d0e21e 3523 return cv;
79072805
LW		 3524}
3525
a0d0e21e
LW		 3526#ifdef DEPRECATED
3527CV *
463ee0b2 3528newXSUB(name, ix, subaddr, filename)
79072805
LW		 3529char *name;
3530I32 ix;
3531I32 (*subaddr)();
3532char *filename;
3533{
a0d0e21e 3534 CV* cv = newXS(name, (void(*)())subaddr, filename);
a5f75d66 3535 CvOLDSTYLE_on(cv);
a0d0e21e
LW		 3536 CvXSUBANY(cv).any_i32 = ix;
3537 return cv;
3538}
3539#endif
3540
3541CV *
3542newXS(name, subaddr, filename)
3543char *name;
3544void (*subaddr) _((CV*));
3545char *filename;
3546{
11343788 3547 dTHR;
44a8e56a 3548 GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
79072805 3549 register CV *cv;
44a8e56a 3550
3551 if (cv = (name ? GvCV(gv) : Nullcv)) {
3552 if (GvCVGEN(gv)) {
3553 /* just a cached method */
3554 SvREFCNT_dec(cv);
3555 cv = 0;
3556 }
3557 else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
3558 /* already defined (or promised) */
a0d0e21e
LW		 3559 if (dowarn) {
3560 line_t oldline = curcop->cop_line;
a0d0e21e
LW		 3561 curcop->cop_line = copline;
3562 warn("Subroutine %s redefined",name);
3563 curcop->cop_line = oldline;
3564 }
3565 SvREFCNT_dec(cv);
3566 cv = 0;
79072805 3567 }
79072805 3568 }
44a8e56a 3569
3570 if (cv) /* must reuse cv if autoloaded */
3571 cv_undef(cv);
a0d0e21e
LW		 3572 else {
3573 cv = (CV*)NEWSV(1105,0);
3574 sv_upgrade((SV *)cv, SVt_PVCV);
44a8e56a 3575 if (name) {
3576 GvCV(gv) = cv;
3577 GvCVGEN(gv) = 0;
3578 sub_generation++;
3579 }
a0d0e21e 3580 }
5196be3e 3581 CvGV(cv) = (GV*)SvREFCNT_inc(gv);
11343788 3582#ifdef USE_THREADS
12ca11f6 3583 New(666, CvMUTEXP(cv), 1, perl_mutex);
11343788 3584 MUTEX_INIT(CvMUTEXP(cv));
12ca11f6 3585 New(666, CvCONDP(cv), 1, perl_cond);
11343788
MB		 3586 COND_INIT(CvCONDP(cv));
3587 CvOWNER(cv) = 0;
3588#endif /* USE_THREADS */
79072805 3589 CvFILEGV(cv) = gv_fetchfile(filename);
a0d0e21e 3590 CvXSUB(cv) = subaddr;
44a8e56a 3591
28757baa 3592 if (name) {
3593 char *s = strrchr(name,':');
3594 if (s)
3595 s++;
3596 else
3597 s = name;
3598 if (strEQ(s, "BEGIN")) {
3599 if (!beginav)
3600 beginav = newAV();
44a8e56a 3601 av_push(beginav, (SV *)cv);
3602 GvCV(gv) = 0;
28757baa 3603 }
3604 else if (strEQ(s, "END")) {
3605 if (!endav)
3606 endav = newAV();
3607 av_unshift(endav, 1);
44a8e56a 3608 av_store(endav, 0, (SV *)cv);
3609 GvCV(gv) = 0;
28757baa 3610 }
ae77835f
MB		 3611 else if (strEQ(s, "RESTART")) {
3612 if (!restartav)
3613 restartav = newAV();
3614 av_push(restartav, (SV *)cv);
3615 }
28757baa 3616 }
8990e307 3617 else
a5f75d66 3618 CvANON_on(cv);
44a8e56a 3619
a0d0e21e 3620 return cv;
79072805
LW		 3621}
3622
3623void
11343788 3624newFORM(floor,o,block)
79072805 3625I32 floor;
11343788 3626OP *o;
79072805
LW		 3627OP *block;
3628{
11343788 3629 dTHR;
79072805
LW		 3630 register CV *cv;
3631 char *name;
3632 GV *gv;
a0d0e21e 3633 I32 ix;
79072805 3634
11343788
MB		 3635 if (o)
3636 name = SvPVx(cSVOPo->op_sv, na);
79072805
LW		 3637 else
3638 name = "STDOUT";
85e6fe83 3639 gv = gv_fetchpv(name,TRUE, SVt_PVFM);
a5f75d66 3640 GvMULTI_on(gv);
79072805
LW		 3641 if (cv = GvFORM(gv)) {
3642 if (dowarn) {
3643 line_t oldline = curcop->cop_line;
3644
3645 curcop->cop_line = copline;
3646 warn("Format %s redefined",name);
3647 curcop->cop_line = oldline;
3648 }
8990e307 3649 SvREFCNT_dec(cv);
79072805 3650 }
748a9306 3651 cv = compcv;
79072805 3652 GvFORM(gv) = cv;
44a8e56a 3653 CvGV(cv) = (GV*)SvREFCNT_inc(gv);
79072805
LW		 3654 CvFILEGV(cv) = curcop->cop_filegv;
3655
a0d0e21e 3656 for (ix = AvFILL(comppad); ix > 0; ix--) {
44a8e56a 3657 if (!SvPADMY(curpad[ix]) && !SvIMMORTAL(curpad[ix]))
a0d0e21e
LW		 3658 SvPADTMP_on(curpad[ix]);
3659 }
3660
79072805
LW		 3661 CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
3662 CvSTART(cv) = LINKLIST(CvROOT(cv));
3663 CvROOT(cv)->op_next = 0;
3664 peep(CvSTART(cv));
11343788 3665 op_free(o);
79072805 3666 copline = NOLINE;
8990e307 3667 LEAVE_SCOPE(floor);
79072805
LW		 3668}
3669
3670OP *
11343788
MB		 3671newANONLIST(o)
3672OP* o;
79072805 3673{
93a17b20 3674 return newUNOP(OP_REFGEN, 0,
11343788 3675 mod(list(convert(OP_ANONLIST, 0, o)), OP_REFGEN));
79072805
LW		 3676}
3677
3678OP *
11343788
MB		 3679newANONHASH(o)
3680OP* o;
79072805 3681{
93a17b20 3682 return newUNOP(OP_REFGEN, 0,
11343788 3683 mod(list(convert(OP_ANONHASH, 0, o)), OP_REFGEN));
a0d0e21e
LW		 3684}
3685
3686OP *
4633a7c4 3687newANONSUB(floor, proto, block)
a0d0e21e 3688I32 floor;
4633a7c4 3689OP *proto;
a0d0e21e
LW		 3690OP *block;
3691{
3692 return newUNOP(OP_REFGEN, 0,
4633a7c4 3693 newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, proto, block)));
79072805
LW		 3694}
3695
3696OP *
3697oopsAV(o)
3698OP *o;
3699{
ed6116ce
LW		 3700 switch (o->op_type) {
3701 case OP_PADSV:
3702 o->op_type = OP_PADAV;
3703 o->op_ppaddr = ppaddr[OP_PADAV];
3704 return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV);
3705
3706 case OP_RV2SV:
79072805
LW		 3707 o->op_type = OP_RV2AV;
3708 o->op_ppaddr = ppaddr[OP_RV2AV];
3709 ref(o, OP_RV2AV);
ed6116ce
LW		 3710 break;
3711
3712 default:
79072805 3713 warn("oops: oopsAV");
ed6116ce
LW		 3714 break;
3715 }
79072805
LW		 3716 return o;
3717}
3718
3719OP *
3720oopsHV(o)
3721OP *o;
3722{
ed6116ce
LW		 3723 switch (o->op_type) {
3724 case OP_PADSV:
3725 case OP_PADAV:
3726 o->op_type = OP_PADHV;
3727 o->op_ppaddr = ppaddr[OP_PADHV];
3728 return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV);
3729
3730 case OP_RV2SV:
3731 case OP_RV2AV:
79072805
LW		 3732 o->op_type = OP_RV2HV;
3733 o->op_ppaddr = ppaddr[OP_RV2HV];
3734 ref(o, OP_RV2HV);
ed6116ce
LW		 3735 break;
3736
3737 default:
79072805 3738 warn("oops: oopsHV");
ed6116ce
LW		 3739 break;
3740 }
79072805
LW		 3741 return o;
3742}
3743
3744OP *
3745newAVREF(o)
3746OP *o;
3747{
ed6116ce
LW		 3748 if (o->op_type == OP_PADANY) {
3749 o->op_type = OP_PADAV;
3750 o->op_ppaddr = ppaddr[OP_PADAV];
93a17b20 3751 return o;
ed6116ce 3752 }
79072805
LW		 3753 return newUNOP(OP_RV2AV, 0, scalar(o));
3754}
3755
3756OP *
a0d0e21e
LW		 3757newGVREF(type,o)
3758I32 type;
79072805
LW		 3759OP *o;
3760{
a0d0e21e
LW		 3761 if (type == OP_MAPSTART)
3762 return newUNOP(OP_NULL, 0, o);
748a9306 3763 return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
79072805
LW		 3764}
3765
3766OP *
3767newHVREF(o)
3768OP *o;
3769{
ed6116ce
LW		 3770 if (o->op_type == OP_PADANY) {
3771 o->op_type = OP_PADHV;
3772 o->op_ppaddr = ppaddr[OP_PADHV];
93a17b20 3773 return o;
ed6116ce 3774 }
79072805
LW		 3775 return newUNOP(OP_RV2HV, 0, scalar(o));
3776}
3777
3778OP *
3779oopsCV(o)
3780OP *o;
3781{
463ee0b2 3782 croak("NOT IMPL LINE %d",__LINE__);
79072805
LW		 3783 /* STUB */
3784 return o;
3785}
3786
3787OP *
c07a80fd 3788newCVREF(flags, o)
3789I32 flags;
79072805
LW		 3790OP *o;
3791{
c07a80fd 3792 return newUNOP(OP_RV2CV, flags, scalar(o));
79072805
LW		 3793}
3794
3795OP *
3796newSVREF(o)
3797OP *o;
3798{
ed6116ce
LW		 3799 if (o->op_type == OP_PADANY) {
3800 o->op_type = OP_PADSV;
3801 o->op_ppaddr = ppaddr[OP_PADSV];
93a17b20 3802 return o;
ed6116ce 3803 }
79072805
LW		 3804 return newUNOP(OP_RV2SV, 0, scalar(o));
3805}
3806
3807/* Check routines. */
3808
3809OP *
5dc0d613
MB		 3810ck_anoncode(o)
3811OP *o;
5f05dabc 3812{
178c6305
CS		 3813 PADOFFSET ix;
3814 SV* name;
3815
3816 name = NEWSV(1106,0);
3817 sv_upgrade(name, SVt_PVNV);
3818 sv_setpvn(name, "&", 1);
3819 SvIVX(name) = -1;
3820 SvNVX(name) = 1;
5dc0d613 3821 ix = pad_alloc(o->op_type, SVs_PADMY);
178c6305 3822 av_store(comppad_name, ix, name);
5dc0d613
MB		 3823 av_store(comppad, ix, cSVOPo->op_sv);
3824 SvPADMY_on(cSVOPo->op_sv);
3825 cSVOPo->op_sv = Nullsv;
3826 cSVOPo->op_targ = ix;
3827 return o;
5f05dabc 3828}
3829
3830OP *
5dc0d613
MB		 3831ck_bitop(o)
3832OP *o;
55497cff 3833{
5dc0d613
MB		 3834 o->op_private = hints;
3835 return o;
55497cff 3836}
3837
3838OP *
11343788
MB		 3839ck_concat(o)
3840OP *o;
79072805 3841{
11343788
MB		 3842 if (cUNOPo->op_first->op_type == OP_CONCAT)
3843 o->op_flags |= OPf_STACKED;
3844 return o;
79072805
LW		 3845}
3846
3847OP *
11343788
MB		 3848ck_spair(o)
3849OP *o;
79072805 3850{
11343788 3851 if (o->op_flags & OPf_KIDS) {
79072805 3852 OP* newop;
a0d0e21e 3853 OP* kid;
5dc0d613
MB		 3854 OPCODE type = o->op_type;
3855 o = modkids(ck_fun(o), type);
11343788 3856 kid = cUNOPo->op_first;
a0d0e21e
LW		 3857 newop = kUNOP->op_first->op_sibling;
3858 if (newop &&
3859 (newop->op_sibling ||
3860 !(opargs[newop->op_type] & OA_RETSCALAR) ||
3861 newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
3862 newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
3863
11343788 3864 return o;
a0d0e21e
LW		 3865 }
3866 op_free(kUNOP->op_first);
3867 kUNOP->op_first = newop;
3868 }
11343788
MB		 3869 o->op_ppaddr = ppaddr[++o->op_type];
3870 return ck_fun(o);
a0d0e21e
LW		 3871}
3872
3873OP *
11343788
MB		 3874ck_delete(o)
3875OP *o;
a0d0e21e 3876{
11343788 3877 o = ck_fun(o);
5dc0d613 3878 o->op_private = 0;
11343788
MB		 3879 if (o->op_flags & OPf_KIDS) {
3880 OP *kid = cUNOPo->op_first;
5f05dabc 3881 if (kid->op_type == OP_HSLICE)
5dc0d613 3882 o->op_private |= OPpSLICE;
5f05dabc 3883 else if (kid->op_type != OP_HELEM)
3884 croak("%s argument is not a HASH element or slice",
5dc0d613 3885 op_desc[o->op_type]);
a0d0e21e 3886 null(kid);
79072805 3887 }
11343788 3888 return o;
79072805
LW		 3889}
3890
3891OP *
11343788
MB		 3892ck_eof(o)
3893OP *o;
79072805 3894{
11343788 3895 I32 type = o->op_type;
79072805 3896
11343788
MB		 3897 if (o->op_flags & OPf_KIDS) {
3898 if (cLISTOPo->op_first->op_type == OP_STUB) {
3899 op_free(o);
3900 o = newUNOP(type, OPf_SPECIAL,
85e6fe83 3901 newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV)));
8990e307 3902 }
11343788 3903 return ck_fun(o);
79072805 3904 }
11343788 3905 return o;
79072805
LW		 3906}
3907
3908OP *
11343788
MB		 3909ck_eval(o)
3910OP *o;
79072805 3911{
85e6fe83 3912 hints |= HINT_BLOCK_SCOPE;
11343788
MB		 3913 if (o->op_flags & OPf_KIDS) {
3914 SVOP *kid = (SVOP*)cUNOPo->op_first;
79072805 3915
93a17b20 3916 if (!kid) {
11343788
MB		 3917 o->op_flags &= ~OPf_KIDS;
3918 null(o);
79072805
LW		 3919 }
3920 else if (kid->op_type == OP_LINESEQ) {
3921 LOGOP *enter;
3922
11343788
MB		 3923 kid->op_next = o->op_next;
3924 cUNOPo->op_first = 0;
3925 op_free(o);
79072805
LW		 3926
3927 Newz(1101, enter, 1, LOGOP);
3928 enter->op_type = OP_ENTERTRY;
3929 enter->op_ppaddr = ppaddr[OP_ENTERTRY];
3930 enter->op_private = 0;
3931
3932 /* establish postfix order */
3933 enter->op_next = (OP*)enter;
3934
11343788
MB		 3935 o = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
3936 o->op_type = OP_LEAVETRY;
3937 o->op_ppaddr = ppaddr[OP_LEAVETRY];
3938 enter->op_other = o;
3939 return o;
79072805
LW		 3940 }
3941 }
3942 else {
11343788
MB		 3943 op_free(o);
3944 o = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
79072805 3945 }
11343788
MB		 3946 o->op_targ = (PADOFFSET)hints;
3947 return o;
79072805
LW		 3948}
3949
3950OP *
11343788
MB		 3951ck_exec(o)
3952OP *o;
79072805
LW		 3953{
3954 OP *kid;
11343788
MB		 3955 if (o->op_flags & OPf_STACKED) {
3956 o = ck_fun(o);
3957 kid = cUNOPo->op_first->op_sibling;
8990e307
LW		 3958 if (kid->op_type == OP_RV2GV)
3959 null(kid);
79072805 3960 }
463ee0b2 3961 else
11343788
MB		 3962 o = listkids(o);
3963 return o;
79072805
LW		 3964}
3965
3966OP *
5196be3e
MB		 3967ck_exists(o)
3968OP *o;
5f05dabc 3969{
5196be3e
MB		 3970 o = ck_fun(o);
3971 if (o->op_flags & OPf_KIDS) {
3972 OP *kid = cUNOPo->op_first;
5f05dabc 3973 if (kid->op_type != OP_HELEM)
5196be3e 3974 croak("%s argument is not a HASH element", op_desc[o->op_type]);
5f05dabc 3975 null(kid);
3976 }
5196be3e 3977 return o;
5f05dabc 3978}
3979
3980OP *
79072805
LW		 3981ck_gvconst(o)
3982register OP *o;
3983{
3984 o = fold_constants(o);
3985 if (o->op_type == OP_CONST)
3986 o->op_type = OP_GV;
3987 return o;
3988}
3989
3990OP *
11343788
MB		 3991ck_rvconst(o)
3992register OP *o;
79072805 3993{
11343788
MB		 3994 dTHR;
3995 SVOP *kid = (SVOP*)cUNOPo->op_first;
85e6fe83 3996
11343788 3997 o->op_private |= (hints & HINT_STRICT_REFS);
79072805 3998 if (kid->op_type == OP_CONST) {
44a8e56a 3999 char *name;
4000 int iscv;
4001 GV *gv;
4002
4003 name = SvPV(kid->op_sv, na);
4004 if ((hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
4005 char *badthing = Nullch;
5dc0d613 4006 switch (o->op_type) {
44a8e56a 4007 case OP_RV2SV:
4008 badthing = "a SCALAR";
4009 break;
4010 case OP_RV2AV:
4011 badthing = "an ARRAY";
4012 break;
4013 case OP_RV2HV:
4014 badthing = "a HASH";
4015 break;
4016 }
4017 if (badthing)
4018 croak(
4019 "Can't use bareword (\"%s\") as %s ref while \"strict refs\" in use",
4020 name, badthing);
4021 }
79072805 4022 kid->op_type = OP_GV;
5196be3e 4023 iscv = (o->op_type == OP_RV2CV) * 2;
a0d0e21e 4024 for (gv = 0; !gv; iscv++) {
748a9306
LW		 4025 /*
4026 * This is a little tricky. We only want to add the symbol if we
4027 * didn't add it in the lexer. Otherwise we get duplicate strict
4028 * warnings. But if we didn't add it in the lexer, we must at
4029 * least pretend like we wanted to add it even if it existed before,
4030 * or we get possible typo warnings. OPpCONST_ENTERED says
4031 * whether the lexer already added THIS instance of this symbol.
4032 */
44a8e56a 4033 gv = gv_fetchpv(name,
748a9306 4034 iscv | !(kid->op_private & OPpCONST_ENTERED),
a0d0e21e
LW		 4035 iscv
4036 ? SVt_PVCV
11343788 4037 : o->op_type == OP_RV2SV
a0d0e21e 4038 ? SVt_PV
11343788 4039 : o->op_type == OP_RV2AV
a0d0e21e 4040 ? SVt_PVAV
11343788 4041 : o->op_type == OP_RV2HV
a0d0e21e
LW		 4042 ? SVt_PVHV
4043 : SVt_PVGV);
4044 }
adbc6bb1 4045 SvREFCNT_dec(kid->op_sv);
a0d0e21e 4046 kid->op_sv = SvREFCNT_inc(gv);
79072805 4047 }
11343788 4048 return o;
79072805
LW		 4049}
4050
4051OP *
11343788
MB		 4052ck_ftst(o)
4053OP *o;
79072805 4054{
11343788
MB		 4055 dTHR;
4056 I32 type = o->op_type;
79072805 4057
11343788
MB		 4058 if (o->op_flags & OPf_REF)
4059 return o;
79072805 4060
11343788
MB		 4061 if (o->op_flags & OPf_KIDS) {
4062 SVOP *kid = (SVOP*)cUNOPo->op_first;
79072805
LW		 4063
4064 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
a0d0e21e 4065 OP *newop = newGVOP(type, OPf_REF,
85e6fe83 4066 gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
11343788 4067 op_free(o);
79072805
LW		 4068 return newop;
4069 }
4070 }
4071 else {
11343788 4072 op_free(o);
79072805 4073 if (type == OP_FTTTY)
a0d0e21e 4074 return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
85e6fe83 4075 SVt_PVIO));
79072805
LW		 4076 else
4077 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
4078 }
11343788 4079 return o;
79072805
LW		 4080}
4081
4082OP *
11343788
MB		 4083ck_fun(o)
4084OP *o;
79072805 4085{
11343788 4086 dTHR;
79072805
LW		 4087 register OP *kid;
4088 OP **tokid;
4089 OP *sibl;
4090 I32 numargs = 0;
11343788 4091 int type = o->op_type;
a0d0e21e 4092 register I32 oa = opargs[type] >> OASHIFT;
79072805 4093
11343788 4094 if (o->op_flags & OPf_STACKED) {
79072805
LW		 4095 if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
4096 oa &= ~OA_OPTIONAL;
4097 else
11343788 4098 return no_fh_allowed(o);
79072805
LW		 4099 }
4100
11343788
MB		 4101 if (o->op_flags & OPf_KIDS) {
4102 tokid = &cLISTOPo->op_first;
4103 kid = cLISTOPo->op_first;
8990e307
LW		 4104 if (kid->op_type == OP_PUSHMARK ||
4105 kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
4106 {
79072805
LW		 4107 tokid = &kid->op_sibling;
4108 kid = kid->op_sibling;
4109 }
a0d0e21e
LW		 4110 if (!kid && opargs[type] & OA_DEFGV)
4111 *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
79072805
LW		 4112
4113 while (oa && kid) {
4114 numargs++;
4115 sibl = kid->op_sibling;
4116 switch (oa & 7) {
4117 case OA_SCALAR:
4118 scalar(kid);
4119 break;
4120 case OA_LIST:
4121 if (oa < 16) {
4122 kid = 0;
4123 continue;
4124 }
4125 else
4126 list(kid);
4127 break;
4128 case OA_AVREF:
4129 if (kid->op_type == OP_CONST &&
4130 (kid->op_private & OPpCONST_BARE)) {
463ee0b2 4131 char *name = SvPVx(((SVOP*)kid)->op_sv, na);
79072805 4132 OP *newop = newAVREF(newGVOP(OP_GV, 0,
85e6fe83 4133 gv_fetchpv(name, TRUE, SVt_PVAV) ));
463ee0b2 4134 if (dowarn)
ff0cee69 4135 warn("Array @%s missing the @ in argument %ld of %s()",
4136 name, (long)numargs, op_desc[type]);
79072805
LW		 4137 op_free(kid);
4138 kid = newop;
4139 kid->op_sibling = sibl;
4140 *tokid = kid;
4141 }
8990e307 4142 else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
11343788 4143 bad_type(numargs, "array", op_desc[o->op_type], kid);
a0d0e21e 4144 mod(kid, type);
79072805
LW		 4145 break;
4146 case OA_HVREF:
4147 if (kid->op_type == OP_CONST &&
4148 (kid->op_private & OPpCONST_BARE)) {
463ee0b2 4149 char *name = SvPVx(((SVOP*)kid)->op_sv, na);
79072805 4150 OP *newop = newHVREF(newGVOP(OP_GV, 0,
85e6fe83 4151 gv_fetchpv(name, TRUE, SVt_PVHV) ));
463ee0b2 4152 if (dowarn)
ff0cee69 4153 warn("Hash %%%s missing the %% in argument %ld of %s()",
4154 name, (long)numargs, op_desc[type]);
79072805
LW		 4155 op_free(kid);
4156 kid = newop;
4157 kid->op_sibling = sibl;
4158 *tokid = kid;
4159 }
8990e307 4160 else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
11343788 4161 bad_type(numargs, "hash", op_desc[o->op_type], kid);
a0d0e21e 4162 mod(kid, type);
79072805
LW		 4163 break;
4164 case OA_CVREF:
4165 {
a0d0e21e 4166 OP *newop = newUNOP(OP_NULL, 0, kid);
79072805
LW		 4167 kid->op_sibling = 0;
4168 linklist(kid);
4169 newop->op_next = newop;
4170 kid = newop;
4171 kid->op_sibling = sibl;
4172 *tokid = kid;
4173 }
4174 break;
4175 case OA_FILEREF:
4176 if (kid->op_type != OP_GV) {
4177 if (kid->op_type == OP_CONST &&
4178 (kid->op_private & OPpCONST_BARE)) {
4179 OP *newop = newGVOP(OP_GV, 0,
85e6fe83
LW		 4180 gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE,
4181 SVt_PVIO) );
79072805
LW		 4182 op_free(kid);
4183 kid = newop;
4184 }
4185 else {
4186 kid->op_sibling = 0;
4187 kid = newUNOP(OP_RV2GV, 0, scalar(kid));
4188 }
4189 kid->op_sibling = sibl;
4190 *tokid = kid;
4191 }
4192 scalar(kid);
4193 break;
4194 case OA_SCALARREF:
a0d0e21e 4195 mod(scalar(kid), type);
79072805
LW		 4196 break;
4197 }
4198 oa >>= 4;
4199 tokid = &kid->op_sibling;
4200 kid = kid->op_sibling;
4201 }
11343788 4202 o->op_private |= numargs;
79072805 4203 if (kid)
11343788
MB		 4204 return too_many_arguments(o,op_desc[o->op_type]);
4205 listkids(o);
79072805 4206 }
a0d0e21e 4207 else if (opargs[type] & OA_DEFGV) {
11343788 4208 op_free(o);
a0d0e21e
LW		 4209 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
4210 }
4211
79072805
LW		 4212 if (oa) {
4213 while (oa & OA_OPTIONAL)
4214 oa >>= 4;
4215 if (oa && oa != OA_LIST)
11343788 4216 return too_few_arguments(o,op_desc[o->op_type]);
79072805 4217 }
11343788 4218 return o;
79072805
LW		 4219}
4220
4221OP *
11343788
MB		 4222ck_glob(o)
4223OP *o;
79072805 4224{
b1cb66bf 4225 GV *gv = gv_fetchpv("glob", FALSE, SVt_PVCV);
4226
4227 if (gv && GvIMPORTED_CV(gv)) {
46fc3d4c 4228 static int glob_index;
4229
5196be3e 4230 append_elem(OP_GLOB, o,
46fc3d4c 4231 newSVOP(OP_CONST, 0, newSViv(glob_index++)));
5196be3e
MB		 4232 o->op_type = OP_LIST;
4233 o->op_ppaddr = ppaddr[OP_LIST];
4234 cLISTOPo->op_first->op_type = OP_PUSHMARK;
4235 cLISTOPo->op_first->op_ppaddr = ppaddr[OP_PUSHMARK];
4236 o = newUNOP(OP_ENTERSUB, OPf_STACKED,
4237 append_elem(OP_LIST, o,
4238 scalar(newUNOP(OP_RV2CV, 0,
4239 newGVOP(OP_GV, 0, gv)))));
4240 return ck_subr(o);
4241 }
4242 if ((o->op_flags & OPf_KIDS) && !cLISTOPo->op_first->op_sibling)
4243 append_elem(OP_GLOB, o, newSVREF(newGVOP(OP_GV, 0, defgv)));
b1cb66bf 4244 gv = newGVgen("main");
a0d0e21e 4245 gv_IOadd(gv);
11343788
MB		 4246 append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
4247 scalarkids(o);
4248 return ck_fun(o);
79072805
LW		 4249}
4250
4251OP *
11343788
MB		 4252ck_grep(o)
4253OP *o;
79072805
LW		 4254{
4255 LOGOP *gwop;
4256 OP *kid;
11343788 4257 OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
79072805 4258
11343788 4259 o->op_ppaddr = ppaddr[OP_GREPSTART];
a0d0e21e
LW		 4260 Newz(1101, gwop, 1, LOGOP);
4261
11343788 4262 if (o->op_flags & OPf_STACKED) {
a0d0e21e 4263 OP* k;
11343788
MB		 4264 o = ck_sort(o);
4265 kid = cLISTOPo->op_first->op_sibling;
4266 for (k = cLISTOPo->op_first->op_sibling->op_next; k; k = k->op_next) {
a0d0e21e
LW		 4267 kid = k;
4268 }
4269 kid->op_next = (OP*)gwop;
11343788 4270 o->op_flags &= ~OPf_STACKED;
93a17b20 4271 }
11343788 4272 kid = cLISTOPo->op_first->op_sibling;
a0d0e21e
LW		 4273 if (type == OP_MAPWHILE)
4274 list(kid);
4275 else
4276 scalar(kid);
11343788 4277 o = ck_fun(o);
79072805 4278 if (error_count)
11343788
MB		 4279 return o;
4280 kid = cLISTOPo->op_first->op_sibling;
79072805 4281 if (kid->op_type != OP_NULL)
463ee0b2 4282 croak("panic: ck_grep");
79072805
LW		 4283 kid = kUNOP->op_first;
4284
a0d0e21e
LW		 4285 gwop->op_type = type;
4286 gwop->op_ppaddr = ppaddr[type];
11343788 4287 gwop->op_first = listkids(o);
79072805
LW		 4288 gwop->op_flags |= OPf_KIDS;
4289 gwop->op_private = 1;
4290 gwop->op_other = LINKLIST(kid);
a0d0e21e 4291 gwop->op_targ = pad_alloc(type, SVs_PADTMP);
79072805
LW		 4292 kid->op_next = (OP*)gwop;
4293
11343788 4294 kid = cLISTOPo->op_first->op_sibling;
a0d0e21e 4295 if (!kid || !kid->op_sibling)
11343788 4296 return too_few_arguments(o,op_desc[o->op_type]);
a0d0e21e
LW		 4297 for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
4298 mod(kid, OP_GREPSTART);
4299
79072805
LW		 4300 return (OP*)gwop;
4301}
4302
4303OP *
11343788
MB		 4304ck_index(o)
4305OP *o;
79072805 4306{
11343788
MB		 4307 if (o->op_flags & OPf_KIDS) {
4308 OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
79072805 4309 if (kid && kid->op_type == OP_CONST)
bbce6d69 4310 fbm_compile(((SVOP*)kid)->op_sv);
79072805 4311 }
11343788 4312 return ck_fun(o);
79072805
LW		 4313}
4314
4315OP *
11343788
MB		 4316ck_lengthconst(o)
4317OP *o;
79072805
LW		 4318{
4319 /* XXX length optimization goes here */
11343788 4320 return ck_fun(o);
79072805
LW		 4321}
4322
4323OP *
11343788
MB		 4324ck_lfun(o)
4325OP *o;
79072805 4326{
5dc0d613
MB		 4327 OPCODE type = o->op_type;
4328 return modkids(ck_fun(o), type);
79072805
LW		 4329}
4330
4331OP *
11343788
MB		 4332ck_rfun(o)
4333OP *o;
8990e307 4334{
5dc0d613
MB		 4335 OPCODE type = o->op_type;
4336 return refkids(ck_fun(o), type);
8990e307
LW		 4337}
4338
4339OP *
11343788
MB		 4340ck_listiob(o)
4341OP *o;
79072805
LW		 4342{
4343 register OP *kid;
4344
11343788 4345 kid = cLISTOPo->op_first;
79072805 4346 if (!kid) {
11343788
MB		 4347 o = force_list(o);
4348 kid = cLISTOPo->op_first;
79072805
LW		 4349 }
4350 if (kid->op_type == OP_PUSHMARK)
4351 kid = kid->op_sibling;
11343788 4352 if (kid && o->op_flags & OPf_STACKED)
79072805
LW		 4353 kid = kid->op_sibling;
4354 else if (kid && !kid->op_sibling) { /* print HANDLE; */
4355 if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
11343788 4356 o->op_flags |= OPf_STACKED; /* make it a filehandle */
748a9306 4357 kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
11343788
MB		 4358 cLISTOPo->op_first->op_sibling = kid;
4359 cLISTOPo->op_last = kid;
79072805
LW		 4360 kid = kid->op_sibling;
4361 }
4362 }
4363
4364 if (!kid)
11343788 4365 append_elem(o->op_type, o, newSVREF(newGVOP(OP_GV, 0, defgv)) );
79072805 4366
5dc0d613 4367 o = listkids(o);
bbce6d69 4368
5dc0d613 4369 o->op_private = 0;
36477c24 4370#ifdef USE_LOCALE
bbce6d69 4371 if (hints & HINT_LOCALE)
5dc0d613 4372 o->op_private |= OPpLOCALE;
bbce6d69 4373#endif
4374
5dc0d613 4375 return o;
bbce6d69 4376}
4377
4378OP *
5dc0d613
MB		 4379ck_fun_locale(o)
4380OP *o;
bbce6d69 4381{
5dc0d613 4382 o = ck_fun(o);
bbce6d69 4383
5dc0d613 4384 o->op_private = 0;
36477c24 4385#ifdef USE_LOCALE
bbce6d69 4386 if (hints & HINT_LOCALE)
5dc0d613 4387 o->op_private |= OPpLOCALE;
bbce6d69 4388#endif
4389
5dc0d613 4390 return o;
bbce6d69 4391}
4392
4393OP *
5dc0d613
MB		 4394ck_scmp(o)
4395OP *o;
bbce6d69 4396{
5dc0d613 4397 o->op_private = 0;
36477c24 4398#ifdef USE_LOCALE
bbce6d69 4399 if (hints & HINT_LOCALE)
5dc0d613 4400 o->op_private |= OPpLOCALE;
bbce6d69 4401#endif
36477c24 4402
5dc0d613 4403 return o;
79072805
LW		 4404}
4405
4406OP *
11343788
MB		 4407ck_match(o)
4408OP *o;
79072805 4409{
5dc0d613 4410 o->op_private |= OPpRUNTIME;
11343788 4411 return o;
79072805
LW		 4412}
4413
4414OP *
11343788
MB		 4415ck_null(o)
4416OP *o;
79072805 4417{
11343788 4418 return o;
79072805
LW		 4419}
4420
4421OP *
11343788
MB		 4422ck_repeat(o)
4423OP *o;
79072805 4424{
11343788
MB		 4425 if (cBINOPo->op_first->op_flags & OPf_PARENS) {
4426 o->op_private |= OPpREPEAT_DOLIST;
4427 cBINOPo->op_first = force_list(cBINOPo->op_first);
79072805
LW		 4428 }
4429 else
11343788
MB		 4430 scalar(o);
4431 return o;
79072805
LW		 4432}
4433
4434OP *
11343788
MB		 4435ck_require(o)
4436OP *o;
8990e307 4437{
11343788
MB		 4438 if (o->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */
4439 SVOP *kid = (SVOP*)cUNOPo->op_first;
8990e307
LW		 4440
4441 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
8990e307 4442 char *s;
a0d0e21e
LW		 4443 for (s = SvPVX(kid->op_sv); *s; s++) {
4444 if (*s == ':' && s[1] == ':') {
4445 *s = '/';
1aef975c 4446 Move(s+2, s+1, strlen(s+2)+1, char);
a0d0e21e
LW		 4447 --SvCUR(kid->op_sv);
4448 }
8990e307 4449 }
a0d0e21e 4450 sv_catpvn(kid->op_sv, ".pm", 3);
8990e307
LW		 4451 }
4452 }
11343788 4453 return ck_fun(o);
8990e307
LW		 4454}
4455
4456OP *
11343788
MB		 4457ck_retarget(o)
4458OP *o;
79072805 4459{
463ee0b2 4460 croak("NOT IMPL LINE %d",__LINE__);
79072805 4461 /* STUB */
11343788 4462 return o;
79072805
LW		 4463}
4464
4465OP *
11343788
MB		 4466ck_select(o)
4467OP *o;
79072805 4468{
c07a80fd 4469 OP* kid;
11343788
MB		 4470 if (o->op_flags & OPf_KIDS) {
4471 kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
2304df62 4472 if (kid && kid->op_sibling) {
11343788
MB		 4473 o->op_type = OP_SSELECT;
4474 o->op_ppaddr = ppaddr[OP_SSELECT];
4475 o = ck_fun(o);
4476 return fold_constants(o);
79072805
LW		 4477 }
4478 }
11343788
MB		 4479 o = ck_fun(o);
4480 kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
c07a80fd 4481 if (kid && kid->op_type == OP_RV2GV)
4482 kid->op_private &= ~HINT_STRICT_REFS;
11343788 4483 return o;
79072805
LW		 4484}
4485
4486OP *
11343788
MB		 4487ck_shift(o)
4488OP *o;
79072805 4489{
11343788 4490 I32 type = o->op_type;
79072805 4491
11343788 4492 if (!(o->op_flags & OPf_KIDS)) {
6d4ff0d2
MB		 4493 OP *argop;
4494
11343788 4495 op_free(o);
6d4ff0d2
MB		 4496#ifdef USE_THREADS
4497 if (subline) {
4498 argop = newOP(OP_PADAV, OPf_REF);
4499 argop->op_targ = 0; /* curpad[0] is @_ */
4500 }
4501 else {
4502 argop = newUNOP(OP_RV2AV, 0,
4503 scalar(newGVOP(OP_GV, 0,
4504 gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
4505 }
4506#else
4507 argop = newUNOP(OP_RV2AV, 0,
4508 scalar(newGVOP(OP_GV, 0, subline ?
4509 defgv : gv_fetchpv("ARGV", TRUE, SVt_PVAV))));
4510#endif /* USE_THREADS */
4511 return newUNOP(type, 0, scalar(argop));
79072805 4512 }
11343788 4513 return scalar(modkids(ck_fun(o), type));
79072805
LW		 4514}
4515
4516OP *
11343788
MB		 4517ck_sort(o)
4518OP *o;
79072805 4519{
5dc0d613 4520 o->op_private = 0;
36477c24 4521#ifdef USE_LOCALE
bbce6d69 4522 if (hints & HINT_LOCALE)
5dc0d613 4523 o->op_private |= OPpLOCALE;
bbce6d69 4524#endif
4525
11343788
MB		 4526 if (o->op_flags & OPf_STACKED) {
4527 OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
463ee0b2
LW		 4528 OP *k;
4529 kid = kUNOP->op_first; /* get past rv2gv */
79072805 4530
463ee0b2 4531 if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
79072805 4532 linklist(kid);
463ee0b2
LW		 4533 if (kid->op_type == OP_SCOPE) {
4534 k = kid->op_next;
4535 kid->op_next = 0;
79072805 4536 }
463ee0b2 4537 else if (kid->op_type == OP_LEAVE) {
11343788 4538 if (o->op_type == OP_SORT) {
748a9306
LW		 4539 null(kid); /* wipe out leave */
4540 kid->op_next = kid;
463ee0b2 4541
748a9306
LW		 4542 for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
4543 if (k->op_next == kid)
4544 k->op_next = 0;
4545 }
463ee0b2 4546 }
748a9306
LW		 4547 else
4548 kid->op_next = 0; /* just disconnect the leave */
a0d0e21e 4549 k = kLISTOP->op_first;
463ee0b2 4550 }
a0d0e21e
LW		 4551 peep(k);
4552
11343788 4553 kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
8990e307 4554 null(kid); /* wipe out rv2gv */
11343788 4555 if (o->op_type == OP_SORT)
a0d0e21e
LW		 4556 kid->op_next = kid;
4557 else
4558 kid->op_next = k;
11343788 4559 o->op_flags |= OPf_SPECIAL;
79072805
LW		 4560 }
4561 }
bbce6d69 4562
11343788 4563 return o;
79072805
LW		 4564}
4565
4566OP *
11343788
MB		 4567ck_split(o)
4568OP *o;
79072805
LW		 4569{
4570 register OP *kid;
ed6116ce 4571 PMOP* pm;
79072805 4572
11343788
MB		 4573 if (o->op_flags & OPf_STACKED)
4574 return no_fh_allowed(o);
79072805 4575
11343788 4576 kid = cLISTOPo->op_first;
8990e307 4577 if (kid->op_type != OP_NULL)
463ee0b2 4578 croak("panic: ck_split");
8990e307 4579 kid = kid->op_sibling;
11343788
MB		 4580 op_free(cLISTOPo->op_first);
4581 cLISTOPo->op_first = kid;
85e6fe83 4582 if (!kid) {
11343788
MB		 4583 cLISTOPo->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
4584 cLISTOPo->op_last = kid; /* There was only one element previously */
85e6fe83 4585 }
79072805
LW		 4586
4587 if (kid->op_type != OP_MATCH) {
4588 OP *sibl = kid->op_sibling;
463ee0b2 4589 kid->op_sibling = 0;
79072805 4590 kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
11343788
MB		 4591 if (cLISTOPo->op_first == cLISTOPo->op_last)
4592 cLISTOPo->op_last = kid;
4593 cLISTOPo->op_first = kid;
79072805
LW		 4594 kid->op_sibling = sibl;
4595 }
ed6116ce
LW		 4596 pm = (PMOP*)kid;
4597 if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
8990e307 4598 SvREFCNT_dec(pm->op_pmshort); /* can't use substring to optimize */
ed6116ce
LW		 4599 pm->op_pmshort = 0;
4600 }
79072805
LW		 4601
4602 kid->op_type = OP_PUSHRE;
4603 kid->op_ppaddr = ppaddr[OP_PUSHRE];
4604 scalar(kid);
4605
4606 if (!kid->op_sibling)
11343788 4607 append_elem(OP_SPLIT, o, newSVREF(newGVOP(OP_GV, 0, defgv)) );
79072805
LW		 4608
4609 kid = kid->op_sibling;
4610 scalar(kid);
4611
4612 if (!kid->op_sibling)
11343788 4613 append_elem(OP_SPLIT, o, newSVOP(OP_CONST, 0, newSViv(0)));
79072805
LW		 4614
4615 kid = kid->op_sibling;
4616 scalar(kid);
4617
4618 if (kid->op_sibling)
11343788 4619 return too_many_arguments(o,op_desc[o->op_type]);
79072805 4620
11343788 4621 return o;
79072805
LW		 4622}
4623
4624OP *
11343788
MB		 4625ck_subr(o)
4626OP *o;
79072805 4627{
11343788
MB		 4628 dTHR;
4629 OP *prev = ((cUNOPo->op_first->op_sibling)
4630 ? cUNOPo : ((UNOP*)cUNOPo->op_first))->op_first;
4631 OP *o2 = prev->op_sibling;
4633a7c4
LW		 4632 OP *cvop;
4633 char *proto = 0;
4634 CV *cv = 0;
46fc3d4c 4635 GV *namegv = 0;
4633a7c4
LW		 4636 int optional = 0;
4637 I32 arg = 0;
4638
11343788 4639 for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
4633a7c4
LW		 4640 if (cvop->op_type == OP_RV2CV) {
4641 SVOP* tmpop;
11343788 4642 o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
4633a7c4
LW		 4643 null(cvop); /* disable rv2cv */
4644 tmpop = (SVOP*)((UNOP*)cvop)->op_first;
4645 if (tmpop->op_type == OP_GV) {
8ebc5c01 4646 cv = GvCVu(tmpop->op_sv);
5dc0d613 4647 if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER)) {
46fc3d4c 4648 namegv = CvANON(cv) ? (GV*)tmpop->op_sv : CvGV(cv);
4649 proto = SvPV((SV*)cv, na);
4650 }
4633a7c4
LW		 4651 }
4652 }
11343788 4653 o->op_private |= (hints & HINT_STRICT_REFS);
8990e307 4654 if (perldb && curstash != debstash)
11343788
MB		 4655 o->op_private |= OPpENTERSUB_DB;
4656 while (o2 != cvop) {
4633a7c4
LW		 4657 if (proto) {
4658 switch (*proto) {
4659 case '\0':
5dc0d613 4660 return too_many_arguments(o, gv_ename(namegv));
4633a7c4
LW		 4661 case ';':
4662 optional = 1;
4663 proto++;
4664 continue;
4665 case '$':
4666 proto++;
4667 arg++;
11343788 4668 scalar(o2);
4633a7c4
LW		 4669 break;
4670 case '%':
4671 case '@':
11343788 4672 list(o2);
4633a7c4
LW		 4673 arg++;
4674 break;
4675 case '&':
4676 proto++;
4677 arg++;
11343788 4678 if (o2->op_type != OP_REFGEN && o2->op_type != OP_UNDEF)
5dc0d613 4679 bad_type(arg, "block", gv_ename(namegv), o2);
4633a7c4
LW		 4680 break;
4681 case '*':
4682 proto++;
4683 arg++;
11343788 4684 if (o2->op_type == OP_RV2GV)
4633a7c4
LW		 4685 goto wrapref;
4686 {
11343788
MB		 4687 OP* kid = o2;
4688 o2 = newUNOP(OP_RV2GV, 0, kid);
4689 o2->op_sibling = kid->op_sibling;
4633a7c4
LW		 4690 kid->op_sibling = 0;
4691 prev->op_sibling = o;
4692 }
4693 goto wrapref;
4694 case '\\':
4695 proto++;
4696 arg++;
4697 switch (*proto++) {
4698 case '*':
11343788 4699 if (o2->op_type != OP_RV2GV)
5dc0d613 4700 bad_type(arg, "symbol", gv_ename(namegv), o2);
4633a7c4
LW		 4701 goto wrapref;
4702 case '&':
11343788 4703 if (o2->op_type != OP_RV2CV)
5dc0d613 4704 bad_type(arg, "sub", gv_ename(namegv), o2);
4633a7c4
LW		 4705 goto wrapref;
4706 case '$':
11343788 4707 if (o2->op_type != OP_RV2SV && o2->op_type != OP_PADSV)
5dc0d613 4708 bad_type(arg, "scalar", gv_ename(namegv), o2);
4633a7c4
LW		 4709 goto wrapref;
4710 case '@':
11343788 4711 if (o2->op_type != OP_RV2AV && o2->op_type != OP_PADAV)
5dc0d613 4712 bad_type(arg, "array", gv_ename(namegv), o2);
4633a7c4
LW		 4713 goto wrapref;
4714 case '%':
11343788 4715 if (o2->op_type != OP_RV2HV && o2->op_type != OP_PADHV)
5dc0d613 4716 bad_type(arg, "hash", gv_ename(namegv), o2);
4633a7c4
LW		 4717 wrapref:
4718 {
11343788
MB		 4719 OP* kid = o2;
4720 o2 = newUNOP(OP_REFGEN, 0, kid);
4721 o2->op_sibling = kid->op_sibling;
4633a7c4 4722 kid->op_sibling = 0;
e858de61 4723 prev->op_sibling = o2;
4633a7c4
LW		 4724 }
4725 break;
4726 default: goto oops;
4727 }
4728 break;
b1cb66bf 4729 case ' ':
4730 proto++;
4731 continue;
4633a7c4
LW		 4732 default:
4733 oops:
4734 croak("Malformed prototype for %s: %s",
46fc3d4c 4735 gv_ename(namegv), SvPV((SV*)cv, na));
4633a7c4
LW		 4736 }
4737 }
4738 else
11343788
MB		 4739 list(o2);
4740 mod(o2, OP_ENTERSUB);
4741 prev = o2;
4742 o2 = o2->op_sibling;
4633a7c4
LW		 4743 }
4744 if (proto && !optional && *proto == '$')
5dc0d613 4745 return too_few_arguments(o, gv_ename(namegv));
11343788 4746 return o;
79072805
LW		 4747}
4748
4749OP *
11343788
MB		 4750ck_svconst(o)
4751OP *o;
8990e307 4752{
11343788
MB		 4753 SvREADONLY_on(cSVOPo->op_sv);
4754 return o;
8990e307
LW		 4755}
4756
4757OP *
11343788
MB		 4758ck_trunc(o)
4759OP *o;
79072805 4760{
11343788
MB		 4761 if (o->op_flags & OPf_KIDS) {
4762 SVOP *kid = (SVOP*)cUNOPo->op_first;
79072805 4763
a0d0e21e
LW		 4764 if (kid->op_type == OP_NULL)
4765 kid = (SVOP*)kid->op_sibling;
4766 if (kid &&
4767 kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
11343788 4768 o->op_flags |= OPf_SPECIAL;
79072805 4769 }
11343788 4770 return ck_fun(o);
79072805
LW		 4771}
4772
463ee0b2
LW		 4773/* A peephole optimizer. We visit the ops in the order they're to execute. */
4774
79072805 4775void
a0d0e21e
LW		 4776peep(o)
4777register OP* o;
79072805 4778{
11343788 4779 dTHR;
79072805 4780 register OP* oldop = 0;
a0d0e21e 4781 if (!o || o->op_seq)
79072805 4782 return;
a0d0e21e 4783 ENTER;
462e5cf6 4784 SAVEOP();
a0d0e21e
LW		 4785 SAVESPTR(curcop);
4786 for (; o; o = o->op_next) {
4787 if (o->op_seq)
4788 break;
c07a80fd 4789 if (!op_seqmax)
4790 op_seqmax++;
a0d0e21e
LW		 4791 op = o;
4792 switch (o->op_type) {
4793 case OP_NEXTSTATE:
4794 case OP_DBSTATE:
4795 curcop = ((COP*)o); /* for warnings */
c07a80fd 4796 o->op_seq = op_seqmax++;
a0d0e21e
LW		 4797 break;
4798
4799 case OP_CONCAT:
4800 case OP_CONST:
4801 case OP_JOIN:
4802 case OP_UC:
4803 case OP_UCFIRST:
4804 case OP_LC:
4805 case OP_LCFIRST:
4806 case OP_QUOTEMETA:
4807 if (o->op_next->op_type == OP_STRINGIFY)
4808 null(o->op_next);
c07a80fd 4809 o->op_seq = op_seqmax++;
a0d0e21e 4810 break;
8990e307 4811 case OP_STUB:
54310121 4812 if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
c07a80fd 4813 o->op_seq = op_seqmax++;
54310121 4814 break; /* Scalar stub must produce undef. List stub is noop */
8990e307 4815 }
748a9306 4816 goto nothin;
79072805 4817 case OP_NULL:
748a9306
LW		 4818 if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
4819 curcop = ((COP*)op);
4820 goto nothin;
79072805 4821 case OP_SCALAR:
93a17b20 4822 case OP_LINESEQ:
463ee0b2 4823 case OP_SCOPE:
748a9306 4824 nothin:
a0d0e21e
LW		 4825 if (oldop && o->op_next) {
4826 oldop->op_next = o->op_next;
79072805
LW		 4827 continue;
4828 }
c07a80fd 4829 o->op_seq = op_seqmax++;
79072805
LW		 4830 break;
4831
4832 case OP_GV:
a0d0e21e 4833 if (o->op_next->op_type == OP_RV2SV) {
5f05dabc 4834 if (!(o->op_next->op_private & OPpDEREF)) {
a0d0e21e
LW		 4835 null(o->op_next);
4836 o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
4837 o->op_next = o->op_next->op_next;
4838 o->op_type = OP_GVSV;
4839 o->op_ppaddr = ppaddr[OP_GVSV];
8990e307
LW		 4840 }
4841 }
a0d0e21e
LW		 4842 else if (o->op_next->op_type == OP_RV2AV) {
4843 OP* pop = o->op_next->op_next;
4844 IV i;
8990e307 4845 if (pop->op_type == OP_CONST &&
e858de61 4846 (op = pop->op_next) &&
8990e307 4847 pop->op_next->op_type == OP_AELEM &&
a0d0e21e 4848 !(pop->op_next->op_private &
68dc0745 4849 (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF)) &&
a0d0e21e
LW		 4850 (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
4851 <= 255 &&
8990e307
LW		 4852 i >= 0)
4853 {
748a9306 4854 SvREFCNT_dec(((SVOP*)pop)->op_sv);
a0d0e21e 4855 null(o->op_next);
8990e307
LW		 4856 null(pop->op_next);
4857 null(pop);
a0d0e21e
LW		 4858 o->op_flags |= pop->op_next->op_flags & OPf_MOD;
4859 o->op_next = pop->op_next->op_next;
4860 o->op_type = OP_AELEMFAST;
4861 o->op_ppaddr = ppaddr[OP_AELEMFAST];
4862 o->op_private = (U8)i;
a6006777 4863 GvAVn(((GVOP*)o)->op_gv);
8990e307 4864 }
79072805 4865 }
c07a80fd 4866 o->op_seq = op_seqmax++;
79072805
LW		 4867 break;
4868
a0d0e21e 4869 case OP_MAPWHILE:
79072805
LW		 4870 case OP_GREPWHILE:
4871 case OP_AND:
4872 case OP_OR:
c07a80fd 4873 o->op_seq = op_seqmax++;
79072805
LW		 4874 peep(cLOGOP->op_other);
4875 break;
4876
4877 case OP_COND_EXPR:
c07a80fd 4878 o->op_seq = op_seqmax++;
79072805
LW		 4879 peep(cCONDOP->op_true);
4880 peep(cCONDOP->op_false);
4881 break;
4882
4883 case OP_ENTERLOOP:
c07a80fd 4884 o->op_seq = op_seqmax++;
79072805
LW		 4885 peep(cLOOP->op_redoop);
4886 peep(cLOOP->op_nextop);
4887 peep(cLOOP->op_lastop);
4888 break;
4889
4890 case OP_MATCH:
4891 case OP_SUBST:
c07a80fd 4892 o->op_seq = op_seqmax++;
a0d0e21e 4893 peep(cPMOP->op_pmreplstart);
79072805
LW		 4894 break;
4895
a0d0e21e 4896 case OP_EXEC:
c07a80fd 4897 o->op_seq = op_seqmax++;
a0d0e21e
LW		 4898 if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
4899 if (o->op_next->op_sibling &&
4900 o->op_next->op_sibling->op_type != OP_DIE) {
4901 line_t oldline = curcop->cop_line;
4902
4903 curcop->cop_line = ((COP*)o->op_next)->cop_line;
4904 warn("Statement unlikely to be reached");
4905 warn("(Maybe you meant system() when you said exec()?)\n");
4906 curcop->cop_line = oldline;
4907 }
4908 }
4909 break;
c750a3ec
MB		 4910
4911 case OP_HELEM: {
4912 UNOP *rop;
4913 SV *lexname;
4914 GV **fields;
4915 SV **svp, **indsvp;
4916 I32 ind;
4917 char *key;
4918 STRLEN keylen;
4919
4920 if (o->op_private & (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)
4921 || ((BINOP*)o)->op_last->op_type != OP_CONST)
4922 break;
4923 rop = (UNOP*)((BINOP*)o)->op_first;
4924 if (rop->op_type != OP_RV2HV || rop->op_first->op_type != OP_PADSV)
4925 break;
4926 lexname = *av_fetch(comppad_name, rop->op_first->op_targ, TRUE);
4927 if (!SvOBJECT(lexname))
4928 break;
5196be3e 4929 fields = (GV**)hv_fetch(SvSTASH(lexname), "FIELDS", 6, FALSE);
c750a3ec
MB		 4930 if (!fields || !GvHV(*fields))
4931 break;
4932 svp = &((SVOP*)((BINOP*)o)->op_last)->op_sv;
4933 key = SvPV(*svp, keylen);
4934 indsvp = hv_fetch(GvHV(*fields), key, keylen, FALSE);
4935 if (!indsvp) {
4936 croak("No such field \"%s\" in variable %s of type %s",
4937 key, SvPV(lexname, na), HvNAME(SvSTASH(lexname)));
4938 }
4939 ind = SvIV(*indsvp);
4940 if (ind < 1)
4941 croak("Bad index while coercing array into hash");
4942 rop->op_type = OP_RV2AV;
4943 rop->op_ppaddr = ppaddr[OP_RV2AV];
4944 o->op_type = OP_AELEM;
4945 o->op_ppaddr = ppaddr[OP_AELEM];
4946 SvREFCNT_dec(*svp);
4947 *svp = newSViv(ind);
4948 break;
4949 }
4950
79072805 4951 default:
c07a80fd 4952 o->op_seq = op_seqmax++;
79072805
LW		 4953 break;
4954 }
a0d0e21e 4955 oldop = o;
79072805 4956 }
a0d0e21e 4957 LEAVE;
79072805 4958}
Unnamed repository; edit this file 'description' to name the repository.