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