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