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