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<