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