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
Pod style
[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;
a0d0e21e 814 case OP_NULL:
748a9306
LW		 815 if (op->op_targ == OP_NEXTSTATE || op->op_targ == OP_DBSTATE)
816 curcop = ((COP*)op); /* for warning below */
a0d0e21e
LW		 817 if (op->op_flags & OPf_STACKED)
818 break;
54310121 819
820 case OP_REQUIRE:
821 /* since all requires must return a value, they're never void */
822 op->op_flags &= ~OPf_WANT;
823 return scalar(op);
824
79072805
LW		 825 case OP_ENTERTRY:
826 case OP_ENTER:
827 case OP_SCALAR:
79072805
LW		 828 if (!(op->op_flags & OPf_KIDS))
829 break;
54310121 830 /* FALL THROUGH */
463ee0b2 831 case OP_SCOPE:
79072805
LW		 832 case OP_LEAVE:
833 case OP_LEAVETRY:
a0d0e21e 834 case OP_LEAVELOOP:
79072805 835 case OP_LINESEQ:
79072805 836 case OP_LIST:
79072805
LW		 837 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
838 scalarvoid(kid);
839 break;
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;
3188 if (!sv)
3189 return Nullsv;
3190 if (!SvREADONLY(sv)) {
3191 if (SvREFCNT(sv) > 1)
3192 return Nullsv;
3193 SvREADONLY_on(sv);
3194 }
760ac839 3195 }
54310121 3196 else
3197 return Nullsv;
760ac839
LW		 3198 }
3199 return sv;
3200}
3201
748a9306 3202CV *
4633a7c4 3203newSUB(floor,op,proto,block)
79072805
LW		 3204I32 floor;
3205OP *op;
4633a7c4 3206OP *proto;
79072805
LW		 3207OP *block;
3208{
44a8e56a 3209 char *name = op ? SvPVx(cSVOP->op_sv, na) : Nullch;
3210 GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
3fe9a6f1 3211 char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch;
79072805 3212 register CV *cv;
a0d0e21e 3213 I32 ix;
79072805 3214
44a8e56a 3215 if (op)
8ebc5c01 3216 SAVEFREEOP(op);
3fe9a6f1 3217 if (proto)
3218 SAVEFREEOP(proto);
3219
68dc0745 3220 if (!name || GvCVGEN(gv))
3221 cv = Nullcv;
3222 else if (cv = GvCV(gv)) {
3fe9a6f1 3223 cv_ckproto(cv, gv, ps);
68dc0745 3224 /* already defined (or promised)? */
3225 if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
3226 SV* const_sv;
aa689395 3227 if (!block) {
3228 /* just a "sub foo;" when &foo is already defined */
3229 SAVEFREESV(compcv);
3230 goto done;
3231 }
68dc0745 3232 const_sv = cv_const_sv(cv);
44a8e56a 3233 if (const_sv || dowarn) {
79072805 3234 line_t oldline = curcop->cop_line;
79072805 3235 curcop->cop_line = copline;
760ac839 3236 warn(const_sv ? "Constant subroutine %s redefined"
68dc0745 3237 : "Subroutine %s redefined", name);
79072805
LW		 3238 curcop->cop_line = oldline;
3239 }
8990e307 3240 SvREFCNT_dec(cv);
68dc0745 3241 cv = Nullcv;
79072805
LW		 3242 }
3243 }
a0d0e21e 3244 if (cv) { /* must reuse cv if autoloaded */
4633a7c4 3245 cv_undef(cv);
44a8e56a 3246 CvFLAGS(cv) = CvFLAGS(compcv);
748a9306 3247 CvOUTSIDE(cv) = CvOUTSIDE(compcv);
e9a444f0 3248 CvOUTSIDE(compcv) = 0;
748a9306 3249 CvPADLIST(cv) = CvPADLIST(compcv);
4aa0a1f7 3250 CvPADLIST(compcv) = 0;
4633a7c4
LW		 3251 if (SvREFCNT(compcv) > 1) /* XXX Make closures transit through stub. */
3252 CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)cv);
748a9306 3253 SvREFCNT_dec(compcv);
a0d0e21e
LW		 3254 }
3255 else {
748a9306 3256 cv = compcv;
44a8e56a 3257 if (name) {
3258 GvCV(gv) = cv;
3259 GvCVGEN(gv) = 0;
3260 sub_generation++;
3261 }
a0d0e21e 3262 }
44a8e56a 3263 CvGV(cv) = (GV*)SvREFCNT_inc(gv);
79072805 3264 CvFILEGV(cv) = curcop->cop_filegv;
8990e307
LW		 3265 CvSTASH(cv) = curstash;
3266
3fe9a6f1 3267 if (ps)
3268 sv_setpv((SV*)cv, ps);
4633a7c4 3269
c07a80fd 3270 if (error_count) {
3271 op_free(block);
3272 block = Nullop;
68dc0745 3273 if (name) {
3274 char *s = strrchr(name, ':');
3275 s = s ? s+1 : name;
3276 if (strEQ(s, "BEGIN"))
3277 croak("BEGIN not safe after errors--compilation aborted");
3278 }
c07a80fd 3279 }
a0d0e21e 3280 if (!block) {
a0d0e21e
LW		 3281 copline = NOLINE;
3282 LEAVE_SCOPE(floor);
3283 return cv;
3284 }
3285
54310121 3286 if (AvFILL(comppad_name) < AvFILL(comppad))
3287 av_store(comppad_name, AvFILL(comppad), Nullsv);
a0d0e21e 3288
54310121 3289 if (CvCLONE(cv)) {
3290 SV **namep = AvARRAY(comppad_name);
3291 for (ix = AvFILL(comppad); ix > 0; ix--) {
3292 SV *namesv;
3293
3294 if (SvIMMORTAL(curpad[ix]))
3295 continue;
3296 /*
3297 * The only things that a clonable function needs in its
3298 * pad are references to outer lexicals and anonymous subs.
3299 * The rest are created anew during cloning.
3300 */
3301 if (!((namesv = namep[ix]) != Nullsv &&
3302 namesv != &sv_undef &&
3303 (SvFAKE(namesv) ||
3304 *SvPVX(namesv) == '&')))
3305 {
3306 SvREFCNT_dec(curpad[ix]);
3307 curpad[ix] = Nullsv;
3308 }
3309 }
a0d0e21e 3310 }
54310121 3311 else {
3312 AV *av = newAV(); /* Will be @_ */
3313 av_extend(av, 0);
3314 av_store(comppad, 0, (SV*)av);
3315 AvFLAGS(av) = AVf_REIFY;
79072805 3316
54310121 3317 for (ix = AvFILL(comppad); ix > 0; ix--) {
3318 if (SvIMMORTAL(curpad[ix]))
3319 continue;
3320 if (!SvPADMY(curpad[ix]))
3321 SvPADTMP_on(curpad[ix]);
3322 }
3323 }
79072805 3324
a0d0e21e 3325 CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
79072805
LW		 3326 CvSTART(cv) = LINKLIST(CvROOT(cv));
3327 CvROOT(cv)->op_next = 0;
3328 peep(CvSTART(cv));
a6006777 3329
44a8e56a 3330 if (name) {
3331 char *s;
3332
3333 if (perldb && curstash != debstash) {
3334 SV *sv;
3335 SV *tmpstr = sv_newmortal();
3336 static GV *db_postponed;
3337 CV *cv;
3338 HV *hv;
3339
3340 sprintf(buf, "%s:%ld",
3341 SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
3342 sv = newSVpv(buf,0);
3343 sv_catpv(sv,"-");
3344 sprintf(buf,"%ld",(long)curcop->cop_line);
3345 sv_catpv(sv,buf);
3346 gv_efullname3(tmpstr, gv, Nullch);
3347 hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
3348 if (!db_postponed) {
6bbcb22c 3349 db_postponed = gv_fetchpv("DB::postponed", GV_ADDMULTI, SVt_PVHV);
44a8e56a 3350 }
3351 hv = GvHVn(db_postponed);
9607fc9c 3352 if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
3353 && (cv = GvCV(db_postponed))) {
44a8e56a 3354 dSP;
3355 PUSHMARK(sp);
3356 XPUSHs(tmpstr);
3357 PUTBACK;
3358 perl_call_sv((SV*)cv, G_DISCARD);
3359 }
3360 }
3361
3362 if ((s = strrchr(name,':')))
28757baa 3363 s++;
3364 else
3365 s = name;
68dc0745 3366 if (strEQ(s, "BEGIN")) {
2ae324a7 3367 I32 oldscope = scopestack_ix;
28757baa 3368 ENTER;
3369 SAVESPTR(compiling.cop_filegv);
3370 SAVEI16(compiling.cop_line);
3371 SAVEI32(perldb);
3372 save_svref(&rs);
3373 sv_setsv(rs, nrs);
3374
3375 if (!beginav)
3376 beginav = newAV();
3377 DEBUG_x( dump_sub(gv) );
3378 av_push(beginav, (SV *)cv);
3379 GvCV(gv) = 0;
68dc0745 3380 call_list(oldscope, beginav);
a6006777 3381
28757baa 3382 curcop = &compiling;
3383 LEAVE;
3384 }
3385 else if (strEQ(s, "END") && !error_count) {
3386 if (!endav)
3387 endav = newAV();
3388 av_unshift(endav, 1);
3389 av_store(endav, 0, (SV *)cv);
3390 GvCV(gv) = 0;
3391 }
93a17b20 3392 }
a6006777 3393
aa689395 3394 done:
a6006777 3395 copline = NOLINE;
3396 LEAVE_SCOPE(floor);
a0d0e21e 3397 return cv;
79072805
LW		 3398}
3399
a0d0e21e
LW		 3400#ifdef DEPRECATED
3401CV *
463ee0b2 3402newXSUB(name, ix, subaddr, filename)
79072805
LW		 3403char *name;
3404I32 ix;
3405I32 (*subaddr)();
3406char *filename;
3407{
a0d0e21e 3408 CV* cv = newXS(name, (void(*)())subaddr, filename);
a5f75d66 3409 CvOLDSTYLE_on(cv);
a0d0e21e
LW		 3410 CvXSUBANY(cv).any_i32 = ix;
3411 return cv;
3412}
3413#endif
3414
3415CV *
3416newXS(name, subaddr, filename)
3417char *name;
3418void (*subaddr) _((CV*));
3419char *filename;
3420{
44a8e56a 3421 GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
79072805 3422 register CV *cv;
44a8e56a 3423
3424 if (cv = (name ? GvCV(gv) : Nullcv)) {
3425 if (GvCVGEN(gv)) {
3426 /* just a cached method */
3427 SvREFCNT_dec(cv);
3428 cv = 0;
3429 }
3430 else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
3431 /* already defined (or promised) */
a0d0e21e
LW		 3432 if (dowarn) {
3433 line_t oldline = curcop->cop_line;
a0d0e21e
LW		 3434 curcop->cop_line = copline;
3435 warn("Subroutine %s redefined",name);
3436 curcop->cop_line = oldline;
3437 }
3438 SvREFCNT_dec(cv);
3439 cv = 0;
79072805 3440 }
79072805 3441 }
44a8e56a 3442
3443 if (cv) /* must reuse cv if autoloaded */
3444 cv_undef(cv);
a0d0e21e
LW		 3445 else {
3446 cv = (CV*)NEWSV(1105,0);
3447 sv_upgrade((SV *)cv, SVt_PVCV);
44a8e56a 3448 if (name) {
3449 GvCV(gv) = cv;
3450 GvCVGEN(gv) = 0;
3451 sub_generation++;
3452 }
a0d0e21e 3453 }
44a8e56a 3454 CvGV(cv) = (GV*)SvREFCNT_inc(gv);
79072805 3455 CvFILEGV(cv) = gv_fetchfile(filename);
a0d0e21e 3456 CvXSUB(cv) = subaddr;
44a8e56a 3457
28757baa 3458 if (name) {
3459 char *s = strrchr(name,':');
3460 if (s)
3461 s++;
3462 else
3463 s = name;
3464 if (strEQ(s, "BEGIN")) {
3465 if (!beginav)
3466 beginav = newAV();
44a8e56a 3467 av_push(beginav, (SV *)cv);
3468 GvCV(gv) = 0;
28757baa 3469 }
3470 else if (strEQ(s, "END")) {
3471 if (!endav)
3472 endav = newAV();
3473 av_unshift(endav, 1);
44a8e56a 3474 av_store(endav, 0, (SV *)cv);
3475 GvCV(gv) = 0;
28757baa 3476 }
3477 }
44a8e56a 3478 else
a5f75d66 3479 CvANON_on(cv);
44a8e56a 3480
a0d0e21e 3481 return cv;
79072805
LW		 3482}
3483
3484void
3485newFORM(floor,op,block)
3486I32 floor;
3487OP *op;
3488OP *block;
3489{
3490 register CV *cv;
3491 char *name;
3492 GV *gv;
a0d0e21e 3493 I32 ix;
79072805
LW		 3494
3495 if (op)
463ee0b2 3496 name = SvPVx(cSVOP->op_sv, na);
79072805
LW		 3497 else
3498 name = "STDOUT";
85e6fe83 3499 gv = gv_fetchpv(name,TRUE, SVt_PVFM);
a5f75d66 3500 GvMULTI_on(gv);
79072805
LW		 3501 if (cv = GvFORM(gv)) {
3502 if (dowarn) {
3503 line_t oldline = curcop->cop_line;
3504
3505 curcop->cop_line = copline;
3506 warn("Format %s redefined",name);
3507 curcop->cop_line = oldline;
3508 }
8990e307 3509 SvREFCNT_dec(cv);
79072805 3510 }
748a9306 3511 cv = compcv;
79072805 3512 GvFORM(gv) = cv;
44a8e56a 3513 CvGV(cv) = (GV*)SvREFCNT_inc(gv);
79072805
LW		 3514 CvFILEGV(cv) = curcop->cop_filegv;
3515
a0d0e21e 3516 for (ix = AvFILL(comppad); ix > 0; ix--) {
44a8e56a 3517 if (!SvPADMY(curpad[ix]) && !SvIMMORTAL(curpad[ix]))
a0d0e21e
LW		 3518 SvPADTMP_on(curpad[ix]);
3519 }
3520
79072805
LW		 3521 CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
3522 CvSTART(cv) = LINKLIST(CvROOT(cv));
3523 CvROOT(cv)->op_next = 0;
3524 peep(CvSTART(cv));
79072805
LW		 3525 op_free(op);
3526 copline = NOLINE;
8990e307 3527 LEAVE_SCOPE(floor);
79072805
LW		 3528}
3529
3530OP *
79072805
LW		 3531newANONLIST(op)
3532OP* op;
3533{
93a17b20 3534 return newUNOP(OP_REFGEN, 0,
a0d0e21e 3535 mod(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN));
79072805
LW		 3536}
3537
3538OP *
3539newANONHASH(op)
3540OP* op;
3541{
93a17b20 3542 return newUNOP(OP_REFGEN, 0,
a0d0e21e
LW		 3543 mod(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN));
3544}
3545
3546OP *
4633a7c4 3547newANONSUB(floor, proto, block)
a0d0e21e 3548I32 floor;
4633a7c4 3549OP *proto;
a0d0e21e
LW		 3550OP *block;
3551{
3552 return newUNOP(OP_REFGEN, 0,
4633a7c4 3553 newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, proto, block)));
79072805
LW		 3554}
3555
3556OP *
3557oopsAV(o)
3558OP *o;
3559{
ed6116ce
LW		 3560 switch (o->op_type) {
3561 case OP_PADSV:
3562 o->op_type = OP_PADAV;
3563 o->op_ppaddr = ppaddr[OP_PADAV];
3564 return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV);
3565
3566 case OP_RV2SV:
79072805
LW		 3567 o->op_type = OP_RV2AV;
3568 o->op_ppaddr = ppaddr[OP_RV2AV];
3569 ref(o, OP_RV2AV);
ed6116ce
LW		 3570 break;
3571
3572 default:
79072805 3573 warn("oops: oopsAV");
ed6116ce
LW		 3574 break;
3575 }
79072805
LW		 3576 return o;
3577}
3578
3579OP *
3580oopsHV(o)
3581OP *o;
3582{
ed6116ce
LW		 3583 switch (o->op_type) {
3584 case OP_PADSV:
3585 case OP_PADAV:
3586 o->op_type = OP_PADHV;
3587 o->op_ppaddr = ppaddr[OP_PADHV];
3588 return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV);
3589
3590 case OP_RV2SV:
3591 case OP_RV2AV:
79072805
LW		 3592 o->op_type = OP_RV2HV;
3593 o->op_ppaddr = ppaddr[OP_RV2HV];
3594 ref(o, OP_RV2HV);
ed6116ce
LW		 3595 break;
3596
3597 default:
79072805 3598 warn("oops: oopsHV");
ed6116ce
LW		 3599 break;
3600 }
79072805
LW		 3601 return o;
3602}
3603
3604OP *
3605newAVREF(o)
3606OP *o;
3607{
ed6116ce
LW		 3608 if (o->op_type == OP_PADANY) {
3609 o->op_type = OP_PADAV;
3610 o->op_ppaddr = ppaddr[OP_PADAV];
93a17b20 3611 return o;
ed6116ce 3612 }
79072805
LW		 3613 return newUNOP(OP_RV2AV, 0, scalar(o));
3614}
3615
3616OP *
a0d0e21e
LW		 3617newGVREF(type,o)
3618I32 type;
79072805
LW		 3619OP *o;
3620{
a0d0e21e
LW		 3621 if (type == OP_MAPSTART)
3622 return newUNOP(OP_NULL, 0, o);
748a9306 3623 return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
79072805
LW		 3624}
3625
3626OP *
3627newHVREF(o)
3628OP *o;
3629{
ed6116ce
LW		 3630 if (o->op_type == OP_PADANY) {
3631 o->op_type = OP_PADHV;
3632 o->op_ppaddr = ppaddr[OP_PADHV];
93a17b20 3633 return o;
ed6116ce 3634 }
79072805
LW		 3635 return newUNOP(OP_RV2HV, 0, scalar(o));
3636}
3637
3638OP *
3639oopsCV(o)
3640OP *o;
3641{
463ee0b2 3642 croak("NOT IMPL LINE %d",__LINE__);
79072805
LW		 3643 /* STUB */
3644 return o;
3645}
3646
3647OP *
c07a80fd 3648newCVREF(flags, o)
3649I32 flags;
79072805
LW		 3650OP *o;
3651{
c07a80fd 3652 return newUNOP(OP_RV2CV, flags, scalar(o));
79072805
LW		 3653}
3654
3655OP *
3656newSVREF(o)
3657OP *o;
3658{
ed6116ce
LW		 3659 if (o->op_type == OP_PADANY) {
3660 o->op_type = OP_PADSV;
3661 o->op_ppaddr = ppaddr[OP_PADSV];
93a17b20 3662 return o;
ed6116ce 3663 }
79072805
LW		 3664 return newUNOP(OP_RV2SV, 0, scalar(o));
3665}
3666
3667/* Check routines. */
3668
3669OP *
5f05dabc 3670ck_anoncode(op)
3671OP *op;
3672{
178c6305
CS		 3673 PADOFFSET ix;
3674 SV* name;
3675
3676 name = NEWSV(1106,0);
3677 sv_upgrade(name, SVt_PVNV);
3678 sv_setpvn(name, "&", 1);
3679 SvIVX(name) = -1;
3680 SvNVX(name) = 1;
3681 ix = pad_alloc(op->op_type, SVs_PADMY);
3682 av_store(comppad_name, ix, name);
5f05dabc 3683 av_store(comppad, ix, cSVOP->op_sv);
3684 SvPADMY_on(cSVOP->op_sv);
3685 cSVOP->op_sv = Nullsv;
3686 cSVOP->op_targ = ix;
3687 return op;
3688}
3689
3690OP *
55497cff 3691ck_bitop(op)
3692OP *op;
3693{
3694 op->op_private = hints;
3695 return op;
3696}
3697
3698OP *
79072805
LW		 3699ck_concat(op)
3700OP *op;
3701{
3702 if (cUNOP->op_first->op_type == OP_CONCAT)
3703 op->op_flags |= OPf_STACKED;
3704 return op;
3705}
3706
3707OP *
a0d0e21e 3708ck_spair(op)
79072805
LW		 3709OP *op;
3710{
3711 if (op->op_flags & OPf_KIDS) {
3712 OP* newop;
a0d0e21e 3713 OP* kid;
8ebc5c01 3714 OPCODE type = op->op_type;
3715 op = modkids(ck_fun(op), type);
a0d0e21e
LW		 3716 kid = cUNOP->op_first;
3717 newop = kUNOP->op_first->op_sibling;
3718 if (newop &&
3719 (newop->op_sibling ||
3720 !(opargs[newop->op_type] & OA_RETSCALAR) ||
3721 newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
3722 newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
3723
79072805 3724 return op;
a0d0e21e
LW		 3725 }
3726 op_free(kUNOP->op_first);
3727 kUNOP->op_first = newop;
3728 }
3729 op->op_ppaddr = ppaddr[++op->op_type];
3730 return ck_fun(op);
3731}
3732
3733OP *
3734ck_delete(op)
3735OP *op;
3736{
3737 op = ck_fun(op);
5f05dabc 3738 op->op_private = 0;
a0d0e21e
LW		 3739 if (op->op_flags & OPf_KIDS) {
3740 OP *kid = cUNOP->op_first;
5f05dabc 3741 if (kid->op_type == OP_HSLICE)
3742 op->op_private |= OPpSLICE;
3743 else if (kid->op_type != OP_HELEM)
3744 croak("%s argument is not a HASH element or slice",
3745 op_desc[op->op_type]);
a0d0e21e 3746 null(kid);
79072805 3747 }
79072805
LW		 3748 return op;
3749}
3750
3751OP *
3752ck_eof(op)
3753OP *op;
3754{
3755 I32 type = op->op_type;
3756
8990e307
LW		 3757 if (op->op_flags & OPf_KIDS) {
3758 if (cLISTOP->op_first->op_type == OP_STUB) {
3759 op_free(op);
3760 op = newUNOP(type, OPf_SPECIAL,
85e6fe83 3761 newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV)));
8990e307 3762 }
79072805 3763 return ck_fun(op);
79072805
LW		 3764 }
3765 return op;
3766}
3767
3768OP *
3769ck_eval(op)
3770OP *op;
3771{
85e6fe83 3772 hints |= HINT_BLOCK_SCOPE;
79072805
LW		 3773 if (op->op_flags & OPf_KIDS) {
3774 SVOP *kid = (SVOP*)cUNOP->op_first;
3775
93a17b20
LW		 3776 if (!kid) {
3777 op->op_flags &= ~OPf_KIDS;
8990e307 3778 null(op);
79072805
LW		 3779 }
3780 else if (kid->op_type == OP_LINESEQ) {
3781 LOGOP *enter;
3782
3783 kid->op_next = op->op_next;
3784 cUNOP->op_first = 0;
3785 op_free(op);
3786
3787 Newz(1101, enter, 1, LOGOP);
3788 enter->op_type = OP_ENTERTRY;
3789 enter->op_ppaddr = ppaddr[OP_ENTERTRY];
3790 enter->op_private = 0;
3791
3792 /* establish postfix order */
3793 enter->op_next = (OP*)enter;
3794
463ee0b2 3795 op = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
79072805
LW		 3796 op->op_type = OP_LEAVETRY;
3797 op->op_ppaddr = ppaddr[OP_LEAVETRY];
3798 enter->op_other = op;
3799 return op;
3800 }
3801 }
3802 else {
3803 op_free(op);
3804 op = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3805 }
a0d0e21e 3806 op->op_targ = (PADOFFSET)hints;
79072805
LW		 3807 return op;
3808}
3809
3810OP *
3811ck_exec(op)
3812OP *op;
3813{
3814 OP *kid;
79072805 3815 if (op->op_flags & OPf_STACKED) {
463ee0b2 3816 op = ck_fun(op);
79072805 3817 kid = cUNOP->op_first->op_sibling;
8990e307
LW		 3818 if (kid->op_type == OP_RV2GV)
3819 null(kid);
79072805 3820 }
463ee0b2
LW		 3821 else
3822 op = listkids(op);
79072805
LW		 3823 return op;
3824}
3825
3826OP *
5f05dabc 3827ck_exists(op)
3828OP *op;
3829{
3830 op = ck_fun(op);
3831 if (op->op_flags & OPf_KIDS) {
3832 OP *kid = cUNOP->op_first;
3833 if (kid->op_type != OP_HELEM)
3834 croak("%s argument is not a HASH element", op_desc[op->op_type]);
3835 null(kid);
3836 }
3837 return op;
3838}
3839
3840OP *
79072805
LW		 3841ck_gvconst(o)
3842register OP *o;
3843{
3844 o = fold_constants(o);
3845 if (o->op_type == OP_CONST)
3846 o->op_type = OP_GV;
3847 return o;
3848}
3849
3850OP *
3851ck_rvconst(op)
3852register OP *op;
3853{
3854 SVOP *kid = (SVOP*)cUNOP->op_first;
85e6fe83 3855
c07a80fd 3856 op->op_private |= (hints & HINT_STRICT_REFS);
79072805 3857 if (kid->op_type == OP_CONST) {
44a8e56a 3858 char *name;
3859 int iscv;
3860 GV *gv;
3861
3862 name = SvPV(kid->op_sv, na);
3863 if ((hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
3864 char *badthing = Nullch;
3865 switch (op->op_type) {
3866 case OP_RV2SV:
3867 badthing = "a SCALAR";
3868 break;
3869 case OP_RV2AV:
3870 badthing = "an ARRAY";
3871 break;
3872 case OP_RV2HV:
3873 badthing = "a HASH";
3874 break;
3875 }
3876 if (badthing)
3877 croak(
3878 "Can't use bareword (\"%s\") as %s ref while \"strict refs\" in use",
3879 name, badthing);
3880 }
79072805 3881 kid->op_type = OP_GV;
44a8e56a 3882 iscv = (op->op_type == OP_RV2CV) * 2;
a0d0e21e 3883 for (gv = 0; !gv; iscv++) {
748a9306
LW		 3884 /*
3885 * This is a little tricky. We only want to add the symbol if we
3886 * didn't add it in the lexer. Otherwise we get duplicate strict
3887 * warnings. But if we didn't add it in the lexer, we must at
3888 * least pretend like we wanted to add it even if it existed before,
3889 * or we get possible typo warnings. OPpCONST_ENTERED says
3890 * whether the lexer already added THIS instance of this symbol.
3891 */
44a8e56a 3892 gv = gv_fetchpv(name,
748a9306 3893 iscv | !(kid->op_private & OPpCONST_ENTERED),
a0d0e21e
LW		 3894 iscv
3895 ? SVt_PVCV
3896 : op->op_type == OP_RV2SV
3897 ? SVt_PV
3898 : op->op_type == OP_RV2AV
3899 ? SVt_PVAV
3900 : op->op_type == OP_RV2HV
3901 ? SVt_PVHV
3902 : SVt_PVGV);
3903 }
adbc6bb1 3904 SvREFCNT_dec(kid->op_sv);
a0d0e21e 3905 kid->op_sv = SvREFCNT_inc(gv);
79072805
LW		 3906 }
3907 return op;
3908}
3909
3910OP *
79072805
LW		 3911ck_ftst(op)
3912OP *op;
3913{
3914 I32 type = op->op_type;
3915
a0d0e21e 3916 if (op->op_flags & OPf_REF)
79072805
LW		 3917 return op;
3918
3919 if (op->op_flags & OPf_KIDS) {
3920 SVOP *kid = (SVOP*)cUNOP->op_first;
3921
3922 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
a0d0e21e 3923 OP *newop = newGVOP(type, OPf_REF,
85e6fe83 3924 gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
79072805
LW		 3925 op_free(op);
3926 return newop;
3927 }
3928 }
3929 else {
3930 op_free(op);
3931 if (type == OP_FTTTY)
a0d0e21e 3932 return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
85e6fe83 3933 SVt_PVIO));
79072805
LW		 3934 else
3935 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3936 }
3937 return op;
3938}
3939
3940OP *
3941ck_fun(op)
3942OP *op;
3943{
3944 register OP *kid;
3945 OP **tokid;
3946 OP *sibl;
3947 I32 numargs = 0;
a0d0e21e
LW		 3948 int type = op->op_type;
3949 register I32 oa = opargs[type] >> OASHIFT;
79072805
LW		 3950
3951 if (op->op_flags & OPf_STACKED) {
3952 if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
3953 oa &= ~OA_OPTIONAL;
3954 else
3955 return no_fh_allowed(op);
3956 }
3957
3958 if (op->op_flags & OPf_KIDS) {
3959 tokid = &cLISTOP->op_first;
3960 kid = cLISTOP->op_first;
8990e307
LW		 3961 if (kid->op_type == OP_PUSHMARK ||
3962 kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
3963 {
79072805
LW		 3964 tokid = &kid->op_sibling;
3965 kid = kid->op_sibling;
3966 }
a0d0e21e
LW		 3967 if (!kid && opargs[type] & OA_DEFGV)
3968 *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
79072805
LW		 3969
3970 while (oa && kid) {
3971 numargs++;
3972 sibl = kid->op_sibling;
3973 switch (oa & 7) {
3974 case OA_SCALAR:
3975 scalar(kid);
3976 break;
3977 case OA_LIST:
3978 if (oa < 16) {
3979 kid = 0;
3980 continue;
3981 }
3982 else
3983 list(kid);
3984 break;
3985 case OA_AVREF:
3986 if (kid->op_type == OP_CONST &&
3987 (kid->op_private & OPpCONST_BARE)) {
463ee0b2 3988 char *name = SvPVx(((SVOP*)kid)->op_sv, na);
79072805 3989 OP *newop = newAVREF(newGVOP(OP_GV, 0,
85e6fe83 3990 gv_fetchpv(name, TRUE, SVt_PVAV) ));
463ee0b2 3991 if (dowarn)
ff0cee69 3992 warn("Array @%s missing the @ in argument %ld of %s()",
3993 name, (long)numargs, op_desc[type]);
79072805
LW		 3994 op_free(kid);
3995 kid = newop;
3996 kid->op_sibling = sibl;
3997 *tokid = kid;
3998 }
8990e307 3999 else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
c07a80fd 4000 bad_type(numargs, "array", op_desc[op->op_type], kid);
a0d0e21e 4001 mod(kid, type);
79072805
LW		 4002 break;
4003 case OA_HVREF:
4004 if (kid->op_type == OP_CONST &&
4005 (kid->op_private & OPpCONST_BARE)) {
463ee0b2 4006 char *name = SvPVx(((SVOP*)kid)->op_sv, na);
79072805 4007 OP *newop = newHVREF(newGVOP(OP_GV, 0,
85e6fe83 4008 gv_fetchpv(name, TRUE, SVt_PVHV) ));
463ee0b2 4009 if (dowarn)
ff0cee69 4010 warn("Hash %%%s missing the %% in argument %ld of %s()",
4011 name, (long)numargs, op_desc[type]);
79072805
LW		 4012 op_free(kid);
4013 kid = newop;
4014 kid->op_sibling = sibl;
4015 *tokid = kid;
4016 }
8990e307 4017 else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
c07a80fd 4018 bad_type(numargs, "hash", op_desc[op->op_type], kid);
a0d0e21e 4019 mod(kid, type);
79072805
LW		 4020 break;
4021 case OA_CVREF:
4022 {
a0d0e21e 4023 OP *newop = newUNOP(OP_NULL, 0, kid);
79072805
LW		 4024 kid->op_sibling = 0;
4025 linklist(kid);
4026 newop->op_next = newop;
4027 kid = newop;
4028 kid->op_sibling = sibl;
4029 *tokid = kid;
4030 }
4031 break;
4032 case OA_FILEREF:
4033 if (kid->op_type != OP_GV) {
4034 if (kid->op_type == OP_CONST &&
4035 (kid->op_private & OPpCONST_BARE)) {
4036 OP *newop = newGVOP(OP_GV, 0,
85e6fe83
LW		 4037 gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE,
4038 SVt_PVIO) );
79072805
LW		 4039 op_free(kid);
4040 kid = newop;
4041 }
4042 else {
4043 kid->op_sibling = 0;
4044 kid = newUNOP(OP_RV2GV, 0, scalar(kid));
4045 }
4046 kid->op_sibling = sibl;
4047 *tokid = kid;
4048 }
4049 scalar(kid);
4050 break;
4051 case OA_SCALARREF:
a0d0e21e 4052 mod(scalar(kid), type);
79072805
LW		 4053 break;
4054 }
4055 oa >>= 4;
4056 tokid = &kid->op_sibling;
4057 kid = kid->op_sibling;
4058 }
c07a80fd 4059 op->op_private |= numargs;
79072805 4060 if (kid)
c07a80fd 4061 return too_many_arguments(op,op_desc[op->op_type]);
79072805
LW		 4062 listkids(op);
4063 }
a0d0e21e
LW		 4064 else if (opargs[type] & OA_DEFGV) {
4065 op_free(op);
4066 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
4067 }
4068
79072805
LW		 4069 if (oa) {
4070 while (oa & OA_OPTIONAL)
4071 oa >>= 4;
4072 if (oa && oa != OA_LIST)
c07a80fd 4073 return too_few_arguments(op,op_desc[op->op_type]);
79072805
LW		 4074 }
4075 return op;
4076}
4077
4078OP *
4079ck_glob(op)
4080OP *op;
4081{
b1cb66bf 4082 GV *gv = gv_fetchpv("glob", FALSE, SVt_PVCV);
4083
4084 if (gv && GvIMPORTED_CV(gv)) {
4085 op->op_type = OP_LIST;
4086 op->op_ppaddr = ppaddr[OP_LIST];
4087 op = newUNOP(OP_ENTERSUB, OPf_STACKED,
4088 append_elem(OP_LIST, op,
4089 scalar(newUNOP(OP_RV2CV, 0,
4090 newGVOP(OP_GV, 0, gv)))));
4091 return ck_subr(op);
4092 }
0a753a76 4093 if ((op->op_flags & OPf_KIDS) && !cLISTOP->op_first->op_sibling)
4094 append_elem(OP_GLOB, op, newSVREF(newGVOP(OP_GV, 0, defgv)));
b1cb66bf 4095 gv = newGVgen("main");
a0d0e21e 4096 gv_IOadd(gv);
79072805
LW		 4097 append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
4098 scalarkids(op);
a0d0e21e 4099 return ck_fun(op);
79072805
LW		 4100}
4101
4102OP *
4103ck_grep(op)
4104OP *op;
4105{
4106 LOGOP *gwop;
4107 OP *kid;
a0d0e21e 4108 OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
79072805 4109
a0d0e21e
LW		 4110 op->op_ppaddr = ppaddr[OP_GREPSTART];
4111 Newz(1101, gwop, 1, LOGOP);
4112
93a17b20 4113 if (op->op_flags & OPf_STACKED) {
a0d0e21e 4114 OP* k;
93a17b20 4115 op = ck_sort(op);
8e07c86e 4116 kid = cLISTOP->op_first->op_sibling;
a0d0e21e
LW		 4117 for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) {
4118 kid = k;
4119 }
4120 kid->op_next = (OP*)gwop;
93a17b20
LW		 4121 op->op_flags &= ~OPf_STACKED;
4122 }
a0d0e21e
LW		 4123 kid = cLISTOP->op_first->op_sibling;
4124 if (type == OP_MAPWHILE)
4125 list(kid);
4126 else
4127 scalar(kid);
79072805
LW		 4128 op = ck_fun(op);
4129 if (error_count)
4130 return op;
a0d0e21e 4131 kid = cLISTOP->op_first->op_sibling;
79072805 4132 if (kid->op_type != OP_NULL)
463ee0b2 4133 croak("panic: ck_grep");
79072805
LW		 4134 kid = kUNOP->op_first;
4135
a0d0e21e
LW		 4136 gwop->op_type = type;
4137 gwop->op_ppaddr = ppaddr[type];
4138 gwop->op_first = listkids(op);
79072805
LW		 4139 gwop->op_flags |= OPf_KIDS;
4140 gwop->op_private = 1;
4141 gwop->op_other = LINKLIST(kid);
a0d0e21e 4142 gwop->op_targ = pad_alloc(type, SVs_PADTMP);
79072805
LW		 4143 kid->op_next = (OP*)gwop;
4144
a0d0e21e
LW		 4145 kid = cLISTOP->op_first->op_sibling;
4146 if (!kid || !kid->op_sibling)
c07a80fd 4147 return too_few_arguments(op,op_desc[op->op_type]);
a0d0e21e
LW		 4148 for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
4149 mod(kid, OP_GREPSTART);
4150
79072805
LW		 4151 return (OP*)gwop;
4152}
4153
4154OP *
4155ck_index(op)
4156OP *op;
4157{
4158 if (op->op_flags & OPf_KIDS) {
4159 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
4160 if (kid && kid->op_type == OP_CONST)
bbce6d69 4161 fbm_compile(((SVOP*)kid)->op_sv);
79072805
LW		 4162 }
4163 return ck_fun(op);
4164}
4165
4166OP *
4167ck_lengthconst(op)
4168OP *op;
4169{
4170 /* XXX length optimization goes here */
a0d0e21e 4171 return ck_fun(op);
79072805
LW		 4172}
4173
4174OP *
4175ck_lfun(op)
4176OP *op;
4177{
8ebc5c01 4178 OPCODE type = op->op_type;
4179 return modkids(ck_fun(op), type);
79072805
LW		 4180}
4181
4182OP *
8990e307
LW		 4183ck_rfun(op)
4184OP *op;
4185{
8ebc5c01 4186 OPCODE type = op->op_type;
4187 return refkids(ck_fun(op), type);
8990e307
LW		 4188}
4189
4190OP *
79072805
LW		 4191ck_listiob(op)
4192OP *op;
4193{
4194 register OP *kid;
4195
4196 kid = cLISTOP->op_first;
4197 if (!kid) {
8990e307 4198 op = force_list(op);
79072805
LW		 4199 kid = cLISTOP->op_first;
4200 }
4201 if (kid->op_type == OP_PUSHMARK)
4202 kid = kid->op_sibling;
4203 if (kid && op->op_flags & OPf_STACKED)
4204 kid = kid->op_sibling;
4205 else if (kid && !kid->op_sibling) { /* print HANDLE; */
4206 if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
4207 op->op_flags |= OPf_STACKED; /* make it a filehandle */
748a9306 4208 kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
79072805
LW		 4209 cLISTOP->op_first->op_sibling = kid;
4210 cLISTOP->op_last = kid;
4211 kid = kid->op_sibling;
4212 }
4213 }
4214
4215 if (!kid)
4216 append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
4217
bbce6d69 4218 op = listkids(op);
4219
4220 op->op_private = 0;
36477c24 4221#ifdef USE_LOCALE
bbce6d69 4222 if (hints & HINT_LOCALE)
4223 op->op_private |= OPpLOCALE;
4224#endif
4225
4226 return op;
4227}
4228
4229OP *
4230ck_fun_locale(op)
4231OP *op;
4232{
4233 op = ck_fun(op);
4234
4235 op->op_private = 0;
36477c24 4236#ifdef USE_LOCALE
bbce6d69 4237 if (hints & HINT_LOCALE)
4238 op->op_private |= OPpLOCALE;
4239#endif
4240
4241 return op;
4242}
4243
4244OP *
4245ck_scmp(op)
4246OP *op;
4247{
4248 op->op_private = 0;
36477c24 4249#ifdef USE_LOCALE
bbce6d69 4250 if (hints & HINT_LOCALE)
4251 op->op_private |= OPpLOCALE;
4252#endif
36477c24 4253
bbce6d69 4254 return op;
79072805
LW		 4255}
4256
4257OP *
4258ck_match(op)
4259OP *op;
4260{
4261 cPMOP->op_pmflags |= PMf_RUNTIME;
4633a7c4 4262 cPMOP->op_pmpermflags |= PMf_RUNTIME;
79072805
LW		 4263 return op;
4264}
4265
4266OP *
4267ck_null(op)
4268OP *op;
4269{
4270 return op;
4271}
4272
4273OP *
4274ck_repeat(op)
4275OP *op;
4276{
4277 if (cBINOP->op_first->op_flags & OPf_PARENS) {
c07a80fd 4278 op->op_private |= OPpREPEAT_DOLIST;
8990e307 4279 cBINOP->op_first = force_list(cBINOP->op_first);
79072805
LW		 4280 }
4281 else
4282 scalar(op);
4283 return op;
4284}
4285
4286OP *
8990e307
LW		 4287ck_require(op)
4288OP *op;
4289{
a0d0e21e 4290 if (op->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */
8990e307
LW		 4291 SVOP *kid = (SVOP*)cUNOP->op_first;
4292
4293 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
8990e307 4294 char *s;
a0d0e21e
LW		 4295 for (s = SvPVX(kid->op_sv); *s; s++) {
4296 if (*s == ':' && s[1] == ':') {
4297 *s = '/';
1aef975c 4298 Move(s+2, s+1, strlen(s+2)+1, char);
a0d0e21e
LW		 4299 --SvCUR(kid->op_sv);
4300 }
8990e307 4301 }
a0d0e21e 4302 sv_catpvn(kid->op_sv, ".pm", 3);
8990e307
LW		 4303 }
4304 }
4305 return ck_fun(op);
4306}
4307
4308OP *
79072805
LW		 4309ck_retarget(op)
4310OP *op;
4311{
463ee0b2 4312 croak("NOT IMPL LINE %d",__LINE__);
79072805
LW		 4313 /* STUB */
4314 return op;
4315}
4316
4317OP *
4318ck_select(op)
4319OP *op;
4320{
c07a80fd 4321 OP* kid;
79072805 4322 if (op->op_flags & OPf_KIDS) {
c07a80fd 4323 kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
2304df62 4324 if (kid && kid->op_sibling) {
79072805
LW		 4325 op->op_type = OP_SSELECT;
4326 op->op_ppaddr = ppaddr[OP_SSELECT];
4327 op = ck_fun(op);
4328 return fold_constants(op);
4329 }
4330 }
c07a80fd 4331 op = ck_fun(op);
4332 kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
4333 if (kid && kid->op_type == OP_RV2GV)
4334 kid->op_private &= ~HINT_STRICT_REFS;
4335 return op;
79072805
LW		 4336}
4337
4338OP *
4339ck_shift(op)
4340OP *op;
4341{
4342 I32 type = op->op_type;
4343
4344 if (!(op->op_flags & OPf_KIDS)) {
4345 op_free(op);
4346 return newUNOP(type, 0,
4347 scalar(newUNOP(OP_RV2AV, 0,
b1cb66bf 4348 scalar(newGVOP(OP_GV, 0, subline
4349 ? defgv
4350 : gv_fetchpv("ARGV", TRUE, SVt_PVAV) )))));
79072805 4351 }
463ee0b2 4352 return scalar(modkids(ck_fun(op), type));
79072805
LW		 4353}
4354
4355OP *
4356ck_sort(op)
4357OP *op;
4358{
bbce6d69 4359 op->op_private = 0;
36477c24 4360#ifdef USE_LOCALE
bbce6d69 4361 if (hints & HINT_LOCALE)
4362 op->op_private |= OPpLOCALE;
4363#endif
4364
79072805
LW		 4365 if (op->op_flags & OPf_STACKED) {
4366 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
463ee0b2
LW		 4367 OP *k;
4368 kid = kUNOP->op_first; /* get past rv2gv */
79072805 4369
463ee0b2 4370 if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
79072805 4371 linklist(kid);
463ee0b2
LW		 4372 if (kid->op_type == OP_SCOPE) {
4373 k = kid->op_next;
4374 kid->op_next = 0;
79072805 4375 }
463ee0b2 4376 else if (kid->op_type == OP_LEAVE) {
748a9306
LW		 4377 if (op->op_type == OP_SORT) {
4378 null(kid); /* wipe out leave */
4379 kid->op_next = kid;
463ee0b2 4380
748a9306
LW		 4381 for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
4382 if (k->op_next == kid)
4383 k->op_next = 0;
4384 }
463ee0b2 4385 }
748a9306
LW		 4386 else
4387 kid->op_next = 0; /* just disconnect the leave */
a0d0e21e 4388 k = kLISTOP->op_first;
463ee0b2 4389 }
a0d0e21e
LW		 4390 peep(k);
4391
463ee0b2 4392 kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
8990e307 4393 null(kid); /* wipe out rv2gv */
a0d0e21e
LW		 4394 if (op->op_type == OP_SORT)
4395 kid->op_next = kid;
4396 else
4397 kid->op_next = k;
79072805
LW		 4398 op->op_flags |= OPf_SPECIAL;
4399 }
4400 }
bbce6d69 4401
79072805
LW		 4402 return op;
4403}
4404
4405OP *
4406ck_split(op)
4407OP *op;
4408{
4409 register OP *kid;
ed6116ce 4410 PMOP* pm;
79072805
LW		 4411
4412 if (op->op_flags & OPf_STACKED)
4413 return no_fh_allowed(op);
4414
79072805 4415 kid = cLISTOP->op_first;
8990e307 4416 if (kid->op_type != OP_NULL)
463ee0b2 4417 croak("panic: ck_split");
8990e307
LW		 4418 kid = kid->op_sibling;
4419 op_free(cLISTOP->op_first);
4420 cLISTOP->op_first = kid;
85e6fe83 4421 if (!kid) {
8990e307 4422 cLISTOP->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
85e6fe83
LW		 4423 cLISTOP->op_last = kid; /* There was only one element previously */
4424 }
79072805
LW		 4425
4426 if (kid->op_type != OP_MATCH) {
4427 OP *sibl = kid->op_sibling;
463ee0b2 4428 kid->op_sibling = 0;
79072805
LW		 4429 kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
4430 if (cLISTOP->op_first == cLISTOP->op_last)
4431 cLISTOP->op_last = kid;
4432 cLISTOP->op_first = kid;
4433 kid->op_sibling = sibl;
4434 }
ed6116ce
LW		 4435 pm = (PMOP*)kid;
4436 if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
8990e307 4437 SvREFCNT_dec(pm->op_pmshort); /* can't use substring to optimize */
ed6116ce
LW		 4438 pm->op_pmshort = 0;
4439 }
79072805
LW		 4440
4441 kid->op_type = OP_PUSHRE;
4442 kid->op_ppaddr = ppaddr[OP_PUSHRE];
4443 scalar(kid);
4444
4445 if (!kid->op_sibling)
4446 append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
4447
4448 kid = kid->op_sibling;
4449 scalar(kid);
4450
4451 if (!kid->op_sibling)
4452 append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0)));
4453
4454 kid = kid->op_sibling;
4455 scalar(kid);
4456
4457 if (kid->op_sibling)
c07a80fd 4458 return too_many_arguments(op,op_desc[op->op_type]);
79072805
LW		 4459
4460 return op;
4461}
4462
4463OP *
4464ck_subr(op)
4465OP *op;
4466{
4633a7c4
LW		 4467 OP *prev = ((cUNOP->op_first->op_sibling)
4468 ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first;
4469 OP *o = prev->op_sibling;
4470 OP *cvop;
4471 char *proto = 0;
4472 CV *cv = 0;
4473 int optional = 0;
4474 I32 arg = 0;
4475
4476 for (cvop = o; cvop->op_sibling; cvop = cvop->op_sibling) ;
4477 if (cvop->op_type == OP_RV2CV) {
4478 SVOP* tmpop;
c07a80fd 4479 op->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
4633a7c4
LW		 4480 null(cvop); /* disable rv2cv */
4481 tmpop = (SVOP*)((UNOP*)cvop)->op_first;
4482 if (tmpop->op_type == OP_GV) {
8ebc5c01 4483 cv = GvCVu(tmpop->op_sv);
c07a80fd 4484 if (cv && SvPOK(cv) && !(op->op_private & OPpENTERSUB_AMPER))
4633a7c4
LW		 4485 proto = SvPV((SV*)cv,na);
4486 }
4487 }
c07a80fd 4488 op->op_private |= (hints & HINT_STRICT_REFS);
8990e307 4489 if (perldb && curstash != debstash)
c07a80fd 4490 op->op_private |= OPpENTERSUB_DB;
4633a7c4
LW		 4491 while (o != cvop) {
4492 if (proto) {
4493 switch (*proto) {
4494 case '\0':
4495 return too_many_arguments(op, CvNAME(cv));
4496 case ';':
4497 optional = 1;
4498 proto++;
4499 continue;
4500 case '$':
4501 proto++;
4502 arg++;
4503 scalar(o);
4504 break;
4505 case '%':
4506 case '@':
4507 list(o);
4508 arg++;
4509 break;
4510 case '&':
4511 proto++;
4512 arg++;
4513 if (o->op_type != OP_REFGEN && o->op_type != OP_UNDEF)
4514 bad_type(arg, "block", CvNAME(cv), o);
4515 break;
4516 case '*':
4517 proto++;
4518 arg++;
4519 if (o->op_type == OP_RV2GV)
4520 goto wrapref;
4521 {
4522 OP* kid = o;
4523 o = newUNOP(OP_RV2GV, 0, kid);
4524 o->op_sibling = kid->op_sibling;
4525 kid->op_sibling = 0;
4526 prev->op_sibling = o;
4527 }
4528 goto wrapref;
4529 case '\\':
4530 proto++;
4531 arg++;
4532 switch (*proto++) {
4533 case '*':
4534 if (o->op_type != OP_RV2GV)
4535 bad_type(arg, "symbol", CvNAME(cv), o);
4536 goto wrapref;
4537 case '&':
4538 if (o->op_type != OP_RV2CV)
4539 bad_type(arg, "sub", CvNAME(cv), o);
4540 goto wrapref;
4541 case '$':
4542 if (o->op_type != OP_RV2SV && o->op_type != OP_PADSV)
4543 bad_type(arg, "scalar", CvNAME(cv), o);
4544 goto wrapref;
4545 case '@':
4546 if (o->op_type != OP_RV2AV && o->op_type != OP_PADAV)
4547 bad_type(arg, "array", CvNAME(cv), o);
4548 goto wrapref;
4549 case '%':
4550 if (o->op_type != OP_RV2HV && o->op_type != OP_PADHV)
4551 bad_type(arg, "hash", CvNAME(cv), o);
4552 wrapref:
4553 {
4554 OP* kid = o;
4555 o = newUNOP(OP_REFGEN, 0, kid);
4556 o->op_sibling = kid->op_sibling;
4557 kid->op_sibling = 0;
4558 prev->op_sibling = o;
4559 }
4560 break;
4561 default: goto oops;
4562 }
4563 break;
b1cb66bf 4564 case ' ':
4565 proto++;
4566 continue;
4633a7c4
LW		 4567 default:
4568 oops:
4569 croak("Malformed prototype for %s: %s",
4570 CvNAME(cv),SvPV((SV*)cv,na));
4571 }
4572 }
4573 else
4574 list(o);
68dc0745 4575 mod(o, OP_ENTERSUB);
4633a7c4
LW		 4576 prev = o;
4577 o = o->op_sibling;
4578 }
4579 if (proto && !optional && *proto == '$')
4580 return too_few_arguments(op, CvNAME(cv));
79072805
LW		 4581 return op;
4582}
4583
4584OP *
8990e307
LW		 4585ck_svconst(op)
4586OP *op;
4587{
4588 SvREADONLY_on(cSVOP->op_sv);
4589 return op;
4590}
4591
4592OP *
79072805
LW		 4593ck_trunc(op)
4594OP *op;
4595{
4596 if (op->op_flags & OPf_KIDS) {
4597 SVOP *kid = (SVOP*)cUNOP->op_first;
4598
a0d0e21e
LW		 4599 if (kid->op_type == OP_NULL)
4600 kid = (SVOP*)kid->op_sibling;
4601 if (kid &&
4602 kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
79072805
LW		 4603 op->op_flags |= OPf_SPECIAL;
4604 }
4605 return ck_fun(op);
4606}
4607
463ee0b2
LW		 4608/* A peephole optimizer. We visit the ops in the order they're to execute. */
4609
79072805 4610void
a0d0e21e
LW		 4611peep(o)
4612register OP* o;
79072805
LW		 4613{
4614 register OP* oldop = 0;
a0d0e21e 4615 if (!o || o->op_seq)
79072805 4616 return;
a0d0e21e
LW		 4617 ENTER;
4618 SAVESPTR(op);
4619 SAVESPTR(curcop);
4620 for (; o; o = o->op_next) {
4621 if (o->op_seq)
4622 break;
c07a80fd 4623 if (!op_seqmax)
4624 op_seqmax++;
a0d0e21e
LW		 4625 op = o;
4626 switch (o->op_type) {
4627 case OP_NEXTSTATE:
4628 case OP_DBSTATE:
4629 curcop = ((COP*)o); /* for warnings */
c07a80fd 4630 o->op_seq = op_seqmax++;
a0d0e21e
LW		 4631 break;
4632
4633 case OP_CONCAT:
4634 case OP_CONST:
4635 case OP_JOIN:
4636 case OP_UC:
4637 case OP_UCFIRST:
4638 case OP_LC:
4639 case OP_LCFIRST:
4640 case OP_QUOTEMETA:
4641 if (o->op_next->op_type == OP_STRINGIFY)
4642 null(o->op_next);
c07a80fd 4643 o->op_seq = op_seqmax++;
a0d0e21e 4644 break;
8990e307 4645 case OP_STUB:
54310121 4646 if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
c07a80fd 4647 o->op_seq = op_seqmax++;
54310121 4648 break; /* Scalar stub must produce undef. List stub is noop */
8990e307 4649 }
748a9306 4650 goto nothin;
79072805 4651 case OP_NULL:
748a9306
LW		 4652 if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
4653 curcop = ((COP*)op);
4654 goto nothin;
79072805 4655 case OP_SCALAR:
93a17b20 4656 case OP_LINESEQ:
463ee0b2 4657 case OP_SCOPE:
748a9306 4658 nothin:
a0d0e21e
LW		 4659 if (oldop && o->op_next) {
4660 oldop->op_next = o->op_next;
79072805
LW		 4661 continue;
4662 }
c07a80fd 4663 o->op_seq = op_seqmax++;
79072805
LW		 4664 break;
4665
4666 case OP_GV:
a0d0e21e 4667 if (o->op_next->op_type == OP_RV2SV) {
5f05dabc 4668 if (!(o->op_next->op_private & OPpDEREF)) {
a0d0e21e
LW		 4669 null(o->op_next);
4670 o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
4671 o->op_next = o->op_next->op_next;
4672 o->op_type = OP_GVSV;
4673 o->op_ppaddr = ppaddr[OP_GVSV];
8990e307
LW		 4674 }
4675 }
a0d0e21e
LW		 4676 else if (o->op_next->op_type == OP_RV2AV) {
4677 OP* pop = o->op_next->op_next;
4678 IV i;
8990e307 4679 if (pop->op_type == OP_CONST &&
a0d0e21e 4680 (op = pop->op_next) &&
8990e307 4681 pop->op_next->op_type == OP_AELEM &&
68dc0745 4682 !(pop->op_next->op_private &
4683 (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF)) &&
a0d0e21e
LW		 4684 (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
4685 <= 255 &&
8990e307
LW		 4686 i >= 0)
4687 {
748a9306 4688 SvREFCNT_dec(((SVOP*)pop)->op_sv);
a0d0e21e 4689 null(o->op_next);
8990e307
LW		 4690 null(pop->op_next);
4691 null(pop);
a0d0e21e
LW		 4692 o->op_flags |= pop->op_next->op_flags & OPf_MOD;
4693 o->op_next = pop->op_next->op_next;
4694 o->op_type = OP_AELEMFAST;
4695 o->op_ppaddr = ppaddr[OP_AELEMFAST];
4696 o->op_private = (U8)i;
a6006777 4697 GvAVn(((GVOP*)o)->op_gv);
8990e307 4698 }
79072805 4699 }
c07a80fd 4700 o->op_seq = op_seqmax++;
79072805
LW		 4701 break;
4702
a0d0e21e 4703 case OP_MAPWHILE:
79072805
LW		 4704 case OP_GREPWHILE:
4705 case OP_AND:
4706 case OP_OR:
c07a80fd 4707 o->op_seq = op_seqmax++;
79072805
LW		 4708 peep(cLOGOP->op_other);
4709 break;
4710
4711 case OP_COND_EXPR:
c07a80fd 4712 o->op_seq = op_seqmax++;
79072805
LW		 4713 peep(cCONDOP->op_true);
4714 peep(cCONDOP->op_false);
4715 break;
4716
4717 case OP_ENTERLOOP:
c07a80fd 4718 o->op_seq = op_seqmax++;
79072805
LW		 4719 peep(cLOOP->op_redoop);
4720 peep(cLOOP->op_nextop);
4721 peep(cLOOP->op_lastop);
4722 break;
4723
4724 case OP_MATCH:
4725 case OP_SUBST:
c07a80fd 4726 o->op_seq = op_seqmax++;
a0d0e21e 4727 peep(cPMOP->op_pmreplstart);
79072805
LW		 4728 break;
4729
a0d0e21e 4730 case OP_EXEC:
c07a80fd 4731 o->op_seq = op_seqmax++;
a0d0e21e
LW		 4732 if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
4733 if (o->op_next->op_sibling &&
4734 o->op_next->op_sibling->op_type != OP_DIE) {
4735 line_t oldline = curcop->cop_line;
4736
4737 curcop->cop_line = ((COP*)o->op_next)->cop_line;
4738 warn("Statement unlikely to be reached");
4739 warn("(Maybe you meant system() when you said exec()?)\n");
4740 curcop->cop_line = oldline;
4741 }
4742 }
4743 break;
79072805 4744 default:
c07a80fd 4745 o->op_seq = op_seqmax++;
79072805
LW		 4746 break;
4747 }
a0d0e21e 4748 oldop = o;
79072805 4749 }
a0d0e21e 4750 LEAVE;
79072805 4751}
Unnamed repository; edit this file 'description' to name the repository.