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