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