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,o) \
29 ((op_mask && op_mask[type]) \
30 ? (croak("%s trapped by operation mask", op_desc[type]), (OP*)o) \
31 : (*check[type])((OP*)o))
33 #define CHECKOP(type,o) (*check[type])(o)
34 #endif /* USE_OP_MASK */
36 static I32 list_assignment _((OP *o));
37 static void bad_type _((I32 n, char *t, char *name, OP *kid));
38 static OP *modkids _((OP *o, I32 type));
39 static OP *no_fh_allowed _((OP *o));
40 static OP *scalarboolean _((OP *o));
41 static OP *too_few_arguments _((OP *o, char* name));
42 static OP *too_many_arguments _((OP *o, char* name));
43 static void null _((OP* o));
44 static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, I32 seq,
45 CV* startcv, I32 cx_ix));
51 SV* tmpsv = sv_newmortal();
52 gv_efullname(tmpsv, CvGV(cv));
53 return SvPV(tmpsv,na);
60 sprintf(tokenbuf,"Missing comma after first argument to %s function",
67 too_few_arguments(o, name)
71 sprintf(tokenbuf,"Not enough arguments for %s", name);
77 too_many_arguments(o, name)
81 sprintf(tokenbuf,"Too many arguments for %s", name);
87 bad_type(n, t, name, kid)
93 sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)",
94 (int) n, name, t, op_desc[kid->op_type]);
102 int type = o->op_type;
103 if (type != OP_AELEM && type != OP_HELEM) {
104 sprintf(tokenbuf, "Can't use subscript on %s", op_desc[type]);
106 if (type == OP_RV2HV || type == OP_ENTERSUB)
107 warn("(Did you mean $ or @ instead of %c?)\n",
108 type == OP_RV2HV ? '%' : '&');
112 /* "register" allocation */
122 if (!(isALPHA(name[1]) || name[1] == '_' && (int)strlen(name) > 2)) {
123 if (!isprint(name[1]))
124 sprintf(name+1, "^%c", name[1] ^ 64); /* XXX is tokenbuf, really */
125 croak("Can't use global %s in \"my\"",name);
127 off = pad_alloc(OP_PADSV, SVs_PADMY);
129 sv_upgrade(sv, SVt_PVNV);
131 av_store(comppad_name, off, sv);
132 SvNVX(sv) = (double)999999999;
133 SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */
134 if (!min_intro_pending)
135 min_intro_pending = off;
136 max_intro_pending = off;
138 av_store(comppad, off, (SV*)newAV());
139 else if (*name == '%')
140 av_store(comppad, off, (SV*)newHV());
141 SvPADMY_on(curpad[off]);
146 #ifndef CAN_PROTOTYPE
147 pad_findlex(name, newoff, seq, startcv, cx_ix)
154 pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix)
162 register CONTEXT *cx;
165 for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
166 AV* curlist = CvPADLIST(cv);
167 SV** svp = av_fetch(curlist, 0, FALSE);
169 if (!svp || *svp == &sv_undef)
172 svp = AvARRAY(curname);
173 for (off = AvFILL(curname); off > 0; off--) {
174 if ((sv = svp[off]) &&
177 seq > (I32)SvNVX(sv) &&
178 strEQ(SvPVX(sv), name))
180 I32 depth = CvDEPTH(cv) ? CvDEPTH(cv) : 1;
181 AV *oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
182 SV *oldsv = *av_fetch(oldpad, off, TRUE);
183 if (!newoff) { /* Not a mere clone operation. */
184 SV *sv = NEWSV(1103,0);
185 newoff = pad_alloc(OP_PADSV, SVs_PADMY);
186 sv_upgrade(sv, SVt_PVNV);
188 av_store(comppad_name, newoff, sv);
189 SvNVX(sv) = (double)curcop->cop_seq;
190 SvIVX(sv) = 999999999; /* A ref, intro immediately */
191 SvFLAGS(sv) |= SVf_FAKE;
193 av_store(comppad, newoff, SvREFCNT_inc(oldsv));
200 /* Nothing in current lexical context--try eval's context, if any.
201 * This is necessary to let the perldb get at lexically scoped variables.
202 * XXX This will also probably interact badly with eval tree caching.
206 for (i = cx_ix; i >= 0; i--) {
208 switch (cx->cx_type) {
210 if (i == 0 && saweval) {
211 seq = cxstack[saweval].blk_oldcop->cop_seq;
212 return pad_findlex(name, newoff, seq, main_cv, 0);
216 if (cx->blk_eval.old_op_type != OP_ENTEREVAL &&
217 cx->blk_eval.old_op_type != OP_ENTERTRY)
218 return 0; /* require must have its own scope */
225 if (debstash && CvSTASH(cv) == debstash) { /* ignore DB'* scope */
226 saweval = i; /* so we know where we were called from */
229 seq = cxstack[saweval].blk_oldcop->cop_seq;
230 return pad_findlex(name, newoff, seq, cv, i-1);
244 SV **svp = AvARRAY(comppad_name);
245 I32 seq = cop_seqmax;
249 * Special case to get lexical (and hence per-thread) @_.
250 * XXX I need to find out how to tell at parse-time whether use
251 * of @_ should refer to a lexical (from a sub) or defgv (global
252 * scope and maybe weird sub-ish things like formats). See
253 * startsub in perly.y. It's possible that @_ could be lexical
254 * (at least from subs) even in non-threaded perl.
256 if (strEQ(name, "@_"))
257 return 0; /* success. (NOT_IN_PAD indicates failure) */
258 #endif /* USE_THREADS */
260 /* The one we're looking for is probably just before comppad_name_fill. */
261 for (off = AvFILL(comppad_name); off > 0; off--) {
262 if ((sv = svp[off]) &&
265 seq > (I32)SvNVX(sv) &&
266 strEQ(SvPVX(sv), name))
268 return (PADOFFSET)off;
272 /* See if it's in a nested scope */
273 off = pad_findlex(name, 0, seq, CvOUTSIDE(compcv), cxstack_ix);
275 return off; /* pad_findlex returns 0 for failure...*/
277 return NOT_IN_PAD; /* ...but we return NOT_IN_PAD for failure */
285 SV **svp = AvARRAY(comppad_name);
287 if (min_intro_pending && fill < min_intro_pending) {
288 for (off = max_intro_pending; off >= min_intro_pending; off--) {
289 if ((sv = svp[off]) && sv != &sv_undef)
290 warn("%s never introduced", SvPVX(sv));
293 /* "Deintroduce" my variables that are leaving with this scope. */
294 for (off = AvFILL(comppad_name); off > fill; off--) {
295 if ((sv = svp[off]) && sv != &sv_undef && SvIVX(sv) == 999999999)
296 SvIVX(sv) = cop_seqmax;
301 pad_alloc(optype,tmptype)
309 if (AvARRAY(comppad) != curpad)
310 croak("panic: pad_alloc");
311 if (pad_reset_pending)
313 if (tmptype & SVs_PADMY) {
315 sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE);
316 } while (SvPADBUSY(sv)); /* need a fresh one */
317 retval = AvFILL(comppad);
321 sv = *av_fetch(comppad, ++padix, TRUE);
322 } while (SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY));
325 SvFLAGS(sv) |= tmptype;
326 curpad = AvARRAY(comppad);
328 DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx alloc %ld for %s\n",
329 (unsigned long) thr, (unsigned long) curpad,
330 (long) retval, op_name[optype]));
332 DEBUG_X(fprintf(stderr, "Pad alloc %ld for %s\n", (long) retval, op_name[optype]));
333 #endif /* USE_THREADS */
334 return (PADOFFSET)retval;
338 #ifndef CAN_PROTOTYPE
343 #endif /* CAN_PROTOTYPE */
347 DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx sv %d\n",
348 (unsigned long) thr, (unsigned long) curpad, po));
351 croak("panic: pad_sv po");
352 DEBUG_X(fprintf(stderr, "Pad sv %d\n", po));
353 #endif /* USE_THREADS */
354 return curpad[po]; /* eventually we'll turn this into a macro */
358 #ifndef CAN_PROTOTYPE
362 pad_free(PADOFFSET po)
363 #endif /* CAN_PROTOTYPE */
368 if (AvARRAY(comppad) != curpad)
369 croak("panic: pad_free curpad");
371 croak("panic: pad_free po");
373 DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx free %d\n",
374 (unsigned long) thr, (unsigned long) curpad, po));
376 DEBUG_X(fprintf(stderr, "Pad free %d\n", po));
377 #endif /* USE_THREADS */
378 if (curpad[po] && curpad[po] != &sv_undef)
379 SvPADTMP_off(curpad[po]);
385 #ifndef CAN_PROTOTYPE
389 pad_swipe(PADOFFSET po)
390 #endif /* CAN_PROTOTYPE */
393 if (AvARRAY(comppad) != curpad)
394 croak("panic: pad_swipe curpad");
396 croak("panic: pad_swipe po");
398 DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx swipe %d\n",
399 (unsigned long) thr, (unsigned long) curpad, po));
401 DEBUG_X(fprintf(stderr, "Pad swipe %d\n", po));
402 #endif /* USE_THREADS */
403 SvPADTMP_off(curpad[po]);
404 curpad[po] = NEWSV(1107,0);
405 SvPADTMP_on(curpad[po]);
416 if (AvARRAY(comppad) != curpad)
417 croak("panic: pad_reset curpad");
419 DEBUG_X(fprintf(stderr, "0x%lx Pad 0x%lx reset\n",
420 (unsigned long) thr, (unsigned long) curpad));
422 DEBUG_X(fprintf(stderr, "Pad reset\n"));
423 #endif /* USE_THREADS */
424 if (!tainting) { /* Can't mix tainted and non-tainted temporaries. */
425 for (po = AvMAX(comppad); po > padix_floor; po--) {
426 if (curpad[po] && curpad[po] != &sv_undef)
427 SvPADTMP_off(curpad[po]);
431 pad_reset_pending = FALSE;
440 register OP *kid, *nextkid;
445 if (o->op_flags & OPf_KIDS) {
446 for (kid = cUNOPo->op_first; kid; kid = nextkid) {
447 nextkid = kid->op_sibling; /* Get before next freeing kid */
452 switch (o->op_type) {
454 o->op_targ = 0; /* Was holding old type, if any. */
457 o->op_targ = 0; /* Was holding hints. */
461 SvREFCNT_dec(cGVOPo->op_gv);
465 SvREFCNT_dec(cCOPo->cop_filegv);
468 SvREFCNT_dec(cSVOPo->op_sv);
474 if (o->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
478 Safefree(cPVOPo->op_pv);
481 op_free(cPMOPo->op_pmreplroot);
485 pregfree(cPMOPo->op_pmregexp);
486 SvREFCNT_dec(cPMOPo->op_pmshort);
493 pad_free(o->op_targ);
502 if (o->op_type != OP_NULL && o->op_targ > 0)
503 pad_free(o->op_targ);
504 o->op_targ = o->op_type;
505 o->op_type = OP_NULL;
506 o->op_ppaddr = ppaddr[OP_NULL];
509 /* Contextualizers */
511 #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
522 /* establish postfix order */
523 if (cUNOPo->op_first) {
524 o->op_next = LINKLIST(cUNOPo->op_first);
525 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling) {
527 kid->op_next = LINKLIST(kid->op_sibling);
543 if (o && o->op_flags & OPf_KIDS) {
544 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
555 o->op_type == OP_SASSIGN && cBINOPo->op_first->op_type == OP_CONST) {
556 line_t oldline = curcop->cop_line;
558 if (copline != NOLINE)
559 curcop->cop_line = copline;
560 warn("Found = in conditional, should be ==");
561 curcop->cop_line = oldline;
572 /* assumes no premature commitment */
573 if (!o || (o->op_flags & OPf_KNOW) || error_count)
576 o->op_flags &= ~OPf_LIST;
577 o->op_flags |= OPf_KNOW;
579 switch (o->op_type) {
581 if (o->op_private & OPpREPEAT_DOLIST)
582 null(((LISTOP*)cBINOPo->op_first)->op_first);
583 scalar(cBINOPo->op_first);
588 for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
592 if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
593 if (!kPMOP->op_pmreplroot)
594 deprecate("implicit split to @_");
601 if (o->op_flags & OPf_KIDS) {
602 for (kid = cUNOPo->op_first; kid; kid = kid->op_sibling)
608 scalar(cLISTOPo->op_first);
613 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
633 if (!o || error_count)
635 if (o->op_flags & OPf_LIST)
638 o->op_flags |= OPf_KNOW;
640 switch (o->op_type) {
642 if (!(opargs[o->op_type] & OA_FOLDCONST))
644 if (o->op_flags & OPf_STACKED)
717 if (!(o->op_private & OPpLVAL_INTRO))
718 useless = op_desc[o->op_type];
725 if (!(o->op_private & OPpLVAL_INTRO) &&
726 (!o->op_sibling || o->op_sibling->op_type != OP_READLINE))
727 useless = "a variable";
732 curcop = ((COP*)o); /* for warning below */
738 useless = "a constant";
739 if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
741 else if (SvPOK(sv)) {
742 if (strnEQ(SvPVX(sv), "di", 2) ||
743 strnEQ(SvPVX(sv), "ds", 2) ||
744 strnEQ(SvPVX(sv), "ig", 2))
748 null(o); /* don't execute a constant */
749 SvREFCNT_dec(sv); /* don't even remember it */
753 o->op_type = OP_PREINC; /* pre-increment is faster */
754 o->op_ppaddr = ppaddr[OP_PREINC];
758 o->op_type = OP_PREDEC; /* pre-decrement is faster */
759 o->op_ppaddr = ppaddr[OP_PREDEC];
763 scalarvoid(cBINOPo->op_first);
764 useless = op_desc[o->op_type];
770 for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
774 if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
775 curcop = ((COP*)o); /* for warning below */
776 if (o->op_flags & OPf_STACKED)
781 if (!(o->op_flags & OPf_KIDS))
787 o->op_private |= OPpLEAVE_VOID;
790 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
794 if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
795 if (!kPMOP->op_pmreplroot)
796 deprecate("implicit split to @_");
800 o->op_private |= OPpLEAVE_VOID;
803 if (useless && dowarn)
804 warn("Useless use of %s in void context", useless);
813 if (o && o->op_flags & OPf_KIDS) {
814 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
826 /* assumes no premature commitment */
827 if (!o || (o->op_flags & OPf_KNOW) || error_count)
830 o->op_flags |= (OPf_KNOW | OPf_LIST);
832 switch (o->op_type) {
835 list(cBINOPo->op_first);
840 for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
847 if (!(o->op_flags & OPf_KIDS))
849 if (!o->op_next && cUNOPo->op_first->op_type == OP_FLOP) {
850 list(cBINOPo->op_first);
851 return gen_constant_list(o);
858 list(cLISTOPo->op_first);
862 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
881 if (o->op_type == OP_LINESEQ ||
882 o->op_type == OP_SCOPE ||
883 o->op_type == OP_LEAVE ||
884 o->op_type == OP_LEAVETRY)
886 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
887 if (kid->op_sibling) {
893 o->op_flags &= ~OPf_PARENS;
894 if (hints & HINT_BLOCK_SCOPE)
895 o->op_flags |= OPf_PARENS;
898 o = newOP(OP_STUB, 0);
908 if (o && o->op_flags & OPf_KIDS) {
909 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
927 if (!o || error_count)
930 switch (o->op_type) {
932 if (!(o->op_private & (OPpCONST_ARYBASE)))
934 if (eval_start && eval_start->op_type == OP_CONST) {
935 compiling.cop_arybase = (I32)SvIV(((SVOP*)eval_start)->op_sv);
939 SAVEI32(compiling.cop_arybase);
940 compiling.cop_arybase = 0;
942 else if (type == OP_REFGEN)
945 croak("That use of $[ is unsupported");
948 if ((type == OP_UNDEF || type == OP_REFGEN) &&
949 !(o->op_flags & OPf_STACKED)) {
950 o->op_type = OP_RV2CV; /* entersub => rv2cv */
951 o->op_ppaddr = ppaddr[OP_RV2CV];
952 assert(cUNOPo->op_first->op_type == OP_NULL);
953 null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
959 /* grep, foreach, subcalls, refgen */
960 if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
962 sprintf(tokenbuf, "Can't modify %s in %s",
964 type ? op_desc[type] : "local");
988 if (!(o->op_flags & OPf_STACKED))
994 for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
1000 if (type == OP_REFGEN && o->op_flags & OPf_PARENS) {
1002 return o; /* Treat \(@foo) like ordinary list. */
1006 ref(cUNOPo->op_first, o->op_type);
1018 if (!type && cUNOPo->op_first->op_type != OP_GV)
1019 croak("Can't localize a reference");
1020 ref(cUNOPo->op_first, o->op_type);
1037 croak("Can't localize lexical variable %s",
1038 SvPV(*av_fetch(comppad_name, o->op_targ, 4), na));
1053 pad_free(o->op_targ);
1054 o->op_targ = pad_alloc(o->op_type, SVs_PADMY);
1055 sv = PAD_SV(o->op_targ);
1056 sv_upgrade(sv, SVt_PVLV);
1057 sv_magic(sv, Nullsv, mtype, Nullch, 0);
1058 curpad[o->op_targ] = sv;
1059 if (o->op_flags & OPf_KIDS)
1060 mod(cBINOPo->op_first->op_sibling, type);
1065 ref(cBINOPo->op_first, o->op_type);
1072 if (o->op_flags & OPf_KIDS)
1073 mod(cLISTOPo->op_last, type);
1077 if (!(o->op_flags & OPf_KIDS))
1079 if (o->op_targ != OP_LIST) {
1080 mod(cBINOPo->op_first, type);
1085 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
1089 o->op_flags |= OPf_MOD;
1091 if (type == OP_AASSIGN || type == OP_SASSIGN)
1092 o->op_flags |= OPf_SPECIAL|OPf_REF;
1094 o->op_private |= OPpLVAL_INTRO;
1095 o->op_flags &= ~OPf_SPECIAL;
1097 else if (type != OP_GREPSTART && type != OP_ENTERSUB)
1098 o->op_flags |= OPf_REF;
1108 if (o && o->op_flags & OPf_KIDS) {
1109 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
1122 if (!o || error_count)
1125 switch (o->op_type) {
1127 if ((type == OP_DEFINED) &&
1128 !(o->op_flags & OPf_STACKED)) {
1129 o->op_type = OP_RV2CV; /* entersub => rv2cv */
1130 o->op_ppaddr = ppaddr[OP_RV2CV];
1131 assert(cUNOPo->op_first->op_type == OP_NULL);
1132 null(((LISTOP*)cUNOPo->op_first)->op_first); /* disable pushmark */
1133 o->op_flags |= OPf_SPECIAL;
1138 for (kid = cUNOPo->op_first->op_sibling; kid; kid = kid->op_sibling)
1142 ref(cUNOPo->op_first, o->op_type);
1145 if (type == OP_RV2AV || type == OP_RV2HV) {
1146 o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV);
1147 o->op_flags |= OPf_MOD;
1153 o->op_flags |= OPf_REF;
1156 ref(cUNOPo->op_first, o->op_type);
1161 o->op_flags |= OPf_REF;
1166 if (!(o->op_flags & OPf_KIDS))
1168 ref(cBINOPo->op_first, type);
1172 ref(cBINOPo->op_first, o->op_type);
1173 if (type == OP_RV2AV || type == OP_RV2HV) {
1174 o->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV);
1175 o->op_flags |= OPf_MOD;
1183 if (!(o->op_flags & OPf_KIDS))
1185 ref(cLISTOPo->op_last, type);
1201 if (!o || error_count)
1205 if (type == OP_LIST) {
1206 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
1209 else if (type != OP_PADSV &&
1212 type != OP_PUSHMARK)
1214 sprintf(tokenbuf, "Can't declare %s in my", op_desc[o->op_type]);
1218 o->op_flags |= OPf_MOD;
1219 o->op_private |= OPpLVAL_INTRO;
1228 o->op_flags |= OPf_PARENS;
1233 bind_match(type, left, right)
1240 if (right->op_type == OP_MATCH ||
1241 right->op_type == OP_SUBST ||
1242 right->op_type == OP_TRANS) {
1243 right->op_flags |= OPf_STACKED;
1244 if (right->op_type != OP_MATCH)
1245 left = mod(left, right->op_type);
1246 if (right->op_type == OP_TRANS)
1247 o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
1249 o = prepend_elem(right->op_type, scalar(left), right);
1251 return newUNOP(OP_NOT, 0, scalar(o));
1255 return bind_match(type, left,
1256 pmruntime(newPMOP(OP_MATCH, 0), right, Nullop));
1265 /* XXX need to optimize away NOT NOT here? Or do we let optimizer do it? */
1266 return newUNOP(OP_NOT, OPf_SPECIAL, scalar(o));
1274 if (o->op_flags & OPf_PARENS || perldb || tainting) {
1275 o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
1276 o->op_type = OP_LEAVE;
1277 o->op_ppaddr = ppaddr[OP_LEAVE];
1280 if (o->op_type == OP_LINESEQ) {
1282 o->op_type = OP_SCOPE;
1283 o->op_ppaddr = ppaddr[OP_SCOPE];
1284 kid = ((LISTOP*)o)->op_first;
1285 if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
1286 SvREFCNT_dec(((COP*)kid)->cop_filegv);
1291 o = newLISTOP(OP_SCOPE, 0, o, Nullop);
1301 int retval = savestack_ix;
1302 comppad_name_fill = AvFILL(comppad_name);
1303 SAVEINT(min_intro_pending);
1304 SAVEINT(max_intro_pending);
1305 min_intro_pending = 0;
1306 SAVEINT(comppad_name_fill);
1307 SAVEINT(padix_floor);
1308 padix_floor = padix;
1309 pad_reset_pending = FALSE;
1311 hints &= ~HINT_BLOCK_SCOPE;
1316 block_end(line, floor, seq)
1322 int needblockscope = hints & HINT_BLOCK_SCOPE;
1323 OP* retval = scalarseq(seq);
1324 if (copline > (line_t)line)
1327 pad_reset_pending = FALSE;
1329 hints |= HINT_BLOCK_SCOPE; /* propagate out */
1330 pad_leavemy(comppad_name_fill);
1340 eval_root = newUNOP(OP_LEAVEEVAL, 0, o);
1341 eval_start = linklist(eval_root);
1342 eval_root->op_next = 0;
1350 main_root = scope(sawparens(scalarvoid(o)));
1351 curcop = &compiling;
1352 main_start = LINKLIST(main_root);
1353 main_root->op_next = 0;
1365 if (o->op_flags & OPf_PARENS)
1369 if (dowarn && bufptr > oldbufptr && bufptr[-1] == ',') {
1371 for (s = bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
1372 if (*s == ';' || *s == '=')
1373 warn("Parens missing around \"%s\" list", lex ? "my" : "local");
1380 return mod(o, OP_NULL); /* a bit kludgey */
1387 if (o->op_type == OP_LIST) {
1388 o = convert(OP_JOIN, 0,
1389 prepend_elem(OP_LIST,
1390 newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
1402 I32 type = o->op_type;
1405 if (opargs[type] & OA_RETSCALAR)
1407 if (opargs[type] & OA_TARGET)
1408 o->op_targ = pad_alloc(type, SVs_PADTMP);
1410 if ((opargs[type] & OA_OTHERINT) && (hints & HINT_INTEGER))
1411 o->op_ppaddr = ppaddr[type = ++(o->op_type)];
1413 if (!(opargs[type] & OA_FOLDCONST))
1417 goto nope; /* Don't try to run w/ errors */
1419 for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
1420 if (curop->op_type != OP_CONST &&
1421 curop->op_type != OP_LIST &&
1422 curop->op_type != OP_SCALAR &&
1423 curop->op_type != OP_NULL &&
1424 curop->op_type != OP_PUSHMARK) {
1429 curop = LINKLIST(o);
1434 if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */
1435 pad_swipe(o->op_targ);
1436 else if (SvTEMP(sv)) { /* grab mortal temp? */
1437 (void)SvREFCNT_inc(sv);
1441 if (type == OP_RV2GV)
1442 return newGVOP(OP_GV, 0, sv);
1444 if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK) {
1446 if ((double)iv == SvNV(sv)) { /* can we smush double to int */
1451 return newSVOP(OP_CONST, 0, sv);
1455 if (!(opargs[type] & OA_OTHERINT))
1458 if (!(hints & HINT_INTEGER)) {
1461 if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS))
1464 for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
1465 if (curop->op_type == OP_CONST) {
1466 if (SvIOK(((SVOP*)curop)->op_sv)) {
1467 if (SvIVX(((SVOP*)curop)->op_sv) <= 0 && vars++)
1468 return o; /* negatives truncate wrong way, alas */
1473 if (opargs[curop->op_type] & OA_RETINTEGER)
1475 if (curop->op_type == OP_PADSV || curop->op_type == OP_RV2SV) {
1478 if (((o->op_type == OP_LT || o->op_type == OP_GE) &&
1479 curop == ((BINOP*)o)->op_first ) ||
1480 ((o->op_type == OP_GT || o->op_type == OP_LE) &&
1481 curop == ((BINOP*)o)->op_last ))
1483 /* Allow "$i < 100" and variants to integerize */
1489 o->op_ppaddr = ppaddr[++(o->op_type)];
1496 gen_constant_list(o)
1501 I32 oldtmps_floor = tmps_floor;
1505 return o; /* Don't attempt to run with errors */
1507 op = curop = LINKLIST(o);
1513 tmps_floor = oldtmps_floor;
1515 o->op_type = OP_RV2AV;
1516 o->op_ppaddr = ppaddr[OP_RV2AV];
1517 curop = ((UNOP*)o)->op_first;
1518 ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*stack_sp--));
1525 convert(type, flags, o)
1533 if (!o || o->op_type != OP_LIST)
1534 o = newLISTOP(OP_LIST, 0, o, Nullop);
1536 o->op_flags &= ~(OPf_KNOW|OPf_LIST);
1538 if (!(opargs[type] & OA_MARK))
1539 null(cLISTOPo->op_first);
1542 o->op_ppaddr = ppaddr[type];
1543 o->op_flags |= flags;
1545 o = CHECKOP(type, o);
1546 if (o->op_type != type)
1549 if (cLISTOPo->op_children < 7) {
1550 /* XXX do we really need to do this if we're done appending?? */
1551 for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
1553 cLISTOPo->op_last = last; /* in case check substituted last arg */
1556 return fold_constants(o);
1559 /* List constructors */
1562 append_elem(type, first, last)
1573 if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS)
1574 return newLISTOP(type, 0, first, last);
1576 if (first->op_flags & OPf_KIDS)
1577 ((LISTOP*)first)->op_last->op_sibling = last;
1579 first->op_flags |= OPf_KIDS;
1580 ((LISTOP*)first)->op_first = last;
1582 ((LISTOP*)first)->op_last = last;
1583 ((LISTOP*)first)->op_children++;
1588 append_list(type, first, last)
1599 if (first->op_type != type)
1600 return prepend_elem(type, (OP*)first, (OP*)last);
1602 if (last->op_type != type)
1603 return append_elem(type, (OP*)first, (OP*)last);
1605 first->op_last->op_sibling = last->op_first;
1606 first->op_last = last->op_last;
1607 first->op_children += last->op_children;
1608 if (first->op_children)
1609 last->op_flags |= OPf_KIDS;
1616 prepend_elem(type, first, last)
1627 if (last->op_type == type) {
1628 if (type == OP_LIST) { /* already a PUSHMARK there */
1629 first->op_sibling = ((LISTOP*)last)->op_first->op_sibling;
1630 ((LISTOP*)last)->op_first->op_sibling = first;
1633 if (!(last->op_flags & OPf_KIDS)) {
1634 ((LISTOP*)last)->op_last = first;
1635 last->op_flags |= OPf_KIDS;
1637 first->op_sibling = ((LISTOP*)last)->op_first;
1638 ((LISTOP*)last)->op_first = first;
1640 ((LISTOP*)last)->op_children++;
1644 return newLISTOP(type, 0, first, last);
1652 return newOP(OP_STUB, 0);
1659 if (!o || o->op_type != OP_LIST)
1660 o = newLISTOP(OP_LIST, 0, o, Nullop);
1666 newLISTOP(type, flags, first, last)
1674 Newz(1101, listop, 1, LISTOP);
1676 listop->op_type = type;
1677 listop->op_ppaddr = ppaddr[type];
1678 listop->op_children = (first != 0) + (last != 0);
1679 listop->op_flags = flags;
1683 else if (!first && last)
1686 first->op_sibling = last;
1687 listop->op_first = first;
1688 listop->op_last = last;
1689 if (type == OP_LIST) {
1691 pushop = newOP(OP_PUSHMARK, 0);
1692 pushop->op_sibling = first;
1693 listop->op_first = pushop;
1694 listop->op_flags |= OPf_KIDS;
1696 listop->op_last = pushop;
1698 else if (listop->op_children)
1699 listop->op_flags |= OPf_KIDS;
1710 Newz(1101, o, 1, OP);
1712 o->op_ppaddr = ppaddr[type];
1713 o->op_flags = flags;
1716 o->op_private = 0 + (flags >> 8);
1717 if (opargs[type] & OA_RETSCALAR)
1719 if (opargs[type] & OA_TARGET)
1720 o->op_targ = pad_alloc(type, SVs_PADTMP);
1721 return CHECKOP(type, o);
1725 newUNOP(type, flags, first)
1733 first = newOP(OP_STUB, 0);
1734 if (opargs[type] & OA_MARK)
1735 first = force_list(first);
1737 Newz(1101, unop, 1, UNOP);
1738 unop->op_type = type;
1739 unop->op_ppaddr = ppaddr[type];
1740 unop->op_first = first;
1741 unop->op_flags = flags | OPf_KIDS;
1742 unop->op_private = 1 | (flags >> 8);
1744 unop = (UNOP*) CHECKOP(type, unop);
1748 return fold_constants((OP *) unop);
1752 newBINOP(type, flags, first, last)
1759 Newz(1101, binop, 1, BINOP);
1762 first = newOP(OP_NULL, 0);
1764 binop->op_type = type;
1765 binop->op_ppaddr = ppaddr[type];
1766 binop->op_first = first;
1767 binop->op_flags = flags | OPf_KIDS;
1770 binop->op_private = 1 | (flags >> 8);
1773 binop->op_private = 2 | (flags >> 8);
1774 first->op_sibling = last;
1777 binop = (BINOP*)CHECKOP(type, binop);
1781 binop->op_last = last = binop->op_first->op_sibling;
1783 return fold_constants((OP *)binop);
1787 pmtrans(o, expr, repl)
1792 SV *tstr = ((SVOP*)expr)->op_sv;
1793 SV *rstr = ((SVOP*)repl)->op_sv;
1796 register U8 *t = (U8*)SvPV(tstr, tlen);
1797 register U8 *r = (U8*)SvPV(rstr, rlen);
1802 register short *tbl;
1804 tbl = (short*)cPVOPo->op_pv;
1805 complement = o->op_private & OPpTRANS_COMPLEMENT;
1806 delete = o->op_private & OPpTRANS_DELETE;
1807 /* squash = o->op_private & OPpTRANS_SQUASH; */
1810 Zero(tbl, 256, short);
1811 for (i = 0; i < tlen; i++)
1813 for (i = 0, j = 0; i < 256; i++) {
1829 if (!rlen && !delete) {
1832 for (i = 0; i < 256; i++)
1834 for (i = 0, j = 0; i < tlen; i++,j++) {
1837 if (tbl[t[i]] == -1)
1843 if (tbl[t[i]] == -1)
1854 newPMOP(type, flags)
1861 Newz(1101, pmop, 1, PMOP);
1862 pmop->op_type = type;
1863 pmop->op_ppaddr = ppaddr[type];
1864 pmop->op_flags = flags;
1865 pmop->op_private = 0 | (flags >> 8);
1867 /* link into pm list */
1868 if (type != OP_TRANS && curstash) {
1869 pmop->op_pmnext = HvPMROOT(curstash);
1870 HvPMROOT(curstash) = pmop;
1877 pmruntime(o, expr, repl)
1885 if (o->op_type == OP_TRANS)
1886 return pmtrans(o, expr, repl);
1890 if (expr->op_type == OP_CONST) {
1892 SV *pat = ((SVOP*)expr)->op_sv;
1893 char *p = SvPV(pat, plen);
1894 if ((o->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
1895 sv_setpvn(pat, "\\s+", 3);
1896 p = SvPV(pat, plen);
1897 pm->op_pmflags |= PMf_SKIPWHITE;
1899 pm->op_pmregexp = pregcomp(p, p + plen, pm);
1900 if (strEQ("\\s+", pm->op_pmregexp->precomp))
1901 pm->op_pmflags |= PMf_WHITE;
1906 if (pm->op_pmflags & PMf_KEEP)
1907 expr = newUNOP(OP_REGCMAYBE,0,expr);
1909 Newz(1101, rcop, 1, LOGOP);
1910 rcop->op_type = OP_REGCOMP;
1911 rcop->op_ppaddr = ppaddr[OP_REGCOMP];
1912 rcop->op_first = scalar(expr);
1913 rcop->op_flags |= OPf_KIDS;
1914 rcop->op_private = 1;
1917 /* establish postfix order */
1918 if (pm->op_pmflags & PMf_KEEP) {
1920 rcop->op_next = expr;
1921 ((UNOP*)expr)->op_first->op_next = (OP*)rcop;
1924 rcop->op_next = LINKLIST(expr);
1925 expr->op_next = (OP*)rcop;
1928 prepend_elem(o->op_type, scalar((OP*)rcop), o);
1933 if (pm->op_pmflags & PMf_EVAL)
1935 else if (repl->op_type == OP_CONST)
1939 for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
1940 if (opargs[curop->op_type] & OA_DANGEROUS) {
1941 if (curop->op_type == OP_GV) {
1942 GV *gv = ((GVOP*)curop)->op_gv;
1943 if (strchr("&`'123456789+", *GvENAME(gv)))
1946 else if (curop->op_type == OP_RV2CV)
1948 else if (curop->op_type == OP_RV2SV ||
1949 curop->op_type == OP_RV2AV ||
1950 curop->op_type == OP_RV2HV ||
1951 curop->op_type == OP_RV2GV) {
1952 if (lastop && lastop->op_type != OP_GV) /*funny deref?*/
1955 else if (curop->op_type == OP_PADSV ||
1956 curop->op_type == OP_PADAV ||
1957 curop->op_type == OP_PADHV ||
1958 curop->op_type == OP_PADANY) {
1967 if (curop == repl) {
1968 pm->op_pmflags |= PMf_CONST; /* const for long enough */
1969 pm->op_pmpermflags |= PMf_CONST; /* const for long enough */
1970 prepend_elem(o->op_type, scalar(repl), o);
1973 Newz(1101, rcop, 1, LOGOP);
1974 rcop->op_type = OP_SUBSTCONT;
1975 rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
1976 rcop->op_first = scalar(repl);
1977 rcop->op_flags |= OPf_KIDS;
1978 rcop->op_private = 1;
1981 /* establish postfix order */
1982 rcop->op_next = LINKLIST(repl);
1983 repl->op_next = (OP*)rcop;
1985 pm->op_pmreplroot = scalar((OP*)rcop);
1986 pm->op_pmreplstart = LINKLIST(rcop);
1995 newSVOP(type, flags, sv)
2001 Newz(1101, svop, 1, SVOP);
2002 svop->op_type = type;
2003 svop->op_ppaddr = ppaddr[type];
2005 svop->op_next = (OP*)svop;
2006 svop->op_flags = flags;
2007 if (opargs[type] & OA_RETSCALAR)
2009 if (opargs[type] & OA_TARGET)
2010 svop->op_targ = pad_alloc(type, SVs_PADTMP);
2011 return CHECKOP(type, svop);
2015 newGVOP(type, flags, gv)
2022 Newz(1101, gvop, 1, GVOP);
2023 gvop->op_type = type;
2024 gvop->op_ppaddr = ppaddr[type];
2025 gvop->op_gv = (GV*)SvREFCNT_inc(gv);
2026 gvop->op_next = (OP*)gvop;
2027 gvop->op_flags = flags;
2028 if (opargs[type] & OA_RETSCALAR)
2030 if (opargs[type] & OA_TARGET)
2031 gvop->op_targ = pad_alloc(type, SVs_PADTMP);
2032 return CHECKOP(type, gvop);
2036 newPVOP(type, flags, pv)
2042 Newz(1101, pvop, 1, PVOP);
2043 pvop->op_type = type;
2044 pvop->op_ppaddr = ppaddr[type];
2046 pvop->op_next = (OP*)pvop;
2047 pvop->op_flags = flags;
2048 if (opargs[type] & OA_RETSCALAR)
2050 if (opargs[type] & OA_TARGET)
2051 pvop->op_targ = pad_alloc(type, SVs_PADTMP);
2052 return CHECKOP(type, pvop);
2062 save_hptr(&curstash);
2063 save_item(curstname);
2068 name = SvPV(sv, len);
2069 curstash = gv_stashpv(name,TRUE);
2070 sv_setpvn(curstname, name, len);
2074 sv_setpv(curstname,"<none>");
2082 utilize(aver, floor, id, arg)
2093 if (id->op_type != OP_CONST)
2094 croak("Module name must be constant");
2096 /* Fake up an import/unimport */
2097 if (arg && arg->op_type == OP_STUB)
2098 imop = arg; /* no import on explicit () */
2100 /* Make copy of id so we don't free it twice */
2101 pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
2103 meth = newSVOP(OP_CONST, 0,
2105 ? newSVpv("import", 6)
2106 : newSVpv("unimport", 8)
2108 imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
2109 append_elem(OP_LIST,
2110 prepend_elem(OP_LIST, pack, list(arg)),
2111 newUNOP(OP_METHOD, 0, meth)));
2114 /* Fake up a require */
2115 rqop = newUNOP(OP_REQUIRE, 0, id);
2117 /* Fake up the BEGIN {}, which does its thing immediately. */
2119 newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)),
2121 append_elem(OP_LINESEQ,
2122 newSTATEOP(0, Nullch, rqop),
2123 newSTATEOP(0, Nullch, imop) ));
2130 newSLICEOP(flags, subscript, listval)
2135 return newBINOP(OP_LSLICE, flags,
2136 list(force_list(subscript)),
2137 list(force_list(listval)) );
2147 if (o->op_type == OP_NULL && o->op_flags & OPf_KIDS)
2148 o = cUNOPo->op_first;
2150 if (o->op_type == OP_COND_EXPR) {
2151 I32 t = list_assignment(cCONDOPo->op_first->op_sibling);
2152 I32 f = list_assignment(cCONDOPo->op_first->op_sibling->op_sibling);
2157 yyerror("Assignment to both a list and a scalar");
2161 if (o->op_type == OP_LIST || o->op_flags & OPf_PARENS ||
2162 o->op_type == OP_RV2AV || o->op_type == OP_RV2HV ||
2163 o->op_type == OP_ASLICE || o->op_type == OP_HSLICE)
2166 if (o->op_type == OP_PADAV || o->op_type == OP_PADHV)
2169 if (o->op_type == OP_RV2SV)
2176 newASSIGNOP(flags, left, optype, right)
2185 if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) {
2186 return newLOGOP(optype, 0,
2187 mod(scalar(left), optype),
2188 newUNOP(OP_SASSIGN, 0, scalar(right)));
2191 return newBINOP(optype, OPf_STACKED,
2192 mod(scalar(left), optype), scalar(right));
2196 if (list_assignment(left)) {
2198 eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
2199 left = mod(left, OP_AASSIGN);
2207 o = newBINOP(OP_AASSIGN, flags,
2208 list(force_list(right)),
2209 list(force_list(left)) );
2210 o->op_private = 0 | (flags >> 8);
2211 if (!(left->op_private & OPpLVAL_INTRO)) {
2212 static int generation = 100;
2216 for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
2217 if (opargs[curop->op_type] & OA_DANGEROUS) {
2218 if (curop->op_type == OP_GV) {
2219 GV *gv = ((GVOP*)curop)->op_gv;
2220 if (gv == defgv || SvCUR(gv) == generation)
2222 SvCUR(gv) = generation;
2224 else if (curop->op_type == OP_PADSV ||
2225 curop->op_type == OP_PADAV ||
2226 curop->op_type == OP_PADHV ||
2227 curop->op_type == OP_PADANY) {
2228 SV **svp = AvARRAY(comppad_name);
2229 SV *sv = svp[curop->op_targ];
2230 if (SvCUR(sv) == generation)
2232 SvCUR(sv) = generation; /* (SvCUR not used any more) */
2234 else if (curop->op_type == OP_RV2CV)
2236 else if (curop->op_type == OP_RV2SV ||
2237 curop->op_type == OP_RV2AV ||
2238 curop->op_type == OP_RV2HV ||
2239 curop->op_type == OP_RV2GV) {
2240 if (lastop->op_type != OP_GV) /* funny deref? */
2249 o->op_private = OPpASSIGN_COMMON;
2251 if (right && right->op_type == OP_SPLIT) {
2253 if ((tmpop = ((LISTOP*)right)->op_first) &&
2254 tmpop->op_type == OP_PUSHRE)
2256 PMOP *pm = (PMOP*)tmpop;
2257 if (left->op_type == OP_RV2AV &&
2258 !(left->op_private & OPpLVAL_INTRO) &&
2259 !(o->op_private & OPpASSIGN_COMMON) )
2261 tmpop = ((UNOP*)left)->op_first;
2262 if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
2263 pm->op_pmreplroot = (OP*)((GVOP*)tmpop)->op_gv;
2264 pm->op_pmflags |= PMf_ONCE;
2265 tmpop = cUNOPo->op_first; /* to list (nulled) */
2266 tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
2267 tmpop->op_sibling = Nullop; /* don't free split */
2268 right->op_next = tmpop->op_next; /* fix starting loc */
2269 op_free(o); /* blow off assign */
2270 right->op_flags &= ~(OPf_KNOW|OPf_LIST);
2271 /* "I don't know and I don't care." */
2276 if (modcount < 10000 &&
2277 ((LISTOP*)right)->op_last->op_type == OP_CONST)
2279 SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
2281 sv_setiv(sv, modcount+1);
2289 right = newOP(OP_UNDEF, 0);
2290 if (right->op_type == OP_READLINE) {
2291 right->op_flags |= OPf_STACKED;
2292 return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right));
2295 eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
2296 o = newBINOP(OP_SASSIGN, flags,
2297 scalar(right), mod(scalar(left), OP_SASSIGN) );
2309 newSTATEOP(flags, label, o)
2317 /* Introduce my variables. */
2318 if (min_intro_pending) {
2319 SV **svp = AvARRAY(comppad_name);
2322 for (i = min_intro_pending; i <= max_intro_pending; i++) {
2323 if ((sv = svp[i]) && sv != &sv_undef && !SvIVX(sv)) {
2324 SvIVX(sv) = 999999999; /* Don't know scope end yet. */
2325 SvNVX(sv) = (double)cop_seqmax;
2328 min_intro_pending = 0;
2329 comppad_name_fill = max_intro_pending; /* Needn't search higher */
2332 Newz(1101, cop, 1, COP);
2333 if (perldb && curcop->cop_line && curstash != debstash) {
2334 cop->op_type = OP_DBSTATE;
2335 cop->op_ppaddr = ppaddr[ OP_DBSTATE ];
2338 cop->op_type = OP_NEXTSTATE;
2339 cop->op_ppaddr = ppaddr[ OP_NEXTSTATE ];
2341 cop->op_flags = flags;
2342 cop->op_private = 0 | (flags >> 8);
2343 cop->op_next = (OP*)cop;
2346 cop->cop_label = label;
2347 hints |= HINT_BLOCK_SCOPE;
2349 cop->cop_seq = cop_seqmax++;
2350 cop->cop_arybase = curcop->cop_arybase;
2352 if (copline == NOLINE)
2353 cop->cop_line = curcop->cop_line;
2355 cop->cop_line = copline;
2358 cop->cop_filegv = SvREFCNT_inc(curcop->cop_filegv);
2359 cop->cop_stash = curstash;
2361 if (perldb && curstash != debstash) {
2362 SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE);
2363 if (svp && *svp != &sv_undef && !SvIOK(*svp)) {
2364 (void)SvIOK_on(*svp);
2366 SvSTASH(*svp) = (HV*)cop;
2370 return prepend_elem(OP_LINESEQ, (OP*)cop, o);
2374 newLOGOP(type, flags, first, other)
2384 if (type == OP_XOR) /* Not short circuit, but here by precedence. */
2385 return newBINOP(type, flags, scalar(first), scalar(other));
2387 scalarboolean(first);
2388 /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
2389 if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) {
2390 if (type == OP_AND || type == OP_OR) {
2396 first = cUNOPo->op_first;
2398 first->op_next = o->op_next;
2399 cUNOPo->op_first = Nullop;
2403 if (first->op_type == OP_CONST) {
2404 if (dowarn && (first->op_private & OPpCONST_BARE))
2405 warn("Probable precedence problem on %s", op_desc[type]);
2406 if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
2415 else if (first->op_type == OP_WANTARRAY) {
2425 if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
2426 other->op_private |= OPpASSIGN_BACKWARDS; /* other is an OP_SASSIGN */
2428 Newz(1101, logop, 1, LOGOP);
2430 logop->op_type = type;
2431 logop->op_ppaddr = ppaddr[type];
2432 logop->op_first = first;
2433 logop->op_flags = flags | OPf_KIDS;
2434 logop->op_other = LINKLIST(other);
2435 logop->op_private = 1 | (flags >> 8);
2437 /* establish postfix order */
2438 logop->op_next = LINKLIST(first);
2439 first->op_next = (OP*)logop;
2440 first->op_sibling = other;
2442 o = newUNOP(OP_NULL, 0, (OP*)logop);
2449 newCONDOP(flags, first, true, false)
2460 return newLOGOP(OP_AND, 0, first, true);
2462 return newLOGOP(OP_OR, 0, first, false);
2464 scalarboolean(first);
2465 if (first->op_type == OP_CONST) {
2466 if (SvTRUE(((SVOP*)first)->op_sv)) {
2477 else if (first->op_type == OP_WANTARRAY) {
2481 Newz(1101, condop, 1, CONDOP);
2483 condop->op_type = OP_COND_EXPR;
2484 condop->op_ppaddr = ppaddr[OP_COND_EXPR];
2485 condop->op_first = first;
2486 condop->op_flags = flags | OPf_KIDS;
2487 condop->op_true = LINKLIST(true);
2488 condop->op_false = LINKLIST(false);
2489 condop->op_private = 1 | (flags >> 8);
2491 /* establish postfix order */
2492 condop->op_next = LINKLIST(first);
2493 first->op_next = (OP*)condop;
2495 first->op_sibling = true;
2496 true->op_sibling = false;
2497 o = newUNOP(OP_NULL, 0, (OP*)condop);
2506 newRANGE(flags, left, right)
2516 Newz(1101, condop, 1, CONDOP);
2518 condop->op_type = OP_RANGE;
2519 condop->op_ppaddr = ppaddr[OP_RANGE];
2520 condop->op_first = left;
2521 condop->op_flags = OPf_KIDS;
2522 condop->op_true = LINKLIST(left);
2523 condop->op_false = LINKLIST(right);
2524 condop->op_private = 1 | (flags >> 8);
2526 left->op_sibling = right;
2528 condop->op_next = (OP*)condop;
2529 flip = newUNOP(OP_FLIP, flags, (OP*)condop);
2530 flop = newUNOP(OP_FLOP, 0, flip);
2531 o = newUNOP(OP_NULL, 0, flop);
2534 left->op_next = flip;
2535 right->op_next = flop;
2537 condop->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
2538 sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV);
2539 flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
2540 sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
2542 flip->op_private = left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
2543 flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
2546 if (!flip->op_private || !flop->op_private)
2547 linklist(o); /* blow off optimizer unless constant */
2553 newLOOPOP(flags, debuggable, expr, block)
2562 int once = block && block->op_flags & OPf_SPECIAL &&
2563 (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
2566 if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
2567 return block; /* do {} while 0 does once */
2568 else if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)
2569 expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr);
2572 listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
2573 o = newLOGOP(OP_AND, 0, expr, listop);
2575 ((LISTOP*)listop)->op_last->op_next = LINKLIST(o);
2577 if (once && o != listop)
2578 o->op_next = ((LOGOP*)cUNOPo->op_first)->op_other;
2581 o = newUNOP(OP_NULL, 0, o); /* or do {} while 1 loses outer block */
2583 o->op_flags |= flags;
2585 o->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/
2590 newWHILEOP(flags, debuggable, loop, expr, block, cont)
2605 if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) {
2606 expr = newUNOP(OP_DEFINED, 0,
2607 newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
2611 block = newOP(OP_NULL, 0);
2614 next = LINKLIST(cont);
2616 cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
2618 listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
2619 redo = LINKLIST(listop);
2622 o = newLOGOP(OP_AND, 0, expr, scalar(listop));
2623 if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) {
2624 op_free(expr); /* oops, it's a while (0) */
2626 return Nullop; /* (listop already freed by newLOGOP) */
2628 ((LISTOP*)listop)->op_last->op_next = condop =
2629 (o == listop ? redo : LINKLIST(o));
2637 Newz(1101,loop,1,LOOP);
2638 loop->op_type = OP_ENTERLOOP;
2639 loop->op_ppaddr = ppaddr[OP_ENTERLOOP];
2640 loop->op_private = 0;
2641 loop->op_next = (OP*)loop;
2644 o = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, o);
2646 loop->op_redoop = redo;
2647 loop->op_lastop = o;
2650 loop->op_nextop = next;
2652 loop->op_nextop = o;
2654 o->op_flags |= flags;
2655 o->op_private |= (flags >> 8);
2660 #ifndef CAN_PROTOTYPE
2661 newFOROP(flags,label,forline,sv,expr,block,cont)
2670 newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
2671 #endif /* CAN_PROTOTYPE */
2679 if (sv->op_type == OP_RV2SV) { /* symbol table variable */
2680 sv->op_type = OP_RV2GV;
2681 sv->op_ppaddr = ppaddr[OP_RV2GV];
2683 else if (sv->op_type == OP_PADSV) { /* private variable */
2684 padoff = sv->op_targ;
2689 croak("Can't use %s for loop variable", op_desc[sv->op_type]);
2692 sv = newGVOP(OP_GV, 0, defgv);
2694 if (expr->op_type == OP_RV2AV) {
2695 expr = scalar(ref(expr, OP_ITER));
2696 iterflags |= OPf_STACKED;
2698 loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
2699 append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART),
2701 assert(!loop->op_next);
2702 Renew(loop, 1, LOOP);
2703 loop->op_targ = padoff;
2704 return newSTATEOP(0, label, newWHILEOP(flags, 1, loop,
2705 newOP(OP_ITER, 0), block, cont));
2709 newLOOPEX(type, label)
2715 if (type != OP_GOTO || label->op_type == OP_CONST) {
2716 o = newPVOP(type, 0, savepv(
2717 label->op_type == OP_CONST
2718 ? SvPVx(((SVOP*)label)->op_sv, na)
2723 if (label->op_type == OP_ENTERSUB)
2724 label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
2725 o = newUNOP(type, OPf_STACKED, label);
2727 hints |= HINT_BLOCK_SCOPE;
2737 MUTEX_DESTROY(CvMUTEXP(cv));
2738 Safefree(CvMUTEXP(cv));
2740 COND_DESTROY(CvCONDP(cv));
2741 Safefree(CvCONDP(cv));
2743 #endif /* USE_THREADS */
2745 if (!CvXSUB(cv) && CvROOT(cv)) {
2747 if (CvDEPTH(cv) || (CvOWNER(cv) && CvOWNER(cv) != thr))
2748 croak("Can't undef active subroutine");
2751 croak("Can't undef active subroutine");
2752 #endif /* USE_THREADS */
2759 op_free(CvROOT(cv));
2760 CvROOT(cv) = Nullop;
2763 SvREFCNT_dec(CvGV(cv));
2765 SvREFCNT_dec(CvOUTSIDE(cv));
2766 CvOUTSIDE(cv) = Nullcv;
2767 if (CvPADLIST(cv)) {
2768 I32 i = AvFILL(CvPADLIST(cv));
2770 SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
2774 SvREFCNT_dec((SV*)CvPADLIST(cv));
2775 CvPADLIST(cv) = Nullav;
2786 AV* protopadlist = CvPADLIST(proto);
2787 AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
2788 AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
2789 SV** svp = AvARRAY(protopad);
2798 cv = compcv = (CV*)NEWSV(1104,0);
2799 sv_upgrade((SV *)cv, SVt_PVCV);
2803 New(666, CvMUTEXP(cv), 1, pthread_mutex_t);
2804 MUTEX_INIT(CvMUTEXP(cv));
2805 New(666, CvCONDP(cv), 1, pthread_cond_t);
2806 COND_INIT(CvCONDP(cv));
2808 #endif /* USE_THREADS */
2809 CvFILEGV(cv) = CvFILEGV(proto);
2810 CvGV(cv) = SvREFCNT_inc(CvGV(proto));
2811 CvSTASH(cv) = CvSTASH(proto);
2812 CvROOT(cv) = CvROOT(proto);
2813 CvSTART(cv) = CvSTART(proto);
2814 if (CvOUTSIDE(proto))
2815 CvOUTSIDE(cv) = (CV*)SvREFCNT_inc((SV*)CvOUTSIDE(proto));
2819 comppadlist = newAV();
2820 AvREAL_off(comppadlist);
2821 av_store(comppadlist, 0, SvREFCNT_inc((SV*)protopad_name));
2822 av_store(comppadlist, 1, (SV*)comppad);
2823 CvPADLIST(cv) = comppadlist;
2824 av_extend(comppad, AvFILL(protopad));
2825 curpad = AvARRAY(comppad);
2827 av = newAV(); /* will be @_ */
2829 av_store(comppad, 0, (SV*)av);
2830 AvFLAGS(av) = AVf_REIFY;
2832 svp = AvARRAY(protopad_name);
2833 for ( ix = AvFILL(protopad); ix > 0; ix--) {
2835 if (svp[ix] != &sv_undef) {
2836 char *name = SvPVX(svp[ix]); /* XXX */
2837 if (SvFLAGS(svp[ix]) & SVf_FAKE) { /* lexical from outside? */
2838 I32 off = pad_findlex(name,ix,curcop->cop_seq, CvOUTSIDE(proto),
2841 croak("panic: cv_clone: %s", name);
2843 else { /* our own lexical */
2845 av_store(comppad, ix, sv = (SV*)newAV());
2846 else if (*name == '%')
2847 av_store(comppad, ix, sv = (SV*)newHV());
2849 av_store(comppad, ix, sv = NEWSV(0,0));
2854 av_store(comppad, ix, sv = NEWSV(0,0));
2864 newSUB(floor,o,proto,block)
2872 char *name = o ? SvPVx(cSVOPo->op_sv, na) : "__ANON__";
2873 GV* gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV);
2880 if (cv = GvCV(gv)) {
2882 cv = 0; /* just a cached method */
2883 else if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) {
2884 if (dowarn) { /* already defined (or promised)? */
2885 line_t oldline = curcop->cop_line;
2887 curcop->cop_line = copline;
2888 warn("Subroutine %s redefined",name);
2889 curcop->cop_line = oldline;
2895 if (cv) { /* must reuse cv if autoloaded */
2897 CvOUTSIDE(cv) = CvOUTSIDE(compcv);
2898 CvOUTSIDE(compcv) = 0;
2899 CvPADLIST(cv) = CvPADLIST(compcv);
2900 CvPADLIST(compcv) = 0;
2901 if (SvREFCNT(compcv) > 1) /* XXX Make closures transit through stub. */
2902 CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)cv);
2903 SvREFCNT_dec(compcv);
2910 CvFILEGV(cv) = curcop->cop_filegv;
2911 CvGV(cv) = SvREFCNT_inc(gv);
2912 CvSTASH(cv) = curstash;
2915 New(666, CvMUTEXP(cv), 1, pthread_mutex_t);
2916 MUTEX_INIT(CvMUTEXP(cv));
2917 New(666, CvCONDP(cv), 1, pthread_cond_t);
2918 COND_INIT(CvCONDP(cv));
2919 #endif /* USE_THREADS */
2922 char *p = SvPVx(((SVOP*)proto)->op_sv, na);
2923 if (SvPOK(cv) && strNE(SvPV((SV*)cv,na), p))
2924 warn("Prototype mismatch: (%s) vs (%s)", SvPV((SV*)cv, na), p);
2925 sv_setpv((SV*)cv, p);
2941 av = newAV(); /* Will be @_ */
2943 av_store(comppad, 0, (SV*)av);
2944 AvFLAGS(av) = AVf_REIFY;
2946 for (ix = AvFILL(comppad); ix > 0; ix--) {
2947 if (!SvPADMY(curpad[ix]))
2948 SvPADTMP_on(curpad[ix]);
2951 if (AvFILL(comppad_name) < AvFILL(comppad))
2952 av_store(comppad_name, AvFILL(comppad), Nullsv);
2954 CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
2955 CvSTART(cv) = LINKLIST(CvROOT(cv));
2956 CvROOT(cv)->op_next = 0;
2958 if (s = strrchr(name,':'))
2962 if (strEQ(s, "BEGIN") && !error_count) {
2963 line_t oldline = compiling.cop_line;
2967 SAVESPTR(compiling.cop_filegv);
2971 av_push(beginav, (SV *)cv);
2972 DEBUG_x( dump_sub(gv) );
2973 rs = SvREFCNT_inc(nrs);
2978 curcop = &compiling;
2979 curcop->cop_line = oldline; /* might have recursed to yylex */
2982 else if (strEQ(s, "END") && !error_count) {
2985 av_unshift(endav, 1);
2986 av_store(endav, 0, SvREFCNT_inc(cv));
2988 if (perldb && curstash != debstash) {
2990 SV *tmpstr = sv_newmortal();
2992 sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
2993 sv = newSVpv(buf,0);
2995 sprintf(buf,"%ld",(long)curcop->cop_line);
2997 gv_efullname(tmpstr,gv);
2998 hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
3004 GvCV(gv) = 0; /* Will remember in SVOP instead. */
3012 newXSUB(name, ix, subaddr, filename)
3018 CV* cv = newXS(name, (void(*)())subaddr, filename);
3020 CvXSUBANY(cv).any_i32 = ix;
3026 newXS(name, subaddr, filename)
3028 void (*subaddr) _((CV*));
3033 GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV);
3038 if (cv = GvCV(gv)) {
3040 cv = 0; /* just a cached method */
3041 else if (CvROOT(cv) || CvXSUB(cv)) { /* already defined? */
3043 line_t oldline = curcop->cop_line;
3045 curcop->cop_line = copline;
3046 warn("Subroutine %s redefined",name);
3047 curcop->cop_line = oldline;
3053 if (cv) { /* must reuse cv if autoloaded */
3054 assert(SvREFCNT(CvGV(cv)) > 1);
3055 SvREFCNT_dec(CvGV(cv));
3058 cv = (CV*)NEWSV(1105,0);
3059 sv_upgrade((SV *)cv, SVt_PVCV);
3062 CvGV(cv) = SvREFCNT_inc(gv);
3065 New(666, CvMUTEXP(cv), 1, pthread_mutex_t);
3066 MUTEX_INIT(CvMUTEXP(cv));
3067 New(666, CvCONDP(cv), 1, pthread_cond_t);
3068 COND_INIT(CvCONDP(cv));
3070 #endif /* USE_THREADS */
3071 CvFILEGV(cv) = gv_fetchfile(filename);
3072 CvXSUB(cv) = subaddr;
3075 else if (s = strrchr(name,':'))
3079 if (strEQ(s, "BEGIN")) {
3082 av_push(beginav, SvREFCNT_inc(gv));
3084 else if (strEQ(s, "END")) {
3087 av_unshift(endav, 1);
3088 av_store(endav, 0, SvREFCNT_inc(gv));
3091 GvCV(gv) = 0; /* Will remember elsewhere instead. */
3098 newFORM(floor,o,block)
3110 name = SvPVx(cSVOPo->op_sv, na);
3113 gv = gv_fetchpv(name,TRUE, SVt_PVFM);
3115 if (cv = GvFORM(gv)) {
3117 line_t oldline = curcop->cop_line;
3119 curcop->cop_line = copline;
3120 warn("Format %s redefined",name);
3121 curcop->cop_line = oldline;
3127 CvGV(cv) = SvREFCNT_inc(gv);
3128 CvFILEGV(cv) = curcop->cop_filegv;
3130 for (ix = AvFILL(comppad); ix > 0; ix--) {
3131 if (!SvPADMY(curpad[ix]))
3132 SvPADTMP_on(curpad[ix]);
3135 CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
3136 CvSTART(cv) = LINKLIST(CvROOT(cv));
3137 CvROOT(cv)->op_next = 0;
3149 return newUNOP(OP_REFGEN, 0,
3150 mod(list(convert(OP_ANONLIST, 0, o)), OP_REFGEN));
3157 return newUNOP(OP_REFGEN, 0,
3158 mod(list(convert(OP_ANONHASH, 0, o)), OP_REFGEN));
3162 newANONSUB(floor, proto, block)
3167 return newUNOP(OP_REFGEN, 0,
3168 newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, proto, block)));
3175 switch (o->op_type) {
3177 o->op_type = OP_PADAV;
3178 o->op_ppaddr = ppaddr[OP_PADAV];
3179 return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV);
3182 o->op_type = OP_RV2AV;
3183 o->op_ppaddr = ppaddr[OP_RV2AV];
3188 warn("oops: oopsAV");
3198 switch (o->op_type) {
3201 o->op_type = OP_PADHV;
3202 o->op_ppaddr = ppaddr[OP_PADHV];
3203 return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV);
3207 o->op_type = OP_RV2HV;
3208 o->op_ppaddr = ppaddr[OP_RV2HV];
3213 warn("oops: oopsHV");
3223 if (o->op_type == OP_PADANY) {
3224 o->op_type = OP_PADAV;
3225 o->op_ppaddr = ppaddr[OP_PADAV];
3228 return newUNOP(OP_RV2AV, 0, scalar(o));
3236 if (type == OP_MAPSTART)
3237 return newUNOP(OP_NULL, 0, o);
3238 return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
3245 if (o->op_type == OP_PADANY) {
3246 o->op_type = OP_PADHV;
3247 o->op_ppaddr = ppaddr[OP_PADHV];
3250 return newUNOP(OP_RV2HV, 0, scalar(o));
3257 croak("NOT IMPL LINE %d",__LINE__);
3267 return newUNOP(OP_RV2CV, flags, scalar(o));
3274 if (o->op_type == OP_PADANY) {
3275 o->op_type = OP_PADSV;
3276 o->op_ppaddr = ppaddr[OP_PADSV];
3279 return newUNOP(OP_RV2SV, 0, scalar(o));
3282 /* Check routines. */
3288 if (cUNOPo->op_first->op_type == OP_CONCAT)
3289 o->op_flags |= OPf_STACKED;
3297 if (o->op_flags & OPf_KIDS) {
3300 o = modkids(ck_fun(o), o->op_type);
3301 kid = cUNOPo->op_first;
3302 newop = kUNOP->op_first->op_sibling;
3304 (newop->op_sibling ||
3305 !(opargs[newop->op_type] & OA_RETSCALAR) ||
3306 newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
3307 newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
3311 op_free(kUNOP->op_first);
3312 kUNOP->op_first = newop;
3314 o->op_ppaddr = ppaddr[++o->op_type];
3323 if (o->op_flags & OPf_KIDS) {
3324 OP *kid = cUNOPo->op_first;
3325 if (kid->op_type != OP_HELEM)
3326 croak("%s argument is not a HASH element", op_desc[o->op_type]);
3336 I32 type = o->op_type;
3338 if (o->op_flags & OPf_KIDS) {
3339 if (cLISTOPo->op_first->op_type == OP_STUB) {
3341 o = newUNOP(type, OPf_SPECIAL,
3342 newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV)));
3353 hints |= HINT_BLOCK_SCOPE;
3354 if (o->op_flags & OPf_KIDS) {
3355 SVOP *kid = (SVOP*)cUNOPo->op_first;
3358 o->op_flags &= ~OPf_KIDS;
3361 else if (kid->op_type == OP_LINESEQ) {
3364 kid->op_next = o->op_next;
3365 cUNOPo->op_first = 0;
3368 Newz(1101, enter, 1, LOGOP);
3369 enter->op_type = OP_ENTERTRY;
3370 enter->op_ppaddr = ppaddr[OP_ENTERTRY];
3371 enter->op_private = 0;
3373 /* establish postfix order */
3374 enter->op_next = (OP*)enter;
3376 o = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
3377 o->op_type = OP_LEAVETRY;
3378 o->op_ppaddr = ppaddr[OP_LEAVETRY];
3379 enter->op_other = o;
3385 o = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3387 o->op_targ = (PADOFFSET)hints;
3396 if (o->op_flags & OPf_STACKED) {
3398 kid = cUNOPo->op_first->op_sibling;
3399 if (kid->op_type == OP_RV2GV)
3411 o = fold_constants(o);
3412 if (o->op_type == OP_CONST)
3422 SVOP *kid = (SVOP*)cUNOPo->op_first;
3424 o->op_private |= (hints & HINT_STRICT_REFS);
3425 if (kid->op_type == OP_CONST) {
3426 int iscv = (o->op_type==OP_RV2CV)*2;
3428 kid->op_type = OP_GV;
3429 for (gv = 0; !gv; iscv++) {
3431 * This is a little tricky. We only want to add the symbol if we
3432 * didn't add it in the lexer. Otherwise we get duplicate strict
3433 * warnings. But if we didn't add it in the lexer, we must at
3434 * least pretend like we wanted to add it even if it existed before,
3435 * or we get possible typo warnings. OPpCONST_ENTERED says
3436 * whether the lexer already added THIS instance of this symbol.
3438 gv = gv_fetchpv(SvPVx(kid->op_sv, na),
3439 iscv | !(kid->op_private & OPpCONST_ENTERED),
3442 : o->op_type == OP_RV2SV
3444 : o->op_type == OP_RV2AV
3446 : o->op_type == OP_RV2HV
3450 SvREFCNT_dec(kid->op_sv);
3451 kid->op_sv = SvREFCNT_inc(gv);
3468 I32 type = o->op_type;
3470 if (o->op_flags & OPf_REF)
3473 if (o->op_flags & OPf_KIDS) {
3474 SVOP *kid = (SVOP*)cUNOPo->op_first;
3476 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
3477 OP *newop = newGVOP(type, OPf_REF,
3478 gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
3485 if (type == OP_FTTTY)
3486 return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
3489 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3503 int type = o->op_type;
3504 register I32 oa = opargs[type] >> OASHIFT;
3506 if (o->op_flags & OPf_STACKED) {
3507 if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
3510 return no_fh_allowed(o);
3513 if (o->op_flags & OPf_KIDS) {
3514 tokid = &cLISTOPo->op_first;
3515 kid = cLISTOPo->op_first;
3516 if (kid->op_type == OP_PUSHMARK ||
3517 kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
3519 tokid = &kid->op_sibling;
3520 kid = kid->op_sibling;
3522 if (!kid && opargs[type] & OA_DEFGV)
3523 *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
3527 sibl = kid->op_sibling;
3541 if (kid->op_type == OP_CONST &&
3542 (kid->op_private & OPpCONST_BARE)) {
3543 char *name = SvPVx(((SVOP*)kid)->op_sv, na);
3544 OP *newop = newAVREF(newGVOP(OP_GV, 0,
3545 gv_fetchpv(name, TRUE, SVt_PVAV) ));
3547 warn("Array @%s missing the @ in argument %d of %s()",
3548 name, numargs, op_desc[type]);
3551 kid->op_sibling = sibl;
3554 else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
3555 bad_type(numargs, "array", op_desc[o->op_type], kid);
3559 if (kid->op_type == OP_CONST &&
3560 (kid->op_private & OPpCONST_BARE)) {
3561 char *name = SvPVx(((SVOP*)kid)->op_sv, na);
3562 OP *newop = newHVREF(newGVOP(OP_GV, 0,
3563 gv_fetchpv(name, TRUE, SVt_PVHV) ));
3565 warn("Hash %%%s missing the %% in argument %d of %s()",
3566 name, numargs, op_desc[type]);
3569 kid->op_sibling = sibl;
3572 else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
3573 bad_type(numargs, "hash", op_desc[o->op_type], kid);
3578 OP *newop = newUNOP(OP_NULL, 0, kid);
3579 kid->op_sibling = 0;
3581 newop->op_next = newop;
3583 kid->op_sibling = sibl;
3588 if (kid->op_type != OP_GV) {
3589 if (kid->op_type == OP_CONST &&
3590 (kid->op_private & OPpCONST_BARE)) {
3591 OP *newop = newGVOP(OP_GV, 0,
3592 gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE,
3598 kid->op_sibling = 0;
3599 kid = newUNOP(OP_RV2GV, 0, scalar(kid));
3601 kid->op_sibling = sibl;
3607 mod(scalar(kid), type);
3611 tokid = &kid->op_sibling;
3612 kid = kid->op_sibling;
3614 o->op_private |= numargs;
3616 return too_many_arguments(o,op_desc[o->op_type]);
3619 else if (opargs[type] & OA_DEFGV) {
3621 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3625 while (oa & OA_OPTIONAL)
3627 if (oa && oa != OA_LIST)
3628 return too_few_arguments(o,op_desc[o->op_type]);
3637 GV *gv = newGVgen("main");
3639 append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
3650 OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
3652 o->op_ppaddr = ppaddr[OP_GREPSTART];
3653 Newz(1101, gwop, 1, LOGOP);
3655 if (o->op_flags & OPf_STACKED) {
3658 kid = cLISTOPo->op_first->op_sibling;
3659 for (k = cLISTOPo->op_first->op_sibling->op_next; k; k = k->op_next) {
3662 kid->op_next = (OP*)gwop;
3663 o->op_flags &= ~OPf_STACKED;
3665 kid = cLISTOPo->op_first->op_sibling;
3666 if (type == OP_MAPWHILE)
3673 kid = cLISTOPo->op_first->op_sibling;
3674 if (kid->op_type != OP_NULL)
3675 croak("panic: ck_grep");
3676 kid = kUNOP->op_first;
3678 gwop->op_type = type;
3679 gwop->op_ppaddr = ppaddr[type];
3680 gwop->op_first = listkids(o);
3681 gwop->op_flags |= OPf_KIDS;
3682 gwop->op_private = 1;
3683 gwop->op_other = LINKLIST(kid);
3684 gwop->op_targ = pad_alloc(type, SVs_PADTMP);
3685 kid->op_next = (OP*)gwop;
3687 kid = cLISTOPo->op_first->op_sibling;
3688 if (!kid || !kid->op_sibling)
3689 return too_few_arguments(o,op_desc[o->op_type]);
3690 for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
3691 mod(kid, OP_GREPSTART);
3700 if (o->op_flags & OPf_KIDS) {
3701 OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
3702 if (kid && kid->op_type == OP_CONST)
3703 fbm_compile(((SVOP*)kid)->op_sv, 0);
3712 /* XXX length optimization goes here */
3720 return modkids(ck_fun(o), o->op_type);
3727 return refkids(ck_fun(o), o->op_type);
3736 kid = cLISTOPo->op_first;
3739 kid = cLISTOPo->op_first;
3741 if (kid->op_type == OP_PUSHMARK)
3742 kid = kid->op_sibling;
3743 if (kid && o->op_flags & OPf_STACKED)
3744 kid = kid->op_sibling;
3745 else if (kid && !kid->op_sibling) { /* print HANDLE; */
3746 if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
3747 o->op_flags |= OPf_STACKED; /* make it a filehandle */
3748 kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
3749 cLISTOPo->op_first->op_sibling = kid;
3750 cLISTOPo->op_last = kid;
3751 kid = kid->op_sibling;
3756 append_elem(o->op_type, o, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3765 cPMOPo->op_pmflags |= PMf_RUNTIME;
3766 cPMOPo->op_pmpermflags |= PMf_RUNTIME;
3781 if (cBINOPo->op_first->op_flags & OPf_PARENS) {
3782 o->op_private |= OPpREPEAT_DOLIST;
3783 cBINOPo->op_first = force_list(cBINOPo->op_first);
3794 if (o->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */
3795 SVOP *kid = (SVOP*)cUNOPo->op_first;
3797 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
3799 for (s = SvPVX(kid->op_sv); *s; s++) {
3800 if (*s == ':' && s[1] == ':') {
3802 Move(s+2, s+1, strlen(s+2)+1, char);
3803 --SvCUR(kid->op_sv);
3806 sv_catpvn(kid->op_sv, ".pm", 3);
3816 croak("NOT IMPL LINE %d",__LINE__);
3826 if (o->op_flags & OPf_KIDS) {
3827 kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
3828 if (kid && kid->op_sibling) {
3829 o->op_type = OP_SSELECT;
3830 o->op_ppaddr = ppaddr[OP_SSELECT];
3832 return fold_constants(o);
3836 kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
3837 if (kid && kid->op_type == OP_RV2GV)
3838 kid->op_private &= ~HINT_STRICT_REFS;
3846 I32 type = o->op_type;
3848 if (!(o->op_flags & OPf_KIDS)) {
3850 return newUNOP(type, 0,
3851 scalar(newUNOP(OP_RV2AV, 0,
3852 scalar(newGVOP(OP_GV, 0,
3853 gv_fetchpv((subline ? "_" : "ARGV"), TRUE, SVt_PVAV) )))));
3855 return scalar(modkids(ck_fun(o), type));
3862 if (o->op_flags & OPf_STACKED) {
3863 OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
3865 kid = kUNOP->op_first; /* get past rv2gv */
3867 if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
3869 if (kid->op_type == OP_SCOPE) {
3873 else if (kid->op_type == OP_LEAVE) {
3874 if (o->op_type == OP_SORT) {
3875 null(kid); /* wipe out leave */
3878 for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
3879 if (k->op_next == kid)
3884 kid->op_next = 0; /* just disconnect the leave */
3885 k = kLISTOP->op_first;
3889 kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
3890 null(kid); /* wipe out rv2gv */
3891 if (o->op_type == OP_SORT)
3895 o->op_flags |= OPf_SPECIAL;
3908 if (o->op_flags & OPf_STACKED)
3909 return no_fh_allowed(o);
3911 kid = cLISTOPo->op_first;
3912 if (kid->op_type != OP_NULL)
3913 croak("panic: ck_split");
3914 kid = kid->op_sibling;
3915 op_free(cLISTOPo->op_first);
3916 cLISTOPo->op_first = kid;
3918 cLISTOPo->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
3919 cLISTOPo->op_last = kid; /* There was only one element previously */
3922 if (kid->op_type != OP_MATCH) {
3923 OP *sibl = kid->op_sibling;
3924 kid->op_sibling = 0;
3925 kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
3926 if (cLISTOPo->op_first == cLISTOPo->op_last)
3927 cLISTOPo->op_last = kid;
3928 cLISTOPo->op_first = kid;
3929 kid->op_sibling = sibl;
3932 if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
3933 SvREFCNT_dec(pm->op_pmshort); /* can't use substring to optimize */
3937 kid->op_type = OP_PUSHRE;
3938 kid->op_ppaddr = ppaddr[OP_PUSHRE];
3941 if (!kid->op_sibling)
3942 append_elem(OP_SPLIT, o, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3944 kid = kid->op_sibling;
3947 if (!kid->op_sibling)
3948 append_elem(OP_SPLIT, o, newSVOP(OP_CONST, 0, newSViv(0)));
3950 kid = kid->op_sibling;
3953 if (kid->op_sibling)
3954 return too_many_arguments(o,op_desc[o->op_type]);
3964 OP *prev = ((cUNOPo->op_first->op_sibling)
3965 ? cUNOPo : ((UNOP*)cUNOPo->op_first))->op_first;
3966 OP *o2 = prev->op_sibling;
3973 for (cvop = o2; cvop->op_sibling; cvop = cvop->op_sibling) ;
3974 if (cvop->op_type == OP_RV2CV) {
3976 o->op_private |= (cvop->op_private & OPpENTERSUB_AMPER);
3977 null(cvop); /* disable rv2cv */
3978 tmpop = (SVOP*)((UNOP*)cvop)->op_first;
3979 if (tmpop->op_type == OP_GV) {
3980 cv = GvCV(tmpop->op_sv);
3981 if (cv && SvPOK(cv) && !(o->op_private & OPpENTERSUB_AMPER))
3982 proto = SvPV((SV*)cv,na);
3985 o->op_private |= (hints & HINT_STRICT_REFS);
3986 if (perldb && curstash != debstash)
3987 o->op_private |= OPpENTERSUB_DB;
3988 while (o2 != cvop) {
3992 return too_many_arguments(o, CvNAME(cv));
4010 if (o2->op_type != OP_REFGEN && o2->op_type != OP_UNDEF)
4011 bad_type(arg, "block", CvNAME(cv), o2);
4016 if (o2->op_type == OP_RV2GV)
4020 o2 = newUNOP(OP_RV2GV, 0, kid);
4021 o2->op_sibling = kid->op_sibling;
4022 kid->op_sibling = 0;
4023 prev->op_sibling = o;
4031 if (o2->op_type != OP_RV2GV)
4032 bad_type(arg, "symbol", CvNAME(cv), o2);
4035 if (o2->op_type != OP_RV2CV)
4036 bad_type(arg, "sub", CvNAME(cv), o2);
4039 if (o2->op_type != OP_RV2SV && o2->op_type != OP_PADSV)
4040 bad_type(arg, "scalar", CvNAME(cv), o2);
4043 if (o2->op_type != OP_RV2AV && o2->op_type != OP_PADAV)
4044 bad_type(arg, "array", CvNAME(cv), o2);
4047 if (o2->op_type != OP_RV2HV && o2->op_type != OP_PADHV)
4048 bad_type(arg, "hash", CvNAME(cv), o2);
4052 o2 = newUNOP(OP_REFGEN, 0, kid);
4053 o2->op_sibling = kid->op_sibling;
4054 kid->op_sibling = 0;
4055 prev->op_sibling = o;
4063 croak("Malformed prototype for %s: %s",
4064 CvNAME(cv),SvPV((SV*)cv,na));
4069 mod(o2, OP_ENTERSUB);
4071 o2 = o2->op_sibling;
4073 if (proto && !optional && *proto == '$')
4074 return too_few_arguments(o, CvNAME(cv));
4082 SvREADONLY_on(cSVOPo->op_sv);
4090 if (o->op_flags & OPf_KIDS) {
4091 SVOP *kid = (SVOP*)cUNOPo->op_first;
4093 if (kid->op_type == OP_NULL)
4094 kid = (SVOP*)kid->op_sibling;
4096 kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
4097 o->op_flags |= OPf_SPECIAL;
4102 /* A peephole optimizer. We visit the ops in the order they're to execute. */
4109 register OP* oldop = 0;
4110 if (!o || o->op_seq)
4115 for (; o; o = o->op_next) {
4121 switch (o->op_type) {
4124 curcop = ((COP*)o); /* for warnings */
4125 o->op_seq = op_seqmax++;
4136 if (o->op_next->op_type == OP_STRINGIFY)
4138 o->op_seq = op_seqmax++;
4141 if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) {
4142 o->op_seq = op_seqmax++;
4143 break; /* Scalar stub must produce undef. List stub is noop */
4147 if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
4148 curcop = ((COP*)op);
4154 if (oldop && o->op_next) {
4155 oldop->op_next = o->op_next;
4158 o->op_seq = op_seqmax++;
4162 if (o->op_next->op_type == OP_RV2SV) {
4163 if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) {
4165 o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
4166 o->op_next = o->op_next->op_next;
4167 o->op_type = OP_GVSV;
4168 o->op_ppaddr = ppaddr[OP_GVSV];
4171 else if (o->op_next->op_type == OP_RV2AV) {
4172 OP* pop = o->op_next->op_next;
4174 if (pop->op_type == OP_CONST &&
4175 (op = pop->op_next) &&
4176 pop->op_next->op_type == OP_AELEM &&
4177 !(pop->op_next->op_private &
4178 (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) &&
4179 (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
4183 SvREFCNT_dec(((SVOP*)pop)->op_sv);
4187 o->op_flags |= pop->op_next->op_flags & OPf_MOD;
4188 o->op_next = pop->op_next->op_next;
4189 o->op_type = OP_AELEMFAST;
4190 o->op_ppaddr = ppaddr[OP_AELEMFAST];
4191 o->op_private = (U8)i;
4192 GvAVn((GV*)(((SVOP*)o)->op_sv));
4195 o->op_seq = op_seqmax++;
4202 o->op_seq = op_seqmax++;
4203 peep(cLOGOP->op_other);
4207 o->op_seq = op_seqmax++;
4208 peep(cCONDOP->op_true);
4209 peep(cCONDOP->op_false);
4213 o->op_seq = op_seqmax++;
4214 peep(cLOOP->op_redoop);
4215 peep(cLOOP->op_nextop);
4216 peep(cLOOP->op_lastop);
4221 o->op_seq = op_seqmax++;
4222 peep(cPMOP->op_pmreplstart);
4226 o->op_seq = op_seqmax++;
4227 if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
4228 if (o->op_next->op_sibling &&
4229 o->op_next->op_sibling->op_type != OP_DIE) {
4230 line_t oldline = curcop->cop_line;
4232 curcop->cop_line = ((COP*)o->op_next)->cop_line;
4233 warn("Statement unlikely to be reached");
4234 warn("(Maybe you meant system() when you said exec()?)\n");
4235 curcop->cop_line = oldline;
4240 o->op_seq = op_seqmax++;