3 * Copyright (c) 1991-1994, Larry Wall
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.
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
21 #define USE_OP_MASK /* Turned on by default in 5.002beta1h */
25 * In the following definition, the ", (OP *) op" is just to make the compiler
26 * think the expression is of the right type: croak actually does a Siglongjmp.
28 #define CHECKOP(type,op) \
29 ((op_mask && op_mask[type]) \
30 ? ( op_free((OP*)op), \
31 croak("%s trapped by operation mask", op_desc[type]), \
33 : (*check[type])((OP*)op))
35 #define CHECKOP(type,op) (*check[type])(op)
36 #endif /* USE_OP_MASK */
38 static I32 list_assignment _((OP *op));
39 static OP *bad_type _((I32 n, char *t, char *name, OP *kid));
40 static OP *modkids _((OP *op, I32 type));
41 static OP *no_fh_allowed _((OP *op));
42 static OP *scalarboolean _((OP *op));
43 static OP *too_few_arguments _((OP *op, char* name));
44 static OP *too_many_arguments _((OP *op, char* name));
45 static void null _((OP* op));
46 static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq,
47 CV* startcv, I32 cx_ix));
53 SV* tmpsv = sv_newmortal();
54 gv_efullname3(tmpsv, CvGV(cv), Nullch);
55 return SvPV(tmpsv,na);
62 sprintf(tokenbuf,"Missing comma after first argument to %s function",
63 op_desc[op->op_type]);
69 too_few_arguments(op, name)
73 sprintf(tokenbuf,"Not enough arguments for %s", name);
79 too_many_arguments(op, name)
83 sprintf(tokenbuf,"Too many arguments for %s", name);
89 bad_type(n, t, name, kid)
95 sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)",
96 (int) n, name, t, op_desc[kid->op_type]);
105 int type = op->op_type;
106 if (type != OP_AELEM && type != OP_HELEM) {
107 sprintf(tokenbuf, "Can't use subscript on %s", op_desc[type]);
109 if (type == OP_ENTERSUB || type == OP_RV2HV || type == OP_PADHV)
110 warn("(Did you mean $ or @ instead of %c?)\n",
111 type == OP_ENTERSUB ? '&' : '%');
115 /* "register" allocation */
124 if (!(isALPHA(name[1]) || name[1] == '_' && (int)strlen(name) > 2)) {
125 if (!isPRINT(name[1]))
126 sprintf(name+1, "^%c", toCTRL(name[1])); /* XXX tokenbuf, really */
127 croak("Can't use global %s in \"my\"",name);
129 if (AvFILL(comppad_name) >= 0) {
130 SV **svp = AvARRAY(comppad_name);
131 for (off = AvFILL(comppad_name); off > comppad_name_floor; off--) {
134 && SvIVX(sv) == 999999999 /* var is in open scope */
135 && strEQ(name, SvPVX(sv)))
137 warn("\"my\" variable %s masks earlier declaration in same scope", name);
142 off = pad_alloc(OP_PADSV, SVs_PADMY);
144 sv_upgrade(sv, SVt_PVNV);
146 av_store(comppad_name, off, sv);
147 SvNVX(sv) = (double)999999999;
148 SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */
149 if (!min_intro_pending)
150 min_intro_pending = off;
151 max_intro_pending = off;
153 av_store(comppad, off, (SV*)newAV());
154 else if (*name == '%')
155 av_store(comppad, off, (SV*)newHV());
156 SvPADMY_on(curpad[off]);
161 #ifndef CAN_PROTOTYPE
162 pad_findlex(name, newoff, seq, startcv, cx_ix)
169 pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)
176 register CONTEXT *cx;
179 for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
180 AV* curlist = CvPADLIST(cv);
181 SV** svp = av_fetch(curlist, 0, FALSE);
183 if (!svp || *svp == &sv_undef)
186 svp = AvARRAY(curname);
187 for (off = AvFILL(curname); off > 0; off--) {
188 if ((sv = svp[off]) &&
192 seq > I_32(SvNVX(sv)) &&
193 strEQ(SvPVX(sv), name))
201 if (newoff && !CvUNIQUE(cv))
202 return 0; /* don't clone inactive sub's stack frame */
205 oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
206 oldsv = *av_fetch(oldpad, off, TRUE);
207 if (!newoff) { /* Not a mere clone operation. */
208 SV *sv = NEWSV(1103,0);
209 newoff = pad_alloc(OP_PADSV, SVs_PADMY);
210 sv_upgrade(sv, SVt_PVNV);
212 av_store(comppad_name, newoff, sv);
213 SvNVX(sv) = (double)curcop->cop_seq;
214 SvIVX(sv) = 999999999; /* A ref, intro immediately */
215 SvFAKE_on(sv); /* A ref, not a real var */
216 if (CvANON(compcv) || SvTYPE(compcv) == SVt_PVFM) {
217 /* "It's closures all the way down." */
222 bcv && bcv != cv && !CvCLONE(bcv);
223 bcv = CvOUTSIDE(bcv)) {
227 if (dowarn && !CvUNIQUE(cv))
229 "Variable \"%s\" may be unavailable",
236 else if (!CvUNIQUE(compcv)) {
237 if (dowarn && !CvUNIQUE(cv))
238 warn("Variable \"%s\" will not stay shared", name);
241 av_store(comppad, newoff, SvREFCNT_inc(oldsv));
247 /* Nothing in current lexical context--try eval's context, if any.
248 * This is necessary to let the perldb get at lexically scoped variables.
249 * XXX This will also probably interact badly with eval tree caching.
253 for (i = cx_ix; i >= 0; i--) {
255 switch (cx->cx_type) {
257 if (i == 0 && saweval) {
258 seq = cxstack[saweval].blk_oldcop->cop_seq;
259 return pad_findlex(name, newoff, seq, main_cv, 0);
263 switch (cx->blk_eval.old_op_type) {
268 /* require must have its own scope */
276 if (debstash && CvSTASH(cv) == debstash) { /* ignore DB'* scope */
277 saweval = i; /* so we know where we were called from */
280 seq = cxstack[saweval].blk_oldcop->cop_seq;
281 return pad_findlex(name, newoff, seq, cv, i-1);
294 SV **svp = AvARRAY(comppad_name);
295 U32 seq = cop_seqmax;
297 /* The one we're looking for is probably just before comppad_name_fill. */
298 for (off = AvFILL(comppad_name); off > 0; off--) {
299 if ((sv = svp[off]) &&
302 seq > I_32(SvNVX(sv)) &&
303 strEQ(SvPVX(sv), name))
305 return (PADOFFSET)off;
309 /* See if it's in a nested scope */
310 off = pad_findlex(name, 0, seq, CvOUTSIDE(compcv), cxstack_ix);
322 SV **svp = AvARRAY(comppad_name);
324 if (min_intro_pending && fill < min_intro_pending) {
325 for (off = max_intro_pending; off >= min_intro_pending; off--) {
326 if ((sv = svp[off]) && sv != &sv_undef)
327 warn("%s never introduced", SvPVX(sv));
330 /* "Deintroduce" my variables that are leaving with this scope. */
331 for (off = AvFILL(comppad_name); off > fill; off--) {
332 if ((sv = svp[off]) && sv != &sv_undef && SvIVX(sv) == 999999999)
333 SvIVX(sv) = cop_seqmax;
338 pad_alloc(optype,tmptype)
345 if (AvARRAY(comppad) != curpad)
346 croak("panic: pad_alloc");
347 if (pad_reset_pending)
349 if (tmptype & SVs_PADMY) {
351 sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE);
352 } while (SvPADBUSY(sv)); /* need a fresh one */
353 retval = AvFILL(comppad);
356 SV **names = AvARRAY(comppad_name);
357 SSize_t names_fill = AvFILL(comppad_name);
360 * "foreach" index vars temporarily become aliases to non-"my"
361 * values. Thus we must skip, not just pad values that are
362 * marked as current pad values, but also those with names.
364 if (++padix <= names_fill &&
365 (sv = names[padix]) && sv != &sv_undef)
367 sv = *av_fetch(comppad, padix, TRUE);
368 if (!(SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY)))
373 SvFLAGS(sv) |= tmptype;
374 curpad = AvARRAY(comppad);
375 DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad alloc %ld for %s\n", (long) retval, op_name[optype]));
376 return (PADOFFSET)retval;
380 #ifndef CAN_PROTOTYPE
385 #endif /* CAN_PROTOTYPE */
388 croak("panic: pad_sv po");
389 DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad sv %d\n", po));
390 return curpad[po]; /* eventually we'll turn this into a macro */
394 #ifndef CAN_PROTOTYPE
398 pad_free(PADOFFSET po)
399 #endif /* CAN_PROTOTYPE */
403 if (AvARRAY(comppad) != curpad)
404 croak("panic: pad_free curpad");
406 croak("panic: pad_free po");
407 DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad free %d\n", po));
408 if (curpad[po] && curpad[po] != &sv_undef)
409 SvPADTMP_off(curpad[po]);
415 #ifndef CAN_PROTOTYPE
419 pad_swipe(PADOFFSET po)
420 #endif /* CAN_PROTOTYPE */
422 if (AvARRAY(comppad) != curpad)
423 croak("panic: pad_swipe curpad");
425 croak("panic: pad_swipe po");
426 DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad swipe %d\n", po));
427 SvPADTMP_off(curpad[po]);
428 curpad[po] = NEWSV(1107,0);
429 SvPADTMP_on(curpad[po]);
439 if (AvARRAY(comppad) != curpad)
440 croak("panic: pad_reset curpad");
441 DEBUG_X(PerlIO_printf(Perl_debug_log, "Pad reset\n"));
442 if (!tainting) { /* Can't mix tainted and non-tainted temporaries. */
443 for (po = AvMAX(comppad); po > padix_floor; po--) {
444 if (curpad[po] && curpad[po] != &sv_undef)
445 SvPADTMP_off(curpad[po]);
449 pad_reset_pending = FALSE;
458 register OP *kid, *nextkid;
460 if (!op || op->op_seq == (U16)-1)
463 if (op->op_flags & OPf_KIDS) {
464 for (kid = cUNOP->op_first; kid; kid = nextkid) {
465 nextkid = kid->op_sibling; /* Get before next freeing kid */
470 switch (op->op_type) {
472 op->op_targ = 0; /* Was holding old type, if any. */
475 op->op_targ = 0; /* Was holding hints. */
478 if (!(op->op_flags & OPf_REF) || (check[op->op_type] != ck_ftst))
484 SvREFCNT_dec(cGVOP->op_gv);
488 Safefree(cCOP->cop_label);
489 SvREFCNT_dec(cCOP->cop_filegv);
492 SvREFCNT_dec(cSVOP->op_sv);
498 if (op->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
502 Safefree(cPVOP->op_pv);
505 op_free(cPMOP->op_pmreplroot);
509 pregfree(cPMOP->op_pmregexp);
510 SvREFCNT_dec(cPMOP->op_pmshort);
515 pad_free(op->op_targ);
524 if (op->op_type != OP_NULL && op->op_targ > 0)
525 pad_free(op->op_targ);
526 op->op_targ = op->op_type;
527 op->op_type = OP_NULL;
528 op->op_ppaddr = ppaddr[OP_NULL];
531 /* Contextualizers */
533 #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
544 /* establish postfix order */
545 if (cUNOP->op_first) {
546 op->op_next = LINKLIST(cUNOP->op_first);
547 for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
549 kid->op_next = LINKLIST(kid->op_sibling);
565 if (op && op->op_flags & OPf_KIDS) {
566 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
577 op->op_type == OP_SASSIGN && cBINOP->op_first->op_type == OP_CONST) {
578 line_t oldline = curcop->cop_line;
580 if (copline != NOLINE)
581 curcop->cop_line = copline;
582 warn("Found = in conditional, should be ==");
583 curcop->cop_line = oldline;
594 /* assumes no premature commitment */
595 if (!op || (op->op_flags & OPf_KNOW) || op->op_type == OP_RETURN
599 op->op_flags &= ~OPf_LIST;
600 op->op_flags |= OPf_KNOW;
602 switch (op->op_type) {
604 if (op->op_private & OPpREPEAT_DOLIST)
605 null(((LISTOP*)cBINOP->op_first)->op_first);
606 scalar(cBINOP->op_first);
611 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
615 if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) {
616 if (!kPMOP->op_pmreplroot)
617 deprecate("implicit split to @_");
624 if (op->op_flags & OPf_KIDS) {
625 for (kid = cUNOP->op_first; kid; kid = kid->op_sibling)
631 scalar(cLISTOP->op_first);
636 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
656 if (!op || error_count)
658 if (op->op_flags & OPf_LIST)
661 op->op_flags |= OPf_KNOW;
663 switch (op->op_type) {
665 if (!(opargs[op->op_type] & OA_FOLDCONST))
669 if (op->op_flags & OPf_STACKED)
742 if (!(op->op_private & OPpLVAL_INTRO))
743 useless = op_desc[op->op_type];
750 if (!(op->op_private & OPpLVAL_INTRO) &&
751 (!op->op_sibling || op->op_sibling->op_type != OP_READLINE))
752 useless = "a variable";
757 curcop = ((COP*)op); /* for warning below */
763 useless = "a constant";
764 if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
766 else if (SvPOK(sv)) {
767 if (strnEQ(SvPVX(sv), "di", 2) ||
768 strnEQ(SvPVX(sv), "ds", 2) ||
769 strnEQ(SvPVX(sv), "ig", 2))
773 null(op); /* don't execute a constant */
774 SvREFCNT_dec(sv); /* don't even remember it */
778 op->op_type = OP_PREINC; /* pre-increment is faster */
779 op->op_ppaddr = ppaddr[OP_PREINC];
783 op->op_type = OP_PREDEC; /* pre-decrement is faster */
784 op->op_ppaddr = ppaddr[OP_PREDEC];
790 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
794 if (op->op_targ == OP_NEXTSTATE || op->op_targ == OP_DBSTATE)
795 curcop = ((COP*)op); /* for warning below */
796 if (op->op_flags & OPf_STACKED)
801 if (!(op->op_flags & OPf_KIDS))
807 op->op_private |= OPpLEAVE_VOID;
810 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
814 if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) {
815 if (!kPMOP->op_pmreplroot)
816 deprecate("implicit split to @_");
820 op->op_private |= OPpLEAVE_VOID;
823 if (useless && dowarn)
824 warn("Useless use of %s in void context", useless);
833 if (op && op->op_flags & OPf_KIDS) {
834 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
846 /* assumes no premature commitment */
847 if (!op || (op->op_flags & OPf_KNOW) || op->op_type == OP_RETURN
851 op->op_flags |= (OPf_KNOW | OPf_LIST);
853 switch (op->op_type) {
856 list(cBINOP->op_first);
861 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
868 if (!(op->op_flags & OPf_KIDS))
870 if (!op->op_next && cUNOP->op_first->op_type == OP_FLOP) {
871 list(cBINOP->op_first);
872 return gen_constant_list(op);
879 list(cLISTOP->op_first);
883 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
902 if (op->op_type == OP_LINESEQ ||
903 op->op_type == OP_SCOPE ||
904 op->op_type == OP_LEAVE ||
905 op->op_type == OP_LEAVETRY)
907 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
908 if (kid->op_sibling) {
914 op->op_flags &= ~OPf_PARENS;
915 if (hints & HINT_BLOCK_SCOPE)
916 op->op_flags |= OPf_PARENS;
919 op = newOP(OP_STUB, 0);
929 if (op && op->op_flags & OPf_KIDS) {
930 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
946 if (!op || error_count)
949 switch (op->op_type) {
951 if (!(op->op_private & (OPpCONST_ARYBASE)))
953 if (eval_start && eval_start->op_type == OP_CONST) {
954 compiling.cop_arybase = (I32)SvIV(((SVOP*)eval_start)->op_sv);
958 SAVEI32(compiling.cop_arybase);
959 compiling.cop_arybase = 0;
961 else if (type == OP_REFGEN)
964 croak("That use of $[ is unsupported");
967 if (op->op_flags & OPf_PARENS)
971 if ((type == OP_UNDEF || type == OP_REFGEN) &&
972 !(op->op_flags & OPf_STACKED)) {
973 op->op_type = OP_RV2CV; /* entersub => rv2cv */
974 op->op_ppaddr = ppaddr[OP_RV2CV];
975 assert(cUNOP->op_first->op_type == OP_NULL);
976 null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */
982 /* grep, foreach, subcalls, refgen */
983 if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
985 sprintf(tokenbuf, "Can't modify %s in %s",
986 op_desc[op->op_type],
987 type ? op_desc[type] : "local");
1002 case OP_RIGHT_SHIFT:
1011 if (!(op->op_flags & OPf_STACKED))
1017 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
1023 if (type == OP_REFGEN && op->op_flags & OPf_PARENS) {
1025 return op; /* Treat \(@foo) like ordinary list. */
1029 ref(cUNOP->op_first, op->op_type);
1041 if (!type && cUNOP->op_first->op_type != OP_GV)
1042 croak("Can't localize a reference");
1043 ref(cUNOP->op_first, op->op_type);
1056 if (type == OP_REFGEN && op->op_flags & OPf_PARENS)
1057 return op; /* Treat \(@foo) like ordinary list. */
1062 croak("Can't localize lexical variable %s",
1063 SvPV(*av_fetch(comppad_name, op->op_targ, 4), na));
1070 if (type != OP_SASSIGN)
1076 pad_free(op->op_targ);
1077 op->op_targ = pad_alloc(op->op_type, SVs_PADMY);
1078 assert(SvTYPE(PAD_SV(op->op_targ)) == SVt_NULL);
1079 if (op->op_flags & OPf_KIDS)
1080 mod(cBINOP->op_first->op_sibling, type);
1085 ref(cBINOP->op_first, op->op_type);
1092 if (op->op_flags & OPf_KIDS)
1093 mod(cLISTOP->op_last, type);
1097 if (!(op->op_flags & OPf_KIDS))
1099 if (op->op_targ != OP_LIST) {
1100 mod(cBINOP->op_first, type);
1105 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
1109 op->op_flags |= OPf_MOD;
1111 if (type == OP_AASSIGN || type == OP_SASSIGN)
1112 op->op_flags |= OPf_SPECIAL|OPf_REF;
1114 op->op_private |= OPpLVAL_INTRO;
1115 op->op_flags &= ~OPf_SPECIAL;
1117 else if (type != OP_GREPSTART && type != OP_ENTERSUB)
1118 op->op_flags |= OPf_REF;
1128 if (op && op->op_flags & OPf_KIDS) {
1129 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
1142 if (!op || error_count)
1145 switch (op->op_type) {
1147 if ((type == OP_DEFINED) &&
1148 !(op->op_flags & OPf_STACKED)) {
1149 op->op_type = OP_RV2CV; /* entersub => rv2cv */
1150 op->op_ppaddr = ppaddr[OP_RV2CV];
1151 assert(cUNOP->op_first->op_type == OP_NULL);
1152 null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */
1153 op->op_flags |= OPf_SPECIAL;
1158 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
1162 ref(cUNOP->op_first, op->op_type);
1165 if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
1166 op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
1167 : type == OP_RV2HV ? OPpDEREF_HV
1169 op->op_flags |= OPf_MOD;
1175 op->op_flags |= OPf_REF;
1178 ref(cUNOP->op_first, op->op_type);
1183 op->op_flags |= OPf_REF;
1188 if (!(op->op_flags & OPf_KIDS))
1190 ref(cBINOP->op_first, type);
1194 ref(cBINOP->op_first, op->op_type);
1195 if (type == OP_RV2SV || type == OP_RV2AV || type == OP_RV2HV) {
1196 op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV
1197 : type == OP_RV2HV ? OPpDEREF_HV
1199 op->op_flags |= OPf_MOD;
1207 if (!(op->op_flags & OPf_KIDS))
1209 ref(cLISTOP->op_last, type);
1225 if (!op || error_count)
1229 if (type == OP_LIST) {
1230 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
1233 else if (type != OP_PADSV &&
1236 type != OP_PUSHMARK)
1238 sprintf(tokenbuf, "Can't declare %s in my", op_desc[op->op_type]);
1242 op->op_flags |= OPf_MOD;
1243 op->op_private |= OPpLVAL_INTRO;
1252 o->op_flags |= OPf_PARENS;
1257 bind_match(type, left, right)
1264 if (right->op_type == OP_MATCH ||
1265 right->op_type == OP_SUBST ||
1266 right->op_type == OP_TRANS) {
1267 right->op_flags |= OPf_STACKED;
1268 if (right->op_type != OP_MATCH)
1269 left = mod(left, right->op_type);
1270 if (right->op_type == OP_TRANS)
1271 op = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
1273 op = prepend_elem(right->op_type, scalar(left), right);
1275 return newUNOP(OP_NOT, 0, scalar(op));
1279 return bind_match(type, left,
1280 pmruntime(newPMOP(OP_MATCH, 0), right, Nullop));
1289 /* XXX need to optimize away NOT NOT here? Or do we let optimizer do it? */
1290 return newUNOP(OP_NOT, OPf_SPECIAL, scalar(op));
1298 if (o->op_flags & OPf_PARENS || perldb || tainting) {
1299 o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
1300 o->op_type = OP_LEAVE;
1301 o->op_ppaddr = ppaddr[OP_LEAVE];
1304 if (o->op_type == OP_LINESEQ) {
1306 o->op_type = OP_SCOPE;
1307 o->op_ppaddr = ppaddr[OP_SCOPE];
1308 kid = ((LISTOP*)o)->op_first;
1309 if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
1310 SvREFCNT_dec(((COP*)kid)->cop_filegv);
1315 o = newLISTOP(OP_SCOPE, 0, o, Nullop);
1325 int retval = savestack_ix;
1326 SAVEI32(comppad_name_floor);
1328 if ((comppad_name_fill = AvFILL(comppad_name)) > 0)
1329 comppad_name_floor = comppad_name_fill;
1331 comppad_name_floor = 0;
1333 SAVEI32(min_intro_pending);
1334 SAVEI32(max_intro_pending);
1335 min_intro_pending = 0;
1336 SAVEI32(comppad_name_fill);
1337 SAVEI32(padix_floor);
1338 padix_floor = padix;
1339 pad_reset_pending = FALSE;
1341 hints &= ~HINT_BLOCK_SCOPE;
1346 block_end(floor, seq)
1350 int needblockscope = hints & HINT_BLOCK_SCOPE;
1351 OP* retval = scalarseq(seq);
1353 pad_reset_pending = FALSE;
1355 hints |= HINT_BLOCK_SCOPE; /* propagate out */
1356 pad_leavemy(comppad_name_fill);
1366 eval_root = newUNOP(OP_LEAVEEVAL, ((in_eval & 4) ? OPf_SPECIAL : 0), op);
1367 eval_start = linklist(eval_root);
1368 eval_root->op_next = 0;
1376 main_root = scope(sawparens(scalarvoid(op)));
1377 curcop = &compiling;
1378 main_start = LINKLIST(main_root);
1379 main_root->op_next = 0;
1383 /* Register with debugger: */
1386 CV *cv = perl_get_cv("DB::postponed", FALSE);
1391 XPUSHs((SV*)compiling.cop_filegv);
1393 perl_call_sv((SV*)cv, G_DISCARD);
1404 if (o->op_flags & OPf_PARENS)
1408 if (dowarn && bufptr > oldbufptr && bufptr[-1] == ',') {
1410 for (s = bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
1411 if (*s == ';' || *s == '=')
1412 warn("Parens missing around \"%s\" list", lex ? "my" : "local");
1419 return mod(o, OP_NULL); /* a bit kludgey */
1426 if (o->op_type == OP_LIST) {
1427 o = convert(OP_JOIN, 0,
1428 prepend_elem(OP_LIST,
1429 newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
1440 I32 type = o->op_type;
1443 if (opargs[type] & OA_RETSCALAR)
1445 if (opargs[type] & OA_TARGET)
1446 o->op_targ = pad_alloc(type, SVs_PADTMP);
1448 if ((opargs[type] & OA_OTHERINT) && (hints & HINT_INTEGER))
1449 o->op_ppaddr = ppaddr[type = ++(o->op_type)];
1451 if (!(opargs[type] & OA_FOLDCONST))
1455 goto nope; /* Don't try to run w/ errors */
1457 for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
1458 if (curop->op_type != OP_CONST &&
1459 curop->op_type != OP_LIST &&
1460 curop->op_type != OP_SCALAR &&
1461 curop->op_type != OP_NULL &&
1462 curop->op_type != OP_PUSHMARK) {
1467 curop = LINKLIST(o);
1472 if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */
1473 pad_swipe(o->op_targ);
1474 else if (SvTEMP(sv)) { /* grab mortal temp? */
1475 (void)SvREFCNT_inc(sv);
1479 if (type == OP_RV2GV)
1480 return newGVOP(OP_GV, 0, (GV*)sv);
1482 if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK) {
1484 if ((double)iv == SvNV(sv)) { /* can we smush double to int */
1489 SvIOK_off(sv); /* undo SvIV() damage */
1491 return newSVOP(OP_CONST, 0, sv);
1495 if (!(opargs[type] & OA_OTHERINT))
1498 if (!(hints & HINT_INTEGER)) {
1499 if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS))
1502 for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
1503 if (curop->op_type == OP_CONST) {
1504 if (SvIOK(((SVOP*)curop)->op_sv))
1508 if (opargs[curop->op_type] & OA_RETINTEGER)
1512 o->op_ppaddr = ppaddr[++(o->op_type)];
1519 gen_constant_list(o)
1523 I32 oldtmps_floor = tmps_floor;
1527 return o; /* Don't attempt to run with errors */
1529 op = curop = LINKLIST(o);
1535 tmps_floor = oldtmps_floor;
1537 o->op_type = OP_RV2AV;
1538 o->op_ppaddr = ppaddr[OP_RV2AV];
1539 curop = ((UNOP*)o)->op_first;
1540 ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*stack_sp--));
1547 convert(type, flags, op)
1555 if (!op || op->op_type != OP_LIST)
1556 op = newLISTOP(OP_LIST, 0, op, Nullop);
1558 op->op_flags &= ~(OPf_KNOW|OPf_LIST);
1560 if (!(opargs[type] & OA_MARK))
1561 null(cLISTOP->op_first);
1564 op->op_ppaddr = ppaddr[type];
1565 op->op_flags |= flags;
1567 op = CHECKOP(type, op);
1568 if (op->op_type != type)
1571 if (cLISTOP->op_children < 7) {
1572 /* XXX do we really need to do this if we're done appending?? */
1573 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
1575 cLISTOP->op_last = last; /* in case check substituted last arg */
1578 return fold_constants(op);
1581 /* List constructors */
1584 append_elem(type, first, last)
1595 if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS)
1596 return newLISTOP(type, 0, first, last);
1598 if (first->op_flags & OPf_KIDS)
1599 ((LISTOP*)first)->op_last->op_sibling = last;
1601 first->op_flags |= OPf_KIDS;
1602 ((LISTOP*)first)->op_first = last;
1604 ((LISTOP*)first)->op_last = last;
1605 ((LISTOP*)first)->op_children++;
1610 append_list(type, first, last)
1621 if (first->op_type != type)
1622 return prepend_elem(type, (OP*)first, (OP*)last);
1624 if (last->op_type != type)
1625 return append_elem(type, (OP*)first, (OP*)last);
1627 first->op_last->op_sibling = last->op_first;
1628 first->op_last = last->op_last;
1629 first->op_children += last->op_children;
1630 if (first->op_children)
1631 last->op_flags |= OPf_KIDS;
1638 prepend_elem(type, first, last)
1649 if (last->op_type == type) {
1650 if (type == OP_LIST) { /* already a PUSHMARK there */
1651 first->op_sibling = ((LISTOP*)last)->op_first->op_sibling;
1652 ((LISTOP*)last)->op_first->op_sibling = first;
1655 if (!(last->op_flags & OPf_KIDS)) {
1656 ((LISTOP*)last)->op_last = first;
1657 last->op_flags |= OPf_KIDS;
1659 first->op_sibling = ((LISTOP*)last)->op_first;
1660 ((LISTOP*)last)->op_first = first;
1662 ((LISTOP*)last)->op_children++;
1666 return newLISTOP(type, 0, first, last);
1674 return newOP(OP_STUB, 0);
1681 if (!op || op->op_type != OP_LIST)
1682 op = newLISTOP(OP_LIST, 0, op, Nullop);
1688 newLISTOP(type, flags, first, last)
1696 Newz(1101, listop, 1, LISTOP);
1698 listop->op_type = type;
1699 listop->op_ppaddr = ppaddr[type];
1700 listop->op_children = (first != 0) + (last != 0);
1701 listop->op_flags = flags;
1705 else if (!first && last)
1708 first->op_sibling = last;
1709 listop->op_first = first;
1710 listop->op_last = last;
1711 if (type == OP_LIST) {
1713 pushop = newOP(OP_PUSHMARK, 0);
1714 pushop->op_sibling = first;
1715 listop->op_first = pushop;
1716 listop->op_flags |= OPf_KIDS;
1718 listop->op_last = pushop;
1720 else if (listop->op_children)
1721 listop->op_flags |= OPf_KIDS;
1732 Newz(1101, op, 1, OP);
1734 op->op_ppaddr = ppaddr[type];
1735 op->op_flags = flags;
1738 op->op_private = 0 + (flags >> 8);
1739 if (opargs[type] & OA_RETSCALAR)
1741 if (opargs[type] & OA_TARGET)
1742 op->op_targ = pad_alloc(type, SVs_PADTMP);
1743 return CHECKOP(type, op);
1747 newUNOP(type, flags, first)
1755 first = newOP(OP_STUB, 0);
1756 if (opargs[type] & OA_MARK)
1757 first = force_list(first);
1759 Newz(1101, unop, 1, UNOP);
1760 unop->op_type = type;
1761 unop->op_ppaddr = ppaddr[type];
1762 unop->op_first = first;
1763 unop->op_flags = flags | OPf_KIDS;
1764 unop->op_private = 1 | (flags >> 8);
1766 unop = (UNOP*) CHECKOP(type, unop);
1770 return fold_constants((OP *) unop);
1774 newBINOP(type, flags, first, last)
1781 Newz(1101, binop, 1, BINOP);
1784 first = newOP(OP_NULL, 0);
1786 binop->op_type = type;
1787 binop->op_ppaddr = ppaddr[type];
1788 binop->op_first = first;
1789 binop->op_flags = flags | OPf_KIDS;
1792 binop->op_private = 1 | (flags >> 8);
1795 binop->op_private = 2 | (flags >> 8);
1796 first->op_sibling = last;
1799 binop = (BINOP*)CHECKOP(type, binop);
1803 binop->op_last = last = binop->op_first->op_sibling;
1805 return fold_constants((OP *)binop);
1809 pmtrans(op, expr, repl)
1814 SV *tstr = ((SVOP*)expr)->op_sv;
1815 SV *rstr = ((SVOP*)repl)->op_sv;
1818 register U8 *t = (U8*)SvPV(tstr, tlen);
1819 register U8 *r = (U8*)SvPV(rstr, rlen);
1824 register short *tbl;
1826 tbl = (short*)cPVOP->op_pv;
1827 complement = op->op_private & OPpTRANS_COMPLEMENT;
1828 delete = op->op_private & OPpTRANS_DELETE;
1829 /* squash = op->op_private & OPpTRANS_SQUASH; */
1832 Zero(tbl, 256, short);
1833 for (i = 0; i < tlen; i++)
1835 for (i = 0, j = 0; i < 256; i++) {
1851 if (!rlen && !delete) {
1854 for (i = 0; i < 256; i++)
1856 for (i = 0, j = 0; i < tlen; i++,j++) {
1859 if (tbl[t[i]] == -1)
1865 if (tbl[t[i]] == -1)
1876 newPMOP(type, flags)
1882 Newz(1101, pmop, 1, PMOP);
1883 pmop->op_type = type;
1884 pmop->op_ppaddr = ppaddr[type];
1885 pmop->op_flags = flags;
1886 pmop->op_private = 0 | (flags >> 8);
1888 if (hints & HINT_LOCALE)
1889 pmop->op_pmpermflags = (pmop->op_pmflags |= PMf_LOCALE);
1891 /* link into pm list */
1892 if (type != OP_TRANS && curstash) {
1893 pmop->op_pmnext = HvPMROOT(curstash);
1894 HvPMROOT(curstash) = pmop;
1901 pmruntime(op, expr, repl)
1909 if (op->op_type == OP_TRANS)
1910 return pmtrans(op, expr, repl);
1914 if (expr->op_type == OP_CONST) {
1916 SV *pat = ((SVOP*)expr)->op_sv;
1917 char *p = SvPV(pat, plen);
1918 if ((op->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
1919 sv_setpvn(pat, "\\s+", 3);
1920 p = SvPV(pat, plen);
1921 pm->op_pmflags |= PMf_SKIPWHITE;
1923 pm->op_pmregexp = pregcomp(p, p + plen, pm);
1924 if (strEQ("\\s+", pm->op_pmregexp->precomp))
1925 pm->op_pmflags |= PMf_WHITE;
1930 if (pm->op_pmflags & PMf_KEEP)
1931 expr = newUNOP(OP_REGCMAYBE,0,expr);
1933 Newz(1101, rcop, 1, LOGOP);
1934 rcop->op_type = OP_REGCOMP;
1935 rcop->op_ppaddr = ppaddr[OP_REGCOMP];
1936 rcop->op_first = scalar(expr);
1937 rcop->op_flags |= OPf_KIDS;
1938 rcop->op_private = 1;
1939 rcop->op_other = op;
1941 /* establish postfix order */
1942 if (pm->op_pmflags & PMf_KEEP) {
1944 rcop->op_next = expr;
1945 ((UNOP*)expr)->op_first->op_next = (OP*)rcop;
1948 rcop->op_next = LINKLIST(expr);
1949 expr->op_next = (OP*)rcop;
1952 prepend_elem(op->op_type, scalar((OP*)rcop), op);
1957 if (pm->op_pmflags & PMf_EVAL)
1959 else if (repl->op_type == OP_CONST)
1963 for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
1964 if (opargs[curop->op_type] & OA_DANGEROUS) {
1965 if (curop->op_type == OP_GV) {
1966 GV *gv = ((GVOP*)curop)->op_gv;
1967 if (strchr("&`'123456789+", *GvENAME(gv)))
1970 else if (curop->op_type == OP_RV2CV)
1972 else if (curop->op_type == OP_RV2SV ||
1973 curop->op_type == OP_RV2AV ||
1974 curop->op_type == OP_RV2HV ||
1975 curop->op_type == OP_RV2GV) {
1976 if (lastop && lastop->op_type != OP_GV) /*funny deref?*/
1979 else if (curop->op_type == OP_PADSV ||
1980 curop->op_type == OP_PADAV ||
1981 curop->op_type == OP_PADHV ||
1982 curop->op_type == OP_PADANY) {
1991 if (curop == repl) {
1992 pm->op_pmflags |= PMf_CONST; /* const for long enough */
1993 pm->op_pmpermflags |= PMf_CONST; /* const for long enough */
1994 prepend_elem(op->op_type, scalar(repl), op);
1997 Newz(1101, rcop, 1, LOGOP);
1998 rcop->op_type = OP_SUBSTCONT;
1999 rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
2000 rcop->op_first = scalar(repl);
2001 rcop->op_flags |= OPf_KIDS;
2002 rcop->op_private = 1;
2003 rcop->op_other = op;
2005 /* establish postfix order */
2006 rcop->op_next = LINKLIST(repl);
2007 repl->op_next = (OP*)rcop;
2009 pm->op_pmreplroot = scalar((OP*)rcop);
2010 pm->op_pmreplstart = LINKLIST(rcop);
2019 newSVOP(type, flags, sv)
2025 Newz(1101, svop, 1, SVOP);
2026 svop->op_type = type;
2027 svop->op_ppaddr = ppaddr[type];
2029 svop->op_next = (OP*)svop;
2030 svop->op_flags = flags;
2031 if (opargs[type] & OA_RETSCALAR)
2033 if (opargs[type] & OA_TARGET)
2034 svop->op_targ = pad_alloc(type, SVs_PADTMP);
2035 return CHECKOP(type, svop);
2039 newGVOP(type, flags, gv)
2045 Newz(1101, gvop, 1, GVOP);
2046 gvop->op_type = type;
2047 gvop->op_ppaddr = ppaddr[type];
2048 gvop->op_gv = (GV*)SvREFCNT_inc(gv);
2049 gvop->op_next = (OP*)gvop;
2050 gvop->op_flags = flags;
2051 if (opargs[type] & OA_RETSCALAR)
2053 if (opargs[type] & OA_TARGET)
2054 gvop->op_targ = pad_alloc(type, SVs_PADTMP);
2055 return CHECKOP(type, gvop);
2059 newPVOP(type, flags, pv)
2065 Newz(1101, pvop, 1, PVOP);
2066 pvop->op_type = type;
2067 pvop->op_ppaddr = ppaddr[type];
2069 pvop->op_next = (OP*)pvop;
2070 pvop->op_flags = flags;
2071 if (opargs[type] & OA_RETSCALAR)
2073 if (opargs[type] & OA_TARGET)
2074 pvop->op_targ = pad_alloc(type, SVs_PADTMP);
2075 return CHECKOP(type, pvop);
2084 save_hptr(&curstash);
2085 save_item(curstname);
2090 name = SvPV(sv, len);
2091 curstash = gv_stashpvn(name,len,TRUE);
2092 sv_setpvn(curstname, name, len);
2096 sv_setpv(curstname,"<none>");
2104 utilize(aver, floor, version, id, arg)
2117 if (id->op_type != OP_CONST)
2118 croak("Module name must be constant");
2122 if(version != Nullop) {
2123 SV *vesv = ((SVOP*)version)->op_sv;
2125 if (arg == Nullop && !SvNIOK(vesv)) {
2132 if (version->op_type != OP_CONST || !SvNIOK(vesv))
2133 croak("Version number must be constant number");
2135 /* Make copy of id so we don't free it twice */
2136 pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
2138 /* Fake up a method call to VERSION */
2139 meth = newSVOP(OP_CONST, 0, newSVpv("VERSION", 7));
2140 veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
2141 append_elem(OP_LIST,
2142 prepend_elem(OP_LIST, pack, list(version)),
2143 newUNOP(OP_METHOD, 0, meth)));
2147 /* Fake up an import/unimport */
2148 if (arg && arg->op_type == OP_STUB)
2149 imop = arg; /* no import on explicit () */
2150 else if(SvNIOK(((SVOP*)id)->op_sv)) {
2151 imop = Nullop; /* use 5.0; */
2154 /* Make copy of id so we don't free it twice */
2155 pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
2156 meth = newSVOP(OP_CONST, 0,
2158 ? newSVpv("import", 6)
2159 : newSVpv("unimport", 8)
2161 imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
2162 append_elem(OP_LIST,
2163 prepend_elem(OP_LIST, pack, list(arg)),
2164 newUNOP(OP_METHOD, 0, meth)));
2167 /* Fake up a require */
2168 rqop = newUNOP(OP_REQUIRE, 0, id);
2170 /* Fake up the BEGIN {}, which does its thing immediately. */
2172 newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)),
2174 append_elem(OP_LINESEQ,
2175 append_elem(OP_LINESEQ,
2176 newSTATEOP(0, Nullch, rqop),
2177 newSTATEOP(0, Nullch, veop)),
2178 newSTATEOP(0, Nullch, imop) ));
2185 newSLICEOP(flags, subscript, listval)
2190 return newBINOP(OP_LSLICE, flags,
2191 list(force_list(subscript)),
2192 list(force_list(listval)) );
2202 if (op->op_type == OP_NULL && op->op_flags & OPf_KIDS)
2203 op = cUNOP->op_first;
2205 if (op->op_type == OP_COND_EXPR) {
2206 I32 t = list_assignment(cCONDOP->op_first->op_sibling);
2207 I32 f = list_assignment(cCONDOP->op_first->op_sibling->op_sibling);
2212 yyerror("Assignment to both a list and a scalar");
2216 if (op->op_type == OP_LIST || op->op_flags & OPf_PARENS ||
2217 op->op_type == OP_RV2AV || op->op_type == OP_RV2HV ||
2218 op->op_type == OP_ASLICE || op->op_type == OP_HSLICE)
2221 if (op->op_type == OP_PADAV || op->op_type == OP_PADHV)
2224 if (op->op_type == OP_RV2SV)
2231 newASSIGNOP(flags, left, optype, right)
2240 if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) {
2241 return newLOGOP(optype, 0,
2242 mod(scalar(left), optype),
2243 newUNOP(OP_SASSIGN, 0, scalar(right)));
2246 return newBINOP(optype, OPf_STACKED,
2247 mod(scalar(left), optype), scalar(right));
2251 if (list_assignment(left)) {
2253 eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
2254 left = mod(left, OP_AASSIGN);
2262 op = newBINOP(OP_AASSIGN, flags,
2263 list(force_list(right)),
2264 list(force_list(left)) );
2265 op->op_private = 0 | (flags >> 8);
2266 if (!(left->op_private & OPpLVAL_INTRO)) {
2267 static int generation = 100;
2271 for (curop = LINKLIST(op); curop != op; curop = LINKLIST(curop)) {
2272 if (opargs[curop->op_type] & OA_DANGEROUS) {
2273 if (curop->op_type == OP_GV) {
2274 GV *gv = ((GVOP*)curop)->op_gv;
2275 if (gv == defgv || SvCUR(gv) == generation)
2277 SvCUR(gv) = generation;
2279 else if (curop->op_type == OP_PADSV ||
2280 curop->op_type == OP_PADAV ||
2281 curop->op_type == OP_PADHV ||
2282 curop->op_type == OP_PADANY) {
2283 SV **svp = AvARRAY(comppad_name);
2284 SV *sv = svp[curop->op_targ];
2285 if (SvCUR(sv) == generation)
2287 SvCUR(sv) = generation; /* (SvCUR not used any more) */
2289 else if (curop->op_type == OP_RV2CV)
2291 else if (curop->op_type == OP_RV2SV ||
2292 curop->op_type == OP_RV2AV ||
2293 curop->op_type == OP_RV2HV ||
2294 curop->op_type == OP_RV2GV) {
2295 if (lastop->op_type != OP_GV) /* funny deref? */
2304 op->op_private = OPpASSIGN_COMMON;
2306 if (right && right->op_type == OP_SPLIT) {
2308 if ((tmpop = ((LISTOP*)right)->op_first) &&
2309 tmpop->op_type == OP_PUSHRE)
2311 PMOP *pm = (PMOP*)tmpop;
2312 if (left->op_type == OP_RV2AV &&
2313 !(left->op_private & OPpLVAL_INTRO) &&
2314 !(op->op_private & OPpASSIGN_COMMON) )
2316 tmpop = ((UNOP*)left)->op_first;
2317 if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
2318 pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv;
2319 pm->op_pmflags |= PMf_ONCE;
2320 tmpop = ((UNOP*)op)->op_first; /* to list (nulled) */
2321 tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
2322 tmpop->op_sibling = Nullop; /* don't free split */
2323 right->op_next = tmpop->op_next; /* fix starting loc */
2324 op_free(op); /* blow off assign */
2325 right->op_flags &= ~(OPf_KNOW|OPf_LIST);
2326 /* "I don't know and I don't care." */
2331 if (modcount < 10000 &&
2332 ((LISTOP*)right)->op_last->op_type == OP_CONST)
2334 SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
2336 sv_setiv(sv, modcount+1);
2344 right = newOP(OP_UNDEF, 0);
2345 if (right->op_type == OP_READLINE) {
2346 right->op_flags |= OPf_STACKED;
2347 return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right));
2350 eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
2351 op = newBINOP(OP_SASSIGN, flags,
2352 scalar(right), mod(scalar(left), OP_SASSIGN) );
2364 newSTATEOP(flags, label, op)
2369 U32 seq = intro_my();
2372 Newz(1101, cop, 1, COP);
2373 if (perldb && curcop->cop_line && curstash != debstash) {
2374 cop->op_type = OP_DBSTATE;
2375 cop->op_ppaddr = ppaddr[ OP_DBSTATE ];
2378 cop->op_type = OP_NEXTSTATE;
2379 cop->op_ppaddr = ppaddr[ OP_NEXTSTATE ];
2381 cop->op_flags = flags;
2382 cop->op_private = 0 | (flags >> 8);
2383 cop->op_next = (OP*)cop;
2386 cop->cop_label = label;
2387 hints |= HINT_BLOCK_SCOPE;
2390 cop->cop_arybase = curcop->cop_arybase;
2392 if (copline == NOLINE)
2393 cop->cop_line = curcop->cop_line;
2395 cop->cop_line = copline;
2398 cop->cop_filegv = (GV*)SvREFCNT_inc(curcop->cop_filegv);
2399 cop->cop_stash = curstash;
2401 if (perldb && curstash != debstash) {
2402 SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE);
2403 if (svp && *svp != &sv_undef && !SvIOK(*svp)) {
2404 (void)SvIOK_on(*svp);
2406 SvSTASH(*svp) = (HV*)cop;
2410 return prepend_elem(OP_LINESEQ, (OP*)cop, op);
2413 /* "Introduce" my variables to visible status. */
2421 if (! min_intro_pending)
2424 svp = AvARRAY(comppad_name);
2425 for (i = min_intro_pending; i <= max_intro_pending; i++) {
2426 if ((sv = svp[i]) && sv != &sv_undef && !SvIVX(sv)) {
2427 SvIVX(sv) = 999999999; /* Don't know scope end yet. */
2428 SvNVX(sv) = (double)cop_seqmax;
2431 min_intro_pending = 0;
2432 comppad_name_fill = max_intro_pending; /* Needn't search higher */
2433 return cop_seqmax++;
2437 newLOGOP(type, flags, first, other)
2446 if (type == OP_XOR) /* Not short circuit, but here by precedence. */
2447 return newBINOP(type, flags, scalar(first), scalar(other));
2449 scalarboolean(first);
2450 /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
2451 if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) {
2452 if (type == OP_AND || type == OP_OR) {
2458 first = cUNOP->op_first;
2460 first->op_next = op->op_next;
2461 cUNOP->op_first = Nullop;
2465 if (first->op_type == OP_CONST) {
2466 if (dowarn && (first->op_private & OPpCONST_BARE))
2467 warn("Probable precedence problem on %s", op_desc[type]);
2468 if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
2477 else if (first->op_type == OP_WANTARRAY) {
2483 else if (dowarn && (first->op_flags & OPf_KIDS)) {
2484 OP *k1 = ((UNOP*)first)->op_first;
2485 OP *k2 = k1->op_sibling;
2487 switch (first->op_type)
2490 if (k2 && k2->op_type == OP_READLINE
2491 && (k2->op_flags & OPf_STACKED)
2492 && (k1->op_type == OP_RV2SV || k1->op_type == OP_PADSV))
2493 warnop = k2->op_type;
2497 if (k1->op_type == OP_READDIR || k1->op_type == OP_GLOB)
2498 warnop = k1->op_type;
2502 line_t oldline = curcop->cop_line;
2503 curcop->cop_line = copline;
2504 warn("Value of %s construct can be \"0\"; test with defined()",
2506 curcop->cop_line = oldline;
2513 if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
2514 other->op_private |= OPpASSIGN_BACKWARDS; /* other is an OP_SASSIGN */
2516 Newz(1101, logop, 1, LOGOP);
2518 logop->op_type = type;
2519 logop->op_ppaddr = ppaddr[type];
2520 logop->op_first = first;
2521 logop->op_flags = flags | OPf_KIDS;
2522 logop->op_other = LINKLIST(other);
2523 logop->op_private = 1 | (flags >> 8);
2525 /* establish postfix order */
2526 logop->op_next = LINKLIST(first);
2527 first->op_next = (OP*)logop;
2528 first->op_sibling = other;
2530 op = newUNOP(OP_NULL, 0, (OP*)logop);
2531 other->op_next = op;
2537 newCONDOP(flags, first, trueop, falseop)
2547 return newLOGOP(OP_AND, 0, first, trueop);
2549 return newLOGOP(OP_OR, 0, first, falseop);
2551 scalarboolean(first);
2552 if (first->op_type == OP_CONST) {
2553 if (SvTRUE(((SVOP*)first)->op_sv)) {
2564 else if (first->op_type == OP_WANTARRAY) {
2568 Newz(1101, condop, 1, CONDOP);
2570 condop->op_type = OP_COND_EXPR;
2571 condop->op_ppaddr = ppaddr[OP_COND_EXPR];
2572 condop->op_first = first;
2573 condop->op_flags = flags | OPf_KIDS;
2574 condop->op_true = LINKLIST(trueop);
2575 condop->op_false = LINKLIST(falseop);
2576 condop->op_private = 1 | (flags >> 8);
2578 /* establish postfix order */
2579 condop->op_next = LINKLIST(first);
2580 first->op_next = (OP*)condop;
2582 first->op_sibling = trueop;
2583 trueop->op_sibling = falseop;
2584 op = newUNOP(OP_NULL, 0, (OP*)condop);
2586 trueop->op_next = op;
2587 falseop->op_next = op;
2593 newRANGE(flags, left, right)
2603 Newz(1101, condop, 1, CONDOP);
2605 condop->op_type = OP_RANGE;
2606 condop->op_ppaddr = ppaddr[OP_RANGE];
2607 condop->op_first = left;
2608 condop->op_flags = OPf_KIDS;
2609 condop->op_true = LINKLIST(left);
2610 condop->op_false = LINKLIST(right);
2611 condop->op_private = 1 | (flags >> 8);
2613 left->op_sibling = right;
2615 condop->op_next = (OP*)condop;
2616 flip = newUNOP(OP_FLIP, flags, (OP*)condop);
2617 flop = newUNOP(OP_FLOP, 0, flip);
2618 op = newUNOP(OP_NULL, 0, flop);
2621 left->op_next = flip;
2622 right->op_next = flop;
2624 condop->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
2625 sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV);
2626 flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
2627 sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
2629 flip->op_private = left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
2630 flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
2633 if (!flip->op_private || !flop->op_private)
2634 linklist(op); /* blow off optimizer unless constant */
2640 newLOOPOP(flags, debuggable, expr, block)
2648 int once = block && block->op_flags & OPf_SPECIAL &&
2649 (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
2652 if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
2653 return block; /* do {} while 0 does once */
2654 if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB) {
2655 expr = newUNOP(OP_DEFINED, 0,
2656 newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
2660 listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
2661 op = newLOGOP(OP_AND, 0, expr, listop);
2663 ((LISTOP*)listop)->op_last->op_next = LINKLIST(op);
2665 if (once && op != listop)
2666 op->op_next = ((LOGOP*)cUNOP->op_first)->op_other;
2669 op = newUNOP(OP_NULL, 0, op); /* or do {} while 1 loses outer block */
2671 op->op_flags |= flags;
2673 op->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/
2678 newWHILEOP(flags, debuggable, loop, expr, block, cont)
2692 if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) {
2693 expr = newUNOP(OP_DEFINED, 0,
2694 newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
2698 block = newOP(OP_NULL, 0);
2701 next = LINKLIST(cont);
2703 cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
2705 listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
2706 redo = LINKLIST(listop);
2709 op = newLOGOP(OP_AND, 0, expr, scalar(listop));
2710 if (op == expr && op->op_type == OP_CONST && !SvTRUE(cSVOP->op_sv)) {
2711 op_free(expr); /* oops, it's a while (0) */
2713 return Nullop; /* (listop already freed by newLOGOP) */
2715 ((LISTOP*)listop)->op_last->op_next = condop =
2716 (op == listop ? redo : LINKLIST(op));
2724 Newz(1101,loop,1,LOOP);
2725 loop->op_type = OP_ENTERLOOP;
2726 loop->op_ppaddr = ppaddr[OP_ENTERLOOP];
2727 loop->op_private = 0;
2728 loop->op_next = (OP*)loop;
2731 op = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, op);
2733 loop->op_redoop = redo;
2734 loop->op_lastop = op;
2737 loop->op_nextop = next;
2739 loop->op_nextop = op;
2741 op->op_flags |= flags;
2742 op->op_private |= (flags >> 8);
2747 #ifndef CAN_PROTOTYPE
2748 newFOROP(flags,label,forline,sv,expr,block,cont)
2757 newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
2758 #endif /* CAN_PROTOTYPE */
2766 if (sv->op_type == OP_RV2SV) { /* symbol table variable */
2767 sv->op_type = OP_RV2GV;
2768 sv->op_ppaddr = ppaddr[OP_RV2GV];
2770 else if (sv->op_type == OP_PADSV) { /* private variable */
2771 padoff = sv->op_targ;
2776 croak("Can't use %s for loop variable", op_desc[sv->op_type]);
2779 sv = newGVOP(OP_GV, 0, defgv);
2781 if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) {
2782 expr = scalar(ref(expr, OP_ITER));
2783 iterflags |= OPf_STACKED;
2785 loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
2786 append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART),
2788 assert(!loop->op_next);
2789 Renew(loop, 1, LOOP);
2790 loop->op_targ = padoff;
2791 return newSTATEOP(0, label, newWHILEOP(flags, 1, loop,
2792 newOP(OP_ITER, 0), block, cont));
2796 newLOOPEX(type, label)
2801 if (type != OP_GOTO || label->op_type == OP_CONST) {
2802 op = newPVOP(type, 0, savepv(
2803 label->op_type == OP_CONST
2804 ? SvPVx(((SVOP*)label)->op_sv, na)
2809 if (label->op_type == OP_ENTERSUB)
2810 label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
2811 op = newUNOP(type, OPf_STACKED, label);
2813 hints |= HINT_BLOCK_SCOPE;
2821 if (!CvXSUB(cv) && CvROOT(cv)) {
2823 croak("Can't undef active subroutine");
2830 op_free(CvROOT(cv));
2831 CvROOT(cv) = Nullop;
2835 SvREFCNT_dec(CvGV(cv));
2837 SvREFCNT_dec(CvOUTSIDE(cv));
2838 CvOUTSIDE(cv) = Nullcv;
2839 if (CvPADLIST(cv)) {
2840 /* may be during global destruction */
2841 if (SvREFCNT(CvPADLIST(cv))) {
2842 I32 i = AvFILL(CvPADLIST(cv));
2844 SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
2848 SvREFCNT_dec((SV*)CvPADLIST(cv));
2850 CvPADLIST(cv) = Nullav;
2854 #ifdef DEBUG_CLOSURES
2859 CV *outside = CvOUTSIDE(cv);
2860 AV* padlist = CvPADLIST(cv);
2861 AV* pad_name = (AV*)*av_fetch(padlist, 0, FALSE);
2862 AV* pad = (AV*)*av_fetch(padlist, 1, FALSE);
2863 SV** pname = AvARRAY(pad_name);
2864 SV** ppad = AvARRAY(pad);
2867 PerlIO_printf(Perl_debug_log, "\tCV=0x%p (%s), OUTSIDE=0x%p (%s)\n",
2869 (CvANON(cv) ? "ANON"
2870 : (cv == main_cv) ? "MAIN"
2871 : CvUNIQUE(outside) ? "UNIQUE"
2872 : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
2875 : CvANON(outside) ? "ANON"
2876 : (outside == main_cv) ? "MAIN"
2877 : CvUNIQUE(outside) ? "UNIQUE"
2878 : CvGV(outside) ? GvNAME(CvGV(outside)) : "UNDEFINED"));
2880 for (ix = 1; ix <= AvFILL(pad); ix++) {
2881 if (SvPOK(pname[ix]))
2882 PerlIO_printf(Perl_debug_log, "\t%4d. 0x%p (\"%s\" %ld-%ld)\n",
2883 ix, ppad[ix], SvPVX(pname[ix]),
2884 (long)I_32(SvNVX(pname[ix])),
2885 (long)SvIVX(pname[ix]));
2888 #endif /* DEBUG_CLOSURES */
2891 cv_clone2(proto, outside)
2897 AV* protopadlist = CvPADLIST(proto);
2898 AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
2899 AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
2900 SV** pname = AvARRAY(protopad_name);
2901 SV** ppad = AvARRAY(protopad);
2905 assert(!CvUNIQUE(proto));
2912 cv = compcv = (CV*)NEWSV(1104,0);
2913 sv_upgrade((SV *)cv, SvTYPE(proto));
2918 CvFILEGV(cv) = CvFILEGV(proto);
2919 CvGV(cv) = (GV*)SvREFCNT_inc(CvGV(proto));
2920 CvSTASH(cv) = CvSTASH(proto);
2921 CvROOT(cv) = CvROOT(proto);
2922 CvSTART(cv) = CvSTART(proto);
2924 CvOUTSIDE(cv) = (CV*)SvREFCNT_inc(outside);
2928 comppadlist = newAV();
2929 AvREAL_off(comppadlist);
2930 av_store(comppadlist, 0, SvREFCNT_inc((SV*)protopad_name));
2931 av_store(comppadlist, 1, (SV*)comppad);
2932 CvPADLIST(cv) = comppadlist;
2933 av_fill(comppad, AvFILL(protopad));
2934 curpad = AvARRAY(comppad);
2936 av = newAV(); /* will be @_ */
2938 av_store(comppad, 0, (SV*)av);
2939 AvFLAGS(av) = AVf_REIFY;
2941 for (ix = AvFILL(protopad); ix > 0; ix--) {
2943 if (pname[ix] != &sv_undef) {
2944 char *name = SvPVX(pname[ix]); /* XXX */
2945 if (SvFLAGS(pname[ix]) & SVf_FAKE) { /* lexical from outside? */
2946 I32 off = pad_findlex(name, ix, SvIVX(pname[ix]),
2947 CvOUTSIDE(cv), cxstack_ix);
2949 curpad[ix] = SvREFCNT_inc(ppad[ix]);
2951 croak("panic: cv_clone: %s", name);
2953 else { /* our own lexical */
2955 /* anon code -- we'll come back for it */
2956 sv = SvREFCNT_inc(ppad[ix]);
2958 else if (*name == '@')
2960 else if (*name == '%')
2976 /* Now that vars are all in place, clone nested closures. */
2978 for (ix = AvFILL(protopad); ix > 0; ix--) {
2979 if (pname[ix] != &sv_undef
2980 && !(SvFLAGS(pname[ix]) & SVf_FAKE)
2981 && *SvPVX(pname[ix]) == '&'
2982 && CvCLONE(ppad[ix]))
2984 CV *kid = cv_clone2((CV*)ppad[ix], cv);
2985 SvREFCNT_dec(ppad[ix]);
2988 curpad[ix] = (SV*)kid;
2992 #ifdef DEBUG_CLOSURES
2993 PerlIO_printf(Perl_debug_log, "Cloned inside:\n");
2995 PerlIO_printf(Perl_debug_log, " from:\n");
2997 PerlIO_printf(Perl_debug_log, " to:\n");
3009 return cv_clone2(proto, CvOUTSIDE(proto));
3019 if(cv && SvPOK(cv) && !SvCUR(cv)) {
3020 for (o = CvSTART(cv); o; o = o->op_next) {
3021 OPCODE type = o->op_type;
3023 if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK)
3025 if (type == OP_LEAVESUB || type == OP_RETURN)
3027 if (type != OP_CONST || sv)
3030 sv = ((SVOP*)o)->op_sv;
3037 newSUB(floor,op,proto,block)
3043 char *name = op ? SvPVx(cSVOP->op_sv, na) : Nullch;
3044 GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
3051 if (cv = (name ? GvCV(gv) : Nullcv)) {
3053 /* just a cached method */
3057 else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
3058 /* already defined (or promised) */
3060 SV* const_sv = cv_const_sv(cv);
3061 char *p = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch;
3063 if((!proto != !SvPOK(cv)) || (p && strNE(SvPV((SV*)cv,na), p))) {
3064 warn("Prototype mismatch: (%s) vs (%s)",
3065 SvPOK(cv) ? SvPV((SV*)cv,na) : "none",
3068 if (const_sv || dowarn) {
3069 line_t oldline = curcop->cop_line;
3070 curcop->cop_line = copline;
3071 warn(const_sv ? "Constant subroutine %s redefined"
3072 : "Subroutine %s redefined",name);
3073 curcop->cop_line = oldline;
3079 if (cv) { /* must reuse cv if autoloaded */
3081 CvFLAGS(cv) = CvFLAGS(compcv);
3082 CvOUTSIDE(cv) = CvOUTSIDE(compcv);
3083 CvOUTSIDE(compcv) = 0;
3084 CvPADLIST(cv) = CvPADLIST(compcv);
3085 CvPADLIST(compcv) = 0;
3086 if (SvREFCNT(compcv) > 1) /* XXX Make closures transit through stub. */
3087 CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)cv);
3088 SvREFCNT_dec(compcv);
3098 CvGV(cv) = (GV*)SvREFCNT_inc(gv);
3099 CvFILEGV(cv) = curcop->cop_filegv;
3100 CvSTASH(cv) = curstash;
3103 char *p = SvPVx(((SVOP*)proto)->op_sv, na);
3104 sv_setpv((SV*)cv, p);
3118 av = newAV(); /* Will be @_ */
3120 av_store(comppad, 0, (SV*)av);
3121 AvFLAGS(av) = AVf_REIFY;
3123 for (ix = AvFILL(comppad); ix > 0; ix--) {
3124 if (!SvPADMY(curpad[ix]) && !SvIMMORTAL(curpad[ix]))
3125 SvPADTMP_on(curpad[ix]);
3128 if (AvFILL(comppad_name) < AvFILL(comppad))
3129 av_store(comppad_name, AvFILL(comppad), Nullsv);
3131 CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
3132 CvSTART(cv) = LINKLIST(CvROOT(cv));
3133 CvROOT(cv)->op_next = 0;
3139 if (perldb && curstash != debstash) {
3141 SV *tmpstr = sv_newmortal();
3142 static GV *db_postponed;
3146 sprintf(buf, "%s:%ld",
3147 SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
3148 sv = newSVpv(buf,0);
3150 sprintf(buf,"%ld",(long)curcop->cop_line);
3152 gv_efullname3(tmpstr, gv, Nullch);
3153 hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
3154 if (!db_postponed) {
3155 db_postponed = gv_fetchpv("DB::postponed", TRUE, SVt_PVHV);
3157 hv = GvHVn(db_postponed);
3158 if (HvFILL(hv) >= 0 && hv_exists(hv, SvPVX(tmpstr), SvCUR(tmpstr))
3159 && (cv = GvCV(db_postponed))) {
3164 perl_call_sv((SV*)cv, G_DISCARD);
3168 if ((s = strrchr(name,':')))
3172 if (strEQ(s, "BEGIN") && !error_count) {
3174 SAVESPTR(compiling.cop_filegv);
3175 SAVEI16(compiling.cop_line);
3182 DEBUG_x( dump_sub(gv) );
3183 av_push(beginav, (SV *)cv);
3187 curcop = &compiling;
3190 else if (strEQ(s, "END") && !error_count) {
3193 av_unshift(endav, 1);
3194 av_store(endav, 0, (SV *)cv);
3206 newXSUB(name, ix, subaddr, filename)
3212 CV* cv = newXS(name, (void(*)())subaddr, filename);
3214 CvXSUBANY(cv).any_i32 = ix;
3220 newXS(name, subaddr, filename)
3222 void (*subaddr) _((CV*));
3225 GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV);
3228 if (cv = (name ? GvCV(gv) : Nullcv)) {
3230 /* just a cached method */
3234 else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
3235 /* already defined (or promised) */
3237 line_t oldline = curcop->cop_line;
3238 curcop->cop_line = copline;
3239 warn("Subroutine %s redefined",name);
3240 curcop->cop_line = oldline;
3247 if (cv) /* must reuse cv if autoloaded */
3250 cv = (CV*)NEWSV(1105,0);
3251 sv_upgrade((SV *)cv, SVt_PVCV);
3258 CvGV(cv) = (GV*)SvREFCNT_inc(gv);
3259 CvFILEGV(cv) = gv_fetchfile(filename);
3260 CvXSUB(cv) = subaddr;
3263 char *s = strrchr(name,':');
3268 if (strEQ(s, "BEGIN")) {
3271 av_push(beginav, (SV *)cv);
3274 else if (strEQ(s, "END")) {
3277 av_unshift(endav, 1);
3278 av_store(endav, 0, (SV *)cv);
3289 newFORM(floor,op,block)
3300 name = SvPVx(cSVOP->op_sv, na);
3303 gv = gv_fetchpv(name,TRUE, SVt_PVFM);
3305 if (cv = GvFORM(gv)) {
3307 line_t oldline = curcop->cop_line;
3309 curcop->cop_line = copline;
3310 warn("Format %s redefined",name);
3311 curcop->cop_line = oldline;
3317 CvGV(cv) = (GV*)SvREFCNT_inc(gv);
3318 CvFILEGV(cv) = curcop->cop_filegv;
3320 for (ix = AvFILL(comppad); ix > 0; ix--) {
3321 if (!SvPADMY(curpad[ix]) && !SvIMMORTAL(curpad[ix]))
3322 SvPADTMP_on(curpad[ix]);
3325 CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
3326 CvSTART(cv) = LINKLIST(CvROOT(cv));
3327 CvROOT(cv)->op_next = 0;
3338 return newUNOP(OP_REFGEN, 0,
3339 mod(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN));
3346 return newUNOP(OP_REFGEN, 0,
3347 mod(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN));
3351 newANONSUB(floor, proto, block)
3356 return newUNOP(OP_REFGEN, 0,
3357 newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, proto, block)));
3364 switch (o->op_type) {
3366 o->op_type = OP_PADAV;
3367 o->op_ppaddr = ppaddr[OP_PADAV];
3368 return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV);
3371 o->op_type = OP_RV2AV;
3372 o->op_ppaddr = ppaddr[OP_RV2AV];
3377 warn("oops: oopsAV");
3387 switch (o->op_type) {
3390 o->op_type = OP_PADHV;
3391 o->op_ppaddr = ppaddr[OP_PADHV];
3392 return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV);
3396 o->op_type = OP_RV2HV;
3397 o->op_ppaddr = ppaddr[OP_RV2HV];
3402 warn("oops: oopsHV");
3412 if (o->op_type == OP_PADANY) {
3413 o->op_type = OP_PADAV;
3414 o->op_ppaddr = ppaddr[OP_PADAV];
3417 return newUNOP(OP_RV2AV, 0, scalar(o));
3425 if (type == OP_MAPSTART)
3426 return newUNOP(OP_NULL, 0, o);
3427 return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
3434 if (o->op_type == OP_PADANY) {
3435 o->op_type = OP_PADHV;
3436 o->op_ppaddr = ppaddr[OP_PADHV];
3439 return newUNOP(OP_RV2HV, 0, scalar(o));
3446 croak("NOT IMPL LINE %d",__LINE__);
3456 return newUNOP(OP_RV2CV, flags, scalar(o));
3463 if (o->op_type == OP_PADANY) {
3464 o->op_type = OP_PADSV;
3465 o->op_ppaddr = ppaddr[OP_PADSV];
3468 return newUNOP(OP_RV2SV, 0, scalar(o));
3471 /* Check routines. */
3480 name = NEWSV(1106,0);
3481 sv_upgrade(name, SVt_PVNV);
3482 sv_setpvn(name, "&", 1);
3485 ix = pad_alloc(op->op_type, SVs_PADMY);
3486 av_store(comppad_name, ix, name);
3487 av_store(comppad, ix, cSVOP->op_sv);
3488 SvPADMY_on(cSVOP->op_sv);
3489 cSVOP->op_sv = Nullsv;
3490 cSVOP->op_targ = ix;
3498 op->op_private = hints;
3506 if (cUNOP->op_first->op_type == OP_CONCAT)
3507 op->op_flags |= OPf_STACKED;
3515 if (op->op_flags & OPf_KIDS) {
3518 OPCODE type = op->op_type;
3519 op = modkids(ck_fun(op), type);
3520 kid = cUNOP->op_first;
3521 newop = kUNOP->op_first->op_sibling;
3523 (newop->op_sibling ||
3524 !(opargs[newop->op_type] & OA_RETSCALAR) ||
3525 newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
3526 newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
3530 op_free(kUNOP->op_first);
3531 kUNOP->op_first = newop;
3533 op->op_ppaddr = ppaddr[++op->op_type];
3543 if (op->op_flags & OPf_KIDS) {
3544 OP *kid = cUNOP->op_first;
3545 if (kid->op_type == OP_HSLICE)
3546 op->op_private |= OPpSLICE;
3547 else if (kid->op_type != OP_HELEM)
3548 croak("%s argument is not a HASH element or slice",
3549 op_desc[op->op_type]);
3559 I32 type = op->op_type;
3561 if (op->op_flags & OPf_KIDS) {
3562 if (cLISTOP->op_first->op_type == OP_STUB) {
3564 op = newUNOP(type, OPf_SPECIAL,
3565 newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV)));
3576 hints |= HINT_BLOCK_SCOPE;
3577 if (op->op_flags & OPf_KIDS) {
3578 SVOP *kid = (SVOP*)cUNOP->op_first;
3581 op->op_flags &= ~OPf_KIDS;
3584 else if (kid->op_type == OP_LINESEQ) {
3587 kid->op_next = op->op_next;
3588 cUNOP->op_first = 0;
3591 Newz(1101, enter, 1, LOGOP);
3592 enter->op_type = OP_ENTERTRY;
3593 enter->op_ppaddr = ppaddr[OP_ENTERTRY];
3594 enter->op_private = 0;
3596 /* establish postfix order */
3597 enter->op_next = (OP*)enter;
3599 op = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
3600 op->op_type = OP_LEAVETRY;
3601 op->op_ppaddr = ppaddr[OP_LEAVETRY];
3602 enter->op_other = op;
3608 op = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3610 op->op_targ = (PADOFFSET)hints;
3619 if (op->op_flags & OPf_STACKED) {
3621 kid = cUNOP->op_first->op_sibling;
3622 if (kid->op_type == OP_RV2GV)
3635 if (op->op_flags & OPf_KIDS) {
3636 OP *kid = cUNOP->op_first;
3637 if (kid->op_type != OP_HELEM)
3638 croak("%s argument is not a HASH element", op_desc[op->op_type]);
3648 o = fold_constants(o);
3649 if (o->op_type == OP_CONST)
3658 SVOP *kid = (SVOP*)cUNOP->op_first;
3660 op->op_private |= (hints & HINT_STRICT_REFS);
3661 if (kid->op_type == OP_CONST) {
3666 name = SvPV(kid->op_sv, na);
3667 if ((hints & HINT_STRICT_REFS) && (kid->op_private & OPpCONST_BARE)) {
3668 char *badthing = Nullch;
3669 switch (op->op_type) {
3671 badthing = "a SCALAR";
3674 badthing = "an ARRAY";
3677 badthing = "a HASH";
3682 "Can't use bareword (\"%s\") as %s ref while \"strict refs\" in use",
3685 kid->op_type = OP_GV;
3686 iscv = (op->op_type == OP_RV2CV) * 2;
3687 for (gv = 0; !gv; iscv++) {
3689 * This is a little tricky. We only want to add the symbol if we
3690 * didn't add it in the lexer. Otherwise we get duplicate strict
3691 * warnings. But if we didn't add it in the lexer, we must at
3692 * least pretend like we wanted to add it even if it existed before,
3693 * or we get possible typo warnings. OPpCONST_ENTERED says
3694 * whether the lexer already added THIS instance of this symbol.
3696 gv = gv_fetchpv(name,
3697 iscv | !(kid->op_private & OPpCONST_ENTERED),
3700 : op->op_type == OP_RV2SV
3702 : op->op_type == OP_RV2AV
3704 : op->op_type == OP_RV2HV
3708 SvREFCNT_dec(kid->op_sv);
3709 kid->op_sv = SvREFCNT_inc(gv);
3718 I32 type = op->op_type;
3720 if (op->op_flags & OPf_REF)
3723 if (op->op_flags & OPf_KIDS) {
3724 SVOP *kid = (SVOP*)cUNOP->op_first;
3726 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
3727 OP *newop = newGVOP(type, OPf_REF,
3728 gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
3735 if (type == OP_FTTTY)
3736 return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
3739 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3752 int type = op->op_type;
3753 register I32 oa = opargs[type] >> OASHIFT;
3755 if (op->op_flags & OPf_STACKED) {
3756 if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
3759 return no_fh_allowed(op);
3762 if (op->op_flags & OPf_KIDS) {
3763 tokid = &cLISTOP->op_first;
3764 kid = cLISTOP->op_first;
3765 if (kid->op_type == OP_PUSHMARK ||
3766 kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
3768 tokid = &kid->op_sibling;
3769 kid = kid->op_sibling;
3771 if (!kid && opargs[type] & OA_DEFGV)
3772 *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
3776 sibl = kid->op_sibling;
3790 if (kid->op_type == OP_CONST &&
3791 (kid->op_private & OPpCONST_BARE)) {
3792 char *name = SvPVx(((SVOP*)kid)->op_sv, na);
3793 OP *newop = newAVREF(newGVOP(OP_GV, 0,
3794 gv_fetchpv(name, TRUE, SVt_PVAV) ));
3796 warn("Array @%s missing the @ in argument %d of %s()",
3797 name, numargs, op_desc[type]);
3800 kid->op_sibling = sibl;
3803 else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
3804 bad_type(numargs, "array", op_desc[op->op_type], kid);
3808 if (kid->op_type == OP_CONST &&
3809 (kid->op_private & OPpCONST_BARE)) {
3810 char *name = SvPVx(((SVOP*)kid)->op_sv, na);
3811 OP *newop = newHVREF(newGVOP(OP_GV, 0,
3812 gv_fetchpv(name, TRUE, SVt_PVHV) ));
3814 warn("Hash %%%s missing the %% in argument %d of %s()",
3815 name, numargs, op_desc[type]);
3818 kid->op_sibling = sibl;
3821 else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
3822 bad_type(numargs, "hash", op_desc[op->op_type], kid);
3827 OP *newop = newUNOP(OP_NULL, 0, kid);
3828 kid->op_sibling = 0;
3830 newop->op_next = newop;
3832 kid->op_sibling = sibl;
3837 if (kid->op_type != OP_GV) {
3838 if (kid->op_type == OP_CONST &&
3839 (kid->op_private & OPpCONST_BARE)) {
3840 OP *newop = newGVOP(OP_GV, 0,
3841 gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE,
3847 kid->op_sibling = 0;
3848 kid = newUNOP(OP_RV2GV, 0, scalar(kid));
3850 kid->op_sibling = sibl;
3856 mod(scalar(kid), type);
3860 tokid = &kid->op_sibling;
3861 kid = kid->op_sibling;
3863 op->op_private |= numargs;
3865 return too_many_arguments(op,op_desc[op->op_type]);
3868 else if (opargs[type] & OA_DEFGV) {
3870 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3874 while (oa & OA_OPTIONAL)
3876 if (oa && oa != OA_LIST)
3877 return too_few_arguments(op,op_desc[op->op_type]);
3886 GV *gv = gv_fetchpv("glob", FALSE, SVt_PVCV);
3888 if (gv && GvIMPORTED_CV(gv)) {
3889 op->op_type = OP_LIST;
3890 op->op_ppaddr = ppaddr[OP_LIST];
3891 op = newUNOP(OP_ENTERSUB, OPf_STACKED,
3892 append_elem(OP_LIST, op,
3893 scalar(newUNOP(OP_RV2CV, 0,
3894 newGVOP(OP_GV, 0, gv)))));
3897 if ((op->op_flags & OPf_KIDS) && !cLISTOP->op_first->op_sibling)
3898 append_elem(OP_GLOB, op, newSVREF(newGVOP(OP_GV, 0, defgv)));
3899 gv = newGVgen("main");
3901 append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
3912 OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
3914 op->op_ppaddr = ppaddr[OP_GREPSTART];
3915 Newz(1101, gwop, 1, LOGOP);
3917 if (op->op_flags & OPf_STACKED) {
3920 kid = cLISTOP->op_first->op_sibling;
3921 for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) {
3924 kid->op_next = (OP*)gwop;
3925 op->op_flags &= ~OPf_STACKED;
3927 kid = cLISTOP->op_first->op_sibling;
3928 if (type == OP_MAPWHILE)
3935 kid = cLISTOP->op_first->op_sibling;
3936 if (kid->op_type != OP_NULL)
3937 croak("panic: ck_grep");
3938 kid = kUNOP->op_first;
3940 gwop->op_type = type;
3941 gwop->op_ppaddr = ppaddr[type];
3942 gwop->op_first = listkids(op);
3943 gwop->op_flags |= OPf_KIDS;
3944 gwop->op_private = 1;
3945 gwop->op_other = LINKLIST(kid);
3946 gwop->op_targ = pad_alloc(type, SVs_PADTMP);
3947 kid->op_next = (OP*)gwop;
3949 kid = cLISTOP->op_first->op_sibling;
3950 if (!kid || !kid->op_sibling)
3951 return too_few_arguments(op,op_desc[op->op_type]);
3952 for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
3953 mod(kid, OP_GREPSTART);
3962 if (op->op_flags & OPf_KIDS) {
3963 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
3964 if (kid && kid->op_type == OP_CONST)
3965 fbm_compile(((SVOP*)kid)->op_sv);
3974 /* XXX length optimization goes here */
3982 OPCODE type = op->op_type;
3983 return modkids(ck_fun(op), type);
3990 OPCODE type = op->op_type;
3991 return refkids(ck_fun(op), type);
4000 kid = cLISTOP->op_first;
4002 op = force_list(op);
4003 kid = cLISTOP->op_first;
4005 if (kid->op_type == OP_PUSHMARK)
4006 kid = kid->op_sibling;
4007 if (kid && op->op_flags & OPf_STACKED)
4008 kid = kid->op_sibling;
4009 else if (kid && !kid->op_sibling) { /* print HANDLE; */
4010 if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
4011 op->op_flags |= OPf_STACKED; /* make it a filehandle */
4012 kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
4013 cLISTOP->op_first->op_sibling = kid;
4014 cLISTOP->op_last = kid;
4015 kid = kid->op_sibling;
4020 append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
4026 if (hints & HINT_LOCALE)
4027 op->op_private |= OPpLOCALE;
4041 if (hints & HINT_LOCALE)
4042 op->op_private |= OPpLOCALE;
4054 if (hints & HINT_LOCALE)
4055 op->op_private |= OPpLOCALE;
4065 cPMOP->op_pmflags |= PMf_RUNTIME;
4066 cPMOP->op_pmpermflags |= PMf_RUNTIME;
4081 if (cBINOP->op_first->op_flags & OPf_PARENS) {
4082 op->op_private |= OPpREPEAT_DOLIST;
4083 cBINOP->op_first = force_list(cBINOP->op_first);
4094 if (op->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */
4095 SVOP *kid = (SVOP*)cUNOP->op_first;
4097 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
4099 for (s = SvPVX(kid->op_sv); *s; s++) {
4100 if (*s == ':' && s[1] == ':') {
4102 Move(s+2, s+1, strlen(s+2)+1, char);
4103 --SvCUR(kid->op_sv);
4106 sv_catpvn(kid->op_sv, ".pm", 3);
4116 croak("NOT IMPL LINE %d",__LINE__);
4126 if (op->op_flags & OPf_KIDS) {
4127 kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
4128 if (kid && kid->op_sibling) {
4129 op->op_type = OP_SSELECT;
4130 op->op_ppaddr = ppaddr[OP_SSELECT];
4132 return fold_constants(op);
4136 kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
4137 if (kid && kid->op_type == OP_RV2GV)
4138 kid->op_private &= ~HINT_STRICT_REFS;
4146 I32 type = op->op_type;
4148 if (!(op->op_flags & OPf_KIDS)) {
4150 return newUNOP(type, 0,
4151 scalar(newUNOP(OP_RV2AV, 0,
4152 scalar(newGVOP(OP_GV, 0, subline
4154 : gv_fetchpv("ARGV", TRUE, SVt_PVAV) )))));
4156 return scalar(modkids(ck_fun(op), type));
4165 if (hints & HINT_LOCALE)
4166 op->op_private |= OPpLOCALE;
4169 if (op->op_flags & OPf_STACKED) {
4170 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
4172 kid = kUNOP->op_first; /* get past rv2gv */
4174 if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
4176 if (kid->op_type == OP_SCOPE) {
4180 else if (kid->op_type == OP_LEAVE) {
4181 if (op->op_type == OP_SORT) {
4182 null(kid); /* wipe out leave */
4185 for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
4186 if (k->op_next == kid)
4191 kid->op_next = 0; /* just disconnect the leave */
4192 k = kLISTOP->op_first;
4196 kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
4197 null(kid); /* wipe out rv2gv */
4198 if (op->op_type == OP_SORT)
4202 op->op_flags |= OPf_SPECIAL;
4216 if (op->op_flags & OPf_STACKED)
4217 return no_fh_allowed(op);
4219 kid = cLISTOP->op_first;
4220 if (kid->op_type != OP_NULL)
4221 croak("panic: ck_split");
4222 kid = kid->op_sibling;
4223 op_free(cLISTOP->op_first);
4224 cLISTOP->op_first = kid;
4226 cLISTOP->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
4227 cLISTOP->op_last = kid; /* There was only one element previously */
4230 if (kid->op_type != OP_MATCH) {
4231 OP *sibl = kid->op_sibling;
4232 kid->op_sibling = 0;
4233 kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
4234 if (cLISTOP->op_first == cLISTOP->op_last)
4235 cLISTOP->op_last = kid;
4236 cLISTOP->op_first = kid;
4237 kid->op_sibling = sibl;
4240 if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
4241 SvREFCNT_dec(pm->op_pmshort); /* can't use substring to optimize */
4245 kid->op_type = OP_PUSHRE;
4246 kid->op_ppaddr = ppaddr[OP_PUSHRE];
4249 if (!kid->op_sibling)
4250 append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
4252 kid = kid->op_sibling;
4255 if (!kid->op_sibling)
4256 append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0)));
4258 kid = kid->op_sibling;
4261 if (kid->op_sibling)
4262 return too_many_arguments(op,op_desc[op->op_type]);
4271 OP *prev = ((cUNOP->op_first->op_sibling)
4272 ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first;
4273 OP *o = prev->op_sibling;
4280 for (cvop = o; cvop->op_sibling; cvop = cvop->op_sibling) ;
4281 if (cvop->op_type == OP_RV2CV) {
4283 op->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
4284 null(cvop); /* disable rv2cv */
4285 tmpop = (SVOP*)((UNOP*)cvop)->op_first;
4286 if (tmpop->op_type == OP_GV) {
4287 cv = GvCVu(tmpop->op_sv);
4288 if (cv && SvPOK(cv) && !(op->op_private & OPpENTERSUB_AMPER))
4289 proto = SvPV((SV*)cv,na);
4292 op->op_private |= (hints & HINT_STRICT_REFS);
4293 if (perldb && curstash != debstash)
4294 op->op_private |= OPpENTERSUB_DB;
4299 return too_many_arguments(op, CvNAME(cv));
4317 if (o->op_type != OP_REFGEN && o->op_type != OP_UNDEF)
4318 bad_type(arg, "block", CvNAME(cv), o);
4323 if (o->op_type == OP_RV2GV)
4327 o = newUNOP(OP_RV2GV, 0, kid);
4328 o->op_sibling = kid->op_sibling;
4329 kid->op_sibling = 0;
4330 prev->op_sibling = o;
4338 if (o->op_type != OP_RV2GV)
4339 bad_type(arg, "symbol", CvNAME(cv), o);
4342 if (o->op_type != OP_RV2CV)
4343 bad_type(arg, "sub", CvNAME(cv), o);
4346 if (o->op_type != OP_RV2SV && o->op_type != OP_PADSV)
4347 bad_type(arg, "scalar", CvNAME(cv), o);
4350 if (o->op_type != OP_RV2AV && o->op_type != OP_PADAV)
4351 bad_type(arg, "array", CvNAME(cv), o);
4354 if (o->op_type != OP_RV2HV && o->op_type != OP_PADHV)
4355 bad_type(arg, "hash", CvNAME(cv), o);
4359 o = newUNOP(OP_REFGEN, 0, kid);
4360 o->op_sibling = kid->op_sibling;
4361 kid->op_sibling = 0;
4362 prev->op_sibling = o;
4373 croak("Malformed prototype for %s: %s",
4374 CvNAME(cv),SvPV((SV*)cv,na));
4379 mod(o, OP_ENTERSUB);
4383 if (proto && !optional && *proto == '$')
4384 return too_few_arguments(op, CvNAME(cv));
4392 SvREADONLY_on(cSVOP->op_sv);
4400 if (op->op_flags & OPf_KIDS) {
4401 SVOP *kid = (SVOP*)cUNOP->op_first;
4403 if (kid->op_type == OP_NULL)
4404 kid = (SVOP*)kid->op_sibling;
4406 kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
4407 op->op_flags |= OPf_SPECIAL;
4412 /* A peephole optimizer. We visit the ops in the order they're to execute. */
4418 register OP* oldop = 0;
4419 if (!o || o->op_seq)
4424 for (; o; o = o->op_next) {
4430 switch (o->op_type) {
4433 curcop = ((COP*)o); /* for warnings */
4434 o->op_seq = op_seqmax++;
4445 if (o->op_next->op_type == OP_STRINGIFY)
4447 o->op_seq = op_seqmax++;
4450 if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) {
4451 o->op_seq = op_seqmax++;
4452 break; /* Scalar stub must produce undef. List stub is noop */
4456 if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
4457 curcop = ((COP*)op);
4463 if (oldop && o->op_next) {
4464 oldop->op_next = o->op_next;
4467 o->op_seq = op_seqmax++;
4471 if (o->op_next->op_type == OP_RV2SV) {
4472 if (!(o->op_next->op_private & OPpDEREF)) {
4474 o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
4475 o->op_next = o->op_next->op_next;
4476 o->op_type = OP_GVSV;
4477 o->op_ppaddr = ppaddr[OP_GVSV];
4480 else if (o->op_next->op_type == OP_RV2AV) {
4481 OP* pop = o->op_next->op_next;
4483 if (pop->op_type == OP_CONST &&
4484 (op = pop->op_next) &&
4485 pop->op_next->op_type == OP_AELEM &&
4486 !(pop->op_next->op_private & (OPpDEREF|OPpLVAL_INTRO)) &&
4487 (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
4491 SvREFCNT_dec(((SVOP*)pop)->op_sv);
4495 o->op_flags |= pop->op_next->op_flags & OPf_MOD;
4496 o->op_next = pop->op_next->op_next;
4497 o->op_type = OP_AELEMFAST;
4498 o->op_ppaddr = ppaddr[OP_AELEMFAST];
4499 o->op_private = (U8)i;
4500 GvAVn(((GVOP*)o)->op_gv);
4503 o->op_seq = op_seqmax++;
4510 o->op_seq = op_seqmax++;
4511 peep(cLOGOP->op_other);
4515 o->op_seq = op_seqmax++;
4516 peep(cCONDOP->op_true);
4517 peep(cCONDOP->op_false);
4521 o->op_seq = op_seqmax++;
4522 peep(cLOOP->op_redoop);
4523 peep(cLOOP->op_nextop);
4524 peep(cLOOP->op_lastop);
4529 o->op_seq = op_seqmax++;
4530 peep(cPMOP->op_pmreplstart);
4534 o->op_seq = op_seqmax++;
4535 if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
4536 if (o->op_next->op_sibling &&
4537 o->op_next->op_sibling->op_type != OP_DIE) {
4538 line_t oldline = curcop->cop_line;
4540 curcop->cop_line = ((COP*)o->op_next)->cop_line;
4541 warn("Statement unlikely to be reached");
4542 warn("(Maybe you meant system() when you said exec()?)\n");
4543 curcop->cop_line = oldline;
4548 o->op_seq = op_seqmax++;