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