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