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