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