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
23 * In the following definition, the ", (OP *) op" is just to make the compiler
24 * think the expression is of the right type: croak actually does a longjmp.
26 #define CHECKOP(type,op) ((op_mask && op_mask[type]) ? \
27 (croak("%s trapped by operation mask", op_name[type]), (OP *) op) \
28 : (*check[type])((OP *) op))
30 #define CHECKOP(type,op) (*check[type])(op)
31 #endif /* USE_OP_MASK */
33 static I32 list_assignment _((OP *op));
34 static OP *bad_type _((I32 n, char *t, OP *op, OP *kid));
35 static OP *modkids _((OP *op, I32 type));
36 static OP *no_fh_allowed _((OP *op));
37 static OP *scalarboolean _((OP *op));
38 static OP *too_few_arguments _((OP *op));
39 static OP *too_many_arguments _((OP *op));
40 static void null _((OP* op));
41 static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, I32 seq,
42 CV* startcv, I32 cx_ix));
48 sprintf(tokenbuf,"Missing comma after first argument to %s function",
49 op_name[op->op_type]);
58 sprintf(tokenbuf,"Not enough arguments for %s", op_name[op->op_type]);
64 too_many_arguments(op)
67 sprintf(tokenbuf,"Too many arguments for %s", op_name[op->op_type]);
73 bad_type(n, t, op, kid)
79 sprintf(tokenbuf, "Type of arg %d to %s must be %s (not %s)",
80 (int) n, op_name[op->op_type], t, op_name[kid->op_type]);
89 int type = op->op_type;
90 if (type != OP_AELEM && type != OP_HELEM) {
91 sprintf(tokenbuf, "Can't use subscript on %s",
94 if (type == OP_RV2HV || type == OP_ENTERSUB)
95 warn("(Did you mean $ or @ instead of %c?)\n",
96 type == OP_RV2HV ? '%' : '&');
100 /* "register" allocation */
109 if (!(isALPHA(name[1]) || name[1] == '_' && (int)strlen(name) > 2)) {
110 if (!isprint(name[1]))
111 sprintf(name+1, "^%c", name[1] ^ 64); /* XXX is tokenbuf, really */
112 croak("Can't use global %s in \"my\"",name);
114 off = pad_alloc(OP_PADSV, SVs_PADMY);
116 sv_upgrade(sv, SVt_PVNV);
118 av_store(comppad_name, off, sv);
119 SvNVX(sv) = (double)999999999;
120 SvIVX(sv) = 0; /* Not yet introduced--see newSTATEOP */
121 if (!min_intro_pending)
122 min_intro_pending = off;
123 max_intro_pending = off;
125 av_store(comppad, off, (SV*)newAV());
126 else if (*name == '%')
127 av_store(comppad, off, (SV*)newHV());
128 SvPADMY_on(curpad[off]);
133 #ifndef CAN_PROTOTYPE
134 pad_findlex(name, newoff, seq, startcv, cx_ix)
141 pad_findlex(char *name, PADOFFSET newoff, I32 seq, CV* startcv, I32 cx_ix)
148 register CONTEXT *cx;
151 for (cv = startcv; cv; cv = CvOUTSIDE(cv)) {
152 AV* curlist = CvPADLIST(cv);
153 SV** svp = av_fetch(curlist, 0, FALSE);
155 if (!svp || *svp == &sv_undef)
158 svp = AvARRAY(curname);
159 for (off = AvFILL(curname); off > 0; off--) {
160 if ((sv = svp[off]) &&
163 seq > (I32)SvNVX(sv) &&
164 strEQ(SvPVX(sv), name))
166 I32 depth = CvDEPTH(cv) ? CvDEPTH(cv) : 1;
167 AV *oldpad = (AV*)*av_fetch(curlist, depth, FALSE);
168 SV *oldsv = *av_fetch(oldpad, off, TRUE);
169 if (!newoff) { /* Not a mere clone operation. */
170 SV *sv = NEWSV(1103,0);
171 newoff = pad_alloc(OP_PADSV, SVs_PADMY);
172 sv_upgrade(sv, SVt_PVNV);
174 av_store(comppad_name, newoff, sv);
175 SvNVX(sv) = (double)curcop->cop_seq;
176 SvIVX(sv) = 999999999; /* A ref, intro immediately */
177 SvFLAGS(sv) |= SVf_FAKE;
179 av_store(comppad, newoff, SvREFCNT_inc(oldsv));
180 SvFLAGS(compcv) |= SVpcv_CLONE;
186 /* Nothing in current lexical context--try eval's context, if any.
187 * This is necessary to let the perldb get at lexically scoped variables.
188 * XXX This will also probably interact badly with eval tree caching.
192 for (i = cx_ix; i >= 0; i--) {
194 switch (cx->cx_type) {
196 if (i == 0 && saweval) {
197 seq = cxstack[saweval].blk_oldcop->cop_seq;
198 return pad_findlex(name, newoff, seq, main_cv, 0);
202 if (cx->blk_eval.old_op_type != OP_ENTEREVAL)
203 return 0; /* require must have its own scope */
210 if (debstash && CvSTASH(cv) == debstash) { /* ignore DB'* scope */
211 saweval = i; /* so we know where we were called from */
214 seq = cxstack[saweval].blk_oldcop->cop_seq;
215 return pad_findlex(name, newoff, seq, cv, i-1);
228 SV **svp = AvARRAY(comppad_name);
229 I32 seq = cop_seqmax;
231 /* The one we're looking for is probably just before comppad_name_fill. */
232 for (off = comppad_name_fill; off > 0; off--) {
233 if ((sv = svp[off]) &&
236 seq > (I32)SvNVX(sv) &&
237 strEQ(SvPVX(sv), name))
239 return (PADOFFSET)off;
243 /* See if it's in a nested scope */
244 off = pad_findlex(name, 0, seq, CvOUTSIDE(compcv), cxstack_ix);
256 SV **svp = AvARRAY(comppad_name);
258 if (min_intro_pending && fill < min_intro_pending) {
259 for (off = max_intro_pending; off >= min_intro_pending; off--) {
260 if ((sv = svp[off]) && sv != &sv_undef)
261 warn("%s never introduced", SvPVX(sv));
264 /* "Deintroduce" my variables that are leaving with this scope. */
265 for (off = AvFILL(comppad_name); off > fill; off--) {
266 if ((sv = svp[off]) && sv != &sv_undef && SvIVX(sv) == 999999999)
267 SvIVX(sv) = cop_seqmax;
272 pad_alloc(optype,tmptype)
279 if (AvARRAY(comppad) != curpad)
280 croak("panic: pad_alloc");
281 if (pad_reset_pending)
283 if (tmptype & SVs_PADMY) {
285 sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE);
286 } while (SvPADBUSY(sv)); /* need a fresh one */
287 retval = AvFILL(comppad);
291 sv = *av_fetch(comppad, ++padix, TRUE);
292 } while (SvFLAGS(sv) & (SVs_PADTMP|SVs_PADMY));
295 SvFLAGS(sv) |= tmptype;
296 curpad = AvARRAY(comppad);
297 DEBUG_X(fprintf(stderr, "Pad alloc %ld for %s\n", (long) retval, op_name[optype]));
298 return (PADOFFSET)retval;
302 #ifndef CAN_PROTOTYPE
307 #endif /* CAN_PROTOTYPE */
310 croak("panic: pad_sv po");
311 DEBUG_X(fprintf(stderr, "Pad sv %d\n", po));
312 return curpad[po]; /* eventually we'll turn this into a macro */
316 #ifndef CAN_PROTOTYPE
320 pad_free(PADOFFSET po)
321 #endif /* CAN_PROTOTYPE */
325 if (AvARRAY(comppad) != curpad)
326 croak("panic: pad_free curpad");
328 croak("panic: pad_free po");
329 DEBUG_X(fprintf(stderr, "Pad free %d\n", po));
330 if (curpad[po] && curpad[po] != &sv_undef)
331 SvPADTMP_off(curpad[po]);
337 #ifndef CAN_PROTOTYPE
341 pad_swipe(PADOFFSET po)
342 #endif /* CAN_PROTOTYPE */
344 if (AvARRAY(comppad) != curpad)
345 croak("panic: pad_swipe curpad");
347 croak("panic: pad_swipe po");
348 DEBUG_X(fprintf(stderr, "Pad swipe %d\n", po));
349 SvPADTMP_off(curpad[po]);
350 curpad[po] = NEWSV(1107,0);
351 SvPADTMP_on(curpad[po]);
361 if (AvARRAY(comppad) != curpad)
362 croak("panic: pad_reset curpad");
363 DEBUG_X(fprintf(stderr, "Pad reset\n"));
364 if (!tainting) { /* Can't mix tainted and non-tainted temporaries. */
365 for (po = AvMAX(comppad); po > padix_floor; po--) {
366 if (curpad[po] && curpad[po] != &sv_undef)
367 SvPADTMP_off(curpad[po]);
371 pad_reset_pending = FALSE;
380 register OP *kid, *nextkid;
385 if (op->op_flags & OPf_KIDS) {
386 for (kid = cUNOP->op_first; kid; kid = nextkid) {
387 nextkid = kid->op_sibling; /* Get before next freeing kid */
392 switch (op->op_type) {
394 op->op_targ = 0; /* Was holding old type, if any. */
397 op->op_targ = 0; /* Was holding hints. */
401 SvREFCNT_dec(cGVOP->op_gv);
405 SvREFCNT_dec(cCOP->cop_filegv);
408 SvREFCNT_dec(cSVOP->op_sv);
414 if (op->op_flags & (OPf_SPECIAL|OPf_STACKED|OPf_KIDS))
418 Safefree(cPVOP->op_pv);
421 op_free(cPMOP->op_pmreplroot);
425 pregfree(cPMOP->op_pmregexp);
426 SvREFCNT_dec(cPMOP->op_pmshort);
433 pad_free(op->op_targ);
442 if (op->op_type != OP_NULL && op->op_targ > 0)
443 pad_free(op->op_targ);
444 op->op_targ = op->op_type;
445 op->op_type = OP_NULL;
446 op->op_ppaddr = ppaddr[OP_NULL];
449 /* Contextualizers */
451 #define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist((OP*)o))
462 /* establish postfix order */
463 if (cUNOP->op_first) {
464 op->op_next = LINKLIST(cUNOP->op_first);
465 for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
467 kid->op_next = LINKLIST(kid->op_sibling);
483 if (op && op->op_flags & OPf_KIDS) {
484 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
495 op->op_type == OP_SASSIGN && cBINOP->op_first->op_type == OP_CONST) {
496 line_t oldline = curcop->cop_line;
498 if (copline != NOLINE)
499 curcop->cop_line = copline;
500 warn("Found = in conditional, should be ==");
501 curcop->cop_line = oldline;
512 /* assumes no premature commitment */
513 if (!op || (op->op_flags & OPf_KNOW) || error_count)
516 op->op_flags &= ~OPf_LIST;
517 op->op_flags |= OPf_KNOW;
519 switch (op->op_type) {
521 scalar(cBINOP->op_first);
526 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
530 if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) {
531 if (!kPMOP->op_pmreplroot)
532 deprecate("implicit split to @_");
539 if (op->op_flags & OPf_KIDS) {
540 for (kid = cUNOP->op_first; kid; kid = kid->op_sibling)
546 scalar(cLISTOP->op_first);
551 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
571 if (!op || error_count)
573 if (op->op_flags & OPf_LIST)
576 op->op_flags |= OPf_KNOW;
578 switch (op->op_type) {
580 if (!(opargs[op->op_type] & OA_FOLDCONST))
582 if (op->op_flags & OPf_STACKED)
656 if (!(op->op_private & OPpLVAL_INTRO))
657 useless = op_name[op->op_type];
664 if (!(op->op_private & OPpLVAL_INTRO) &&
665 (!op->op_sibling || op->op_sibling->op_type != OP_READLINE))
666 useless = "a variable";
671 curcop = ((COP*)op); /* for warning below */
677 useless = "a constant";
678 if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
680 else if (SvPOK(sv)) {
681 if (strnEQ(SvPVX(sv), "di", 2) ||
682 strnEQ(SvPVX(sv), "ds", 2) ||
683 strnEQ(SvPVX(sv), "ig", 2))
687 null(op); /* don't execute a constant */
688 SvREFCNT_dec(sv); /* don't even remember it */
692 op->op_type = OP_PREINC; /* pre-increment is faster */
693 op->op_ppaddr = ppaddr[OP_PREINC];
697 op->op_type = OP_PREDEC; /* pre-decrement is faster */
698 op->op_ppaddr = ppaddr[OP_PREDEC];
702 scalarvoid(cBINOP->op_first);
703 useless = op_name[op->op_type];
709 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
713 if (op->op_targ == OP_NEXTSTATE || op->op_targ == OP_DBSTATE)
714 curcop = ((COP*)op); /* for warning below */
715 if (op->op_flags & OPf_STACKED)
720 if (!(op->op_flags & OPf_KIDS))
726 op->op_private |= OPpLEAVE_VOID;
729 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
733 if ((kid = ((LISTOP*)op)->op_first) && kid->op_type == OP_PUSHRE) {
734 if (!kPMOP->op_pmreplroot)
735 deprecate("implicit split to @_");
739 op->op_private |= OPpLEAVE_VOID;
742 if (useless && dowarn)
743 warn("Useless use of %s in void context", useless);
752 if (op && op->op_flags & OPf_KIDS) {
753 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
765 /* assumes no premature commitment */
766 if (!op || (op->op_flags & OPf_KNOW) || error_count)
769 op->op_flags |= (OPf_KNOW | OPf_LIST);
771 switch (op->op_type) {
774 list(cBINOP->op_first);
779 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
786 if (!(op->op_flags & OPf_KIDS))
788 if (!op->op_next && cUNOP->op_first->op_type == OP_FLOP) {
789 list(cBINOP->op_first);
790 return gen_constant_list(op);
797 list(cLISTOP->op_first);
801 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
820 if (op->op_type == OP_LINESEQ ||
821 op->op_type == OP_SCOPE ||
822 op->op_type == OP_LEAVE ||
823 op->op_type == OP_LEAVETRY)
825 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
826 if (kid->op_sibling) {
832 op->op_flags &= ~OPf_PARENS;
833 if (hints & HINT_BLOCK_SCOPE)
834 op->op_flags |= OPf_PARENS;
837 op = newOP(OP_STUB, 0);
847 if (op && op->op_flags & OPf_KIDS) {
848 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
865 if (!op || error_count)
868 switch (op->op_type) {
870 if (!(op->op_private & (OPpCONST_ARYBASE)))
872 if (eval_start && eval_start->op_type == OP_CONST) {
873 compiling.cop_arybase = (I32)SvIV(((SVOP*)eval_start)->op_sv);
877 SAVEI32(compiling.cop_arybase);
878 compiling.cop_arybase = 0;
880 else if (type == OP_REFGEN)
883 croak("That use of $[ is unsupported");
886 if ((type == OP_UNDEF || type == OP_REFGEN) &&
887 !(op->op_flags & OPf_STACKED)) {
888 op->op_type = OP_RV2CV; /* entersub => rv2cv */
889 op->op_ppaddr = ppaddr[OP_RV2CV];
890 assert(cUNOP->op_first->op_type == OP_NULL);
891 null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */
897 /* grep, foreach, subcalls, refgen */
898 if (type == OP_GREPSTART || type == OP_ENTERSUB || type == OP_REFGEN)
900 sprintf(tokenbuf, "Can't modify %s in %s",
901 op_name[op->op_type],
902 type ? op_name[type] : "local");
926 if (!(op->op_flags & OPf_STACKED))
932 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
938 if (type == OP_REFGEN && op->op_flags & OPf_PARENS) {
940 return op; /* Treat \(@foo) like ordinary list. */
944 ref(cUNOP->op_first, op->op_type);
956 ref(cUNOP->op_first, op->op_type);
973 croak("Can't localize lexical variable %s",
974 SvPV(*av_fetch(comppad_name, op->op_targ, 4), na));
989 pad_free(op->op_targ);
990 op->op_targ = pad_alloc(op->op_type, SVs_PADMY);
991 sv = PAD_SV(op->op_targ);
992 sv_upgrade(sv, SVt_PVLV);
993 sv_magic(sv, Nullsv, mtype, Nullch, 0);
994 curpad[op->op_targ] = sv;
995 if (op->op_flags & OPf_KIDS)
996 mod(cBINOP->op_first, type);
1001 ref(cBINOP->op_first, op->op_type);
1008 if (op->op_flags & OPf_KIDS)
1009 mod(cLISTOP->op_last, type);
1013 if (!(op->op_flags & OPf_KIDS))
1015 if (op->op_targ != OP_LIST) {
1016 mod(cBINOP->op_first, type);
1021 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
1025 op->op_flags |= OPf_MOD;
1027 if (type == OP_AASSIGN || type == OP_SASSIGN)
1028 op->op_flags |= OPf_SPECIAL|OPf_REF;
1030 op->op_private |= OPpLVAL_INTRO;
1031 op->op_flags &= ~OPf_SPECIAL;
1033 else if (type != OP_GREPSTART && type != OP_ENTERSUB)
1034 op->op_flags |= OPf_REF;
1044 if (op && op->op_flags & OPf_KIDS) {
1045 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
1058 if (!op || error_count)
1061 switch (op->op_type) {
1063 if ((type == OP_DEFINED) &&
1064 !(op->op_flags & OPf_STACKED)) {
1065 op->op_type = OP_RV2CV; /* entersub => rv2cv */
1066 op->op_ppaddr = ppaddr[OP_RV2CV];
1067 assert(cUNOP->op_first->op_type == OP_NULL);
1068 null(((LISTOP*)cUNOP->op_first)->op_first); /* disable pushmark */
1073 for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
1077 ref(cUNOP->op_first, op->op_type);
1078 if (type == OP_RV2AV || type == OP_RV2HV) {
1079 op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV);
1080 op->op_flags |= OPf_MOD;
1086 op->op_flags |= OPf_REF;
1089 ref(cUNOP->op_first, op->op_type);
1094 op->op_flags |= OPf_REF;
1099 if (!(op->op_flags & OPf_KIDS))
1101 ref(cBINOP->op_first, type);
1105 ref(cBINOP->op_first, op->op_type);
1106 if (type == OP_RV2AV || type == OP_RV2HV) {
1107 op->op_private |= (type == OP_RV2AV ? OPpDEREF_AV : OPpDEREF_HV);
1108 op->op_flags |= OPf_MOD;
1116 if (!(op->op_flags & OPf_KIDS))
1118 ref(cLISTOP->op_last, type);
1134 if (!op || error_count)
1138 if (type == OP_LIST) {
1139 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
1142 else if (type != OP_PADSV &&
1145 type != OP_PUSHMARK)
1147 sprintf(tokenbuf, "Can't declare %s in my", op_name[op->op_type]);
1151 op->op_flags |= OPf_MOD;
1152 op->op_private |= OPpLVAL_INTRO;
1161 o->op_flags |= OPf_PARENS;
1166 bind_match(type, left, right)
1173 if (right->op_type == OP_MATCH ||
1174 right->op_type == OP_SUBST ||
1175 right->op_type == OP_TRANS) {
1176 right->op_flags |= OPf_STACKED;
1177 if (right->op_type != OP_MATCH)
1178 left = mod(left, right->op_type);
1179 if (right->op_type == OP_TRANS)
1180 op = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
1182 op = prepend_elem(right->op_type, scalar(left), right);
1184 return newUNOP(OP_NOT, 0, scalar(op));
1188 return bind_match(type, left,
1189 pmruntime(newPMOP(OP_MATCH, 0), right, Nullop));
1198 /* XXX need to optimize away NOT NOT here? Or do we let optimizer do it? */
1199 return newUNOP(OP_NOT, OPf_SPECIAL, scalar(op));
1207 if (o->op_flags & OPf_PARENS || perldb) {
1208 o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
1209 o->op_type = OP_LEAVE;
1210 o->op_ppaddr = ppaddr[OP_LEAVE];
1213 if (o->op_type == OP_LINESEQ) {
1215 o->op_type = OP_SCOPE;
1216 o->op_ppaddr = ppaddr[OP_SCOPE];
1217 kid = ((LISTOP*)o)->op_first;
1218 if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE){
1219 SvREFCNT_dec(((COP*)kid)->cop_filegv);
1224 o = newLISTOP(OP_SCOPE, 0, o, Nullop);
1233 int retval = savestack_ix;
1234 comppad_name_fill = AvFILL(comppad_name);
1235 SAVEINT(min_intro_pending);
1236 SAVEINT(max_intro_pending);
1237 min_intro_pending = 0;
1238 SAVEINT(comppad_name_fill);
1239 SAVEINT(padix_floor);
1240 padix_floor = padix;
1241 pad_reset_pending = FALSE;
1243 hints &= ~HINT_BLOCK_SCOPE;
1248 block_end(line, floor, seq)
1253 int needblockscope = hints & HINT_BLOCK_SCOPE;
1254 OP* retval = scalarseq(seq);
1255 if (copline > (line_t)line)
1258 pad_reset_pending = FALSE;
1260 hints |= HINT_BLOCK_SCOPE; /* propagate out */
1261 pad_leavemy(comppad_name_fill);
1270 eval_root = newUNOP(OP_LEAVEEVAL, 0, op);
1271 eval_start = linklist(eval_root);
1272 eval_root->op_next = 0;
1280 main_root = scope(sawparens(scalarvoid(op)));
1281 curcop = &compiling;
1282 main_start = LINKLIST(main_root);
1283 main_root->op_next = 0;
1295 if (o->op_flags & OPf_PARENS)
1299 if (dowarn && bufptr > oldbufptr && bufptr[-1] == ',') {
1301 for (s = bufptr; *s && (isALNUM(*s) || strchr("@$%, ",*s)); s++) ;
1302 if (*s == ';' || *s == '=')
1303 warn("Parens missing around \"%s\" list", lex ? "my" : "local");
1310 return mod(o, OP_NULL); /* a bit kludgey */
1317 if (o->op_type == OP_LIST) {
1318 o = convert(OP_JOIN, 0,
1319 prepend_elem(OP_LIST,
1320 newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE, SVt_PV))),
1331 I32 type = o->op_type;
1334 if (opargs[type] & OA_RETSCALAR)
1336 if (opargs[type] & OA_TARGET)
1337 o->op_targ = pad_alloc(type, SVs_PADTMP);
1339 if ((opargs[type] & OA_OTHERINT) && (hints & HINT_INTEGER))
1340 o->op_ppaddr = ppaddr[type = ++(o->op_type)];
1342 if (!(opargs[type] & OA_FOLDCONST))
1346 goto nope; /* Don't try to run w/ errors */
1348 for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
1349 if (curop->op_type != OP_CONST &&
1350 curop->op_type != OP_LIST &&
1351 curop->op_type != OP_SCALAR &&
1352 curop->op_type != OP_NULL &&
1353 curop->op_type != OP_PUSHMARK) {
1358 curop = LINKLIST(o);
1363 if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */
1364 pad_swipe(o->op_targ);
1365 else if (SvTEMP(sv)) { /* grab mortal temp? */
1366 (void)SvREFCNT_inc(sv);
1370 if (type == OP_RV2GV)
1371 return newGVOP(OP_GV, 0, sv);
1373 if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK) {
1375 if ((double)iv == SvNV(sv)) { /* can we smush double to int */
1380 return newSVOP(OP_CONST, 0, sv);
1384 if (!(opargs[type] & OA_OTHERINT))
1387 if (!(hints & HINT_INTEGER)) {
1388 if (type == OP_DIVIDE || !(o->op_flags & OPf_KIDS))
1391 for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
1392 if (curop->op_type == OP_CONST) {
1393 if (SvIOK(((SVOP*)curop)->op_sv))
1397 if (opargs[curop->op_type] & OA_RETINTEGER)
1401 o->op_ppaddr = ppaddr[++(o->op_type)];
1408 gen_constant_list(o)
1412 I32 oldtmps_floor = tmps_floor;
1416 return o; /* Don't attempt to run with errors */
1418 op = curop = LINKLIST(o);
1424 tmps_floor = oldtmps_floor;
1426 o->op_type = OP_RV2AV;
1427 o->op_ppaddr = ppaddr[OP_RV2AV];
1428 curop = ((UNOP*)o)->op_first;
1429 ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc(*stack_sp--));
1436 convert(type, flags, op)
1444 if (!op || op->op_type != OP_LIST)
1445 op = newLISTOP(OP_LIST, 0, op, Nullop);
1447 op->op_flags &= ~(OPf_KNOW|OPf_LIST);
1449 if (!(opargs[type] & OA_MARK))
1450 null(cLISTOP->op_first);
1453 op->op_ppaddr = ppaddr[type];
1454 op->op_flags |= flags;
1456 op = CHECKOP(type, op);
1457 if (op->op_type != type)
1460 if (cLISTOP->op_children < 7) {
1461 /* XXX do we really need to do this if we're done appending?? */
1462 for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
1464 cLISTOP->op_last = last; /* in case check substituted last arg */
1467 return fold_constants(op);
1470 /* List constructors */
1473 append_elem(type, first, last)
1484 if (first->op_type != type || type==OP_LIST && first->op_flags & OPf_PARENS)
1485 return newLISTOP(type, 0, first, last);
1487 if (first->op_flags & OPf_KIDS)
1488 ((LISTOP*)first)->op_last->op_sibling = last;
1490 first->op_flags |= OPf_KIDS;
1491 ((LISTOP*)first)->op_first = last;
1493 ((LISTOP*)first)->op_last = last;
1494 ((LISTOP*)first)->op_children++;
1499 append_list(type, first, last)
1510 if (first->op_type != type)
1511 return prepend_elem(type, (OP*)first, (OP*)last);
1513 if (last->op_type != type)
1514 return append_elem(type, (OP*)first, (OP*)last);
1516 first->op_last->op_sibling = last->op_first;
1517 first->op_last = last->op_last;
1518 first->op_children += last->op_children;
1519 if (first->op_children)
1520 last->op_flags |= OPf_KIDS;
1527 prepend_elem(type, first, last)
1538 if (last->op_type == type) {
1539 if (type == OP_LIST) { /* already a PUSHMARK there */
1540 first->op_sibling = ((LISTOP*)last)->op_first->op_sibling;
1541 ((LISTOP*)last)->op_first->op_sibling = first;
1544 if (!(last->op_flags & OPf_KIDS)) {
1545 ((LISTOP*)last)->op_last = first;
1546 last->op_flags |= OPf_KIDS;
1548 first->op_sibling = ((LISTOP*)last)->op_first;
1549 ((LISTOP*)last)->op_first = first;
1551 ((LISTOP*)last)->op_children++;
1555 return newLISTOP(type, 0, first, last);
1563 return newOP(OP_STUB, 0);
1570 if (!op || op->op_type != OP_LIST)
1571 op = newLISTOP(OP_LIST, 0, op, Nullop);
1577 newLISTOP(type, flags, first, last)
1585 Newz(1101, listop, 1, LISTOP);
1587 listop->op_type = type;
1588 listop->op_ppaddr = ppaddr[type];
1589 listop->op_children = (first != 0) + (last != 0);
1590 listop->op_flags = flags;
1594 else if (!first && last)
1597 first->op_sibling = last;
1598 listop->op_first = first;
1599 listop->op_last = last;
1600 if (type == OP_LIST) {
1602 pushop = newOP(OP_PUSHMARK, 0);
1603 pushop->op_sibling = first;
1604 listop->op_first = pushop;
1605 listop->op_flags |= OPf_KIDS;
1607 listop->op_last = pushop;
1609 else if (listop->op_children)
1610 listop->op_flags |= OPf_KIDS;
1621 Newz(1101, op, 1, OP);
1623 op->op_ppaddr = ppaddr[type];
1624 op->op_flags = flags;
1627 /* op->op_private = 0; */
1628 if (opargs[type] & OA_RETSCALAR)
1630 if (opargs[type] & OA_TARGET)
1631 op->op_targ = pad_alloc(type, SVs_PADTMP);
1632 return CHECKOP(type, op);
1636 newUNOP(type, flags, first)
1644 first = newOP(OP_STUB, 0);
1645 if (opargs[type] & OA_MARK)
1646 first = force_list(first);
1648 Newz(1101, unop, 1, UNOP);
1649 unop->op_type = type;
1650 unop->op_ppaddr = ppaddr[type];
1651 unop->op_first = first;
1652 unop->op_flags = flags | OPf_KIDS;
1653 unop->op_private = 1;
1655 unop = (UNOP*) CHECKOP(type, unop);
1659 return fold_constants((OP *) unop);
1663 newBINOP(type, flags, first, last)
1670 Newz(1101, binop, 1, BINOP);
1673 first = newOP(OP_NULL, 0);
1675 binop->op_type = type;
1676 binop->op_ppaddr = ppaddr[type];
1677 binop->op_first = first;
1678 binop->op_flags = flags | OPf_KIDS;
1681 binop->op_private = 1;
1684 binop->op_private = 2;
1685 first->op_sibling = last;
1688 binop = (BINOP*)CHECKOP(type, binop);
1692 binop->op_last = last = binop->op_first->op_sibling;
1694 return fold_constants((OP *)binop);
1698 pmtrans(op, expr, repl)
1703 SV *tstr = ((SVOP*)expr)->op_sv;
1704 SV *rstr = ((SVOP*)repl)->op_sv;
1707 register char *t = SvPV(tstr, tlen);
1708 register char *r = SvPV(rstr, rlen);
1713 register short *tbl;
1715 tbl = (short*)cPVOP->op_pv;
1716 complement = op->op_private & OPpTRANS_COMPLEMENT;
1717 delete = op->op_private & OPpTRANS_DELETE;
1718 /* squash = op->op_private & OPpTRANS_SQUASH; */
1721 Zero(tbl, 256, short);
1722 for (i = 0; i < tlen; i++)
1723 tbl[t[i] & 0377] = -1;
1724 for (i = 0, j = 0; i < 256; i++) {
1730 tbl[i] = r[j-1] & 0377;
1735 tbl[i] = r[j++] & 0377;
1740 if (!rlen && !delete) {
1743 for (i = 0; i < 256; i++)
1745 for (i = 0, j = 0; i < tlen; i++,j++) {
1748 if (tbl[t[i] & 0377] == -1)
1749 tbl[t[i] & 0377] = -2;
1754 if (tbl[t[i] & 0377] == -1)
1755 tbl[t[i] & 0377] = r[j] & 0377;
1765 newPMOP(type, flags)
1771 Newz(1101, pmop, 1, PMOP);
1772 pmop->op_type = type;
1773 pmop->op_ppaddr = ppaddr[type];
1774 pmop->op_flags = flags;
1775 pmop->op_private = 0;
1777 /* link into pm list */
1778 if (type != OP_TRANS && curstash) {
1779 pmop->op_pmnext = HvPMROOT(curstash);
1780 HvPMROOT(curstash) = pmop;
1787 pmruntime(op, expr, repl)
1795 if (op->op_type == OP_TRANS)
1796 return pmtrans(op, expr, repl);
1800 if (expr->op_type == OP_CONST) {
1802 SV *pat = ((SVOP*)expr)->op_sv;
1803 char *p = SvPV(pat, plen);
1804 if ((op->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
1805 sv_setpvn(pat, "\\s+", 3);
1806 p = SvPV(pat, plen);
1807 pm->op_pmflags |= PMf_SKIPWHITE;
1809 pm->op_pmregexp = pregcomp(p, p + plen, pm);
1810 if (strEQ("\\s+", pm->op_pmregexp->precomp))
1811 pm->op_pmflags |= PMf_WHITE;
1816 if (pm->op_pmflags & PMf_KEEP)
1817 expr = newUNOP(OP_REGCMAYBE,0,expr);
1819 Newz(1101, rcop, 1, LOGOP);
1820 rcop->op_type = OP_REGCOMP;
1821 rcop->op_ppaddr = ppaddr[OP_REGCOMP];
1822 rcop->op_first = scalar(expr);
1823 rcop->op_flags |= OPf_KIDS;
1824 rcop->op_private = 1;
1825 rcop->op_other = op;
1827 /* establish postfix order */
1828 if (pm->op_pmflags & PMf_KEEP) {
1830 rcop->op_next = expr;
1831 ((UNOP*)expr)->op_first->op_next = (OP*)rcop;
1834 rcop->op_next = LINKLIST(expr);
1835 expr->op_next = (OP*)rcop;
1838 prepend_elem(op->op_type, scalar((OP*)rcop), op);
1843 if (pm->op_pmflags & PMf_EVAL)
1845 else if (repl->op_type == OP_CONST)
1849 for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
1850 if (opargs[curop->op_type] & OA_DANGEROUS) {
1851 if (curop->op_type == OP_GV) {
1852 GV *gv = ((GVOP*)curop)->op_gv;
1853 if (strchr("&`'123456789+", *GvENAME(gv)))
1856 else if (curop->op_type == OP_RV2CV)
1858 else if (curop->op_type == OP_RV2SV ||
1859 curop->op_type == OP_RV2AV ||
1860 curop->op_type == OP_RV2HV ||
1861 curop->op_type == OP_RV2GV) {
1862 if (lastop && lastop->op_type != OP_GV) /*funny deref?*/
1865 else if (curop->op_type == OP_PADSV ||
1866 curop->op_type == OP_PADAV ||
1867 curop->op_type == OP_PADHV ||
1868 curop->op_type == OP_PADANY) {
1877 if (curop == repl) {
1878 pm->op_pmflags |= PMf_CONST; /* const for long enough */
1879 prepend_elem(op->op_type, scalar(repl), op);
1882 Newz(1101, rcop, 1, LOGOP);
1883 rcop->op_type = OP_SUBSTCONT;
1884 rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
1885 rcop->op_first = scalar(repl);
1886 rcop->op_flags |= OPf_KIDS;
1887 rcop->op_private = 1;
1888 rcop->op_other = op;
1890 /* establish postfix order */
1891 rcop->op_next = LINKLIST(repl);
1892 repl->op_next = (OP*)rcop;
1894 pm->op_pmreplroot = scalar((OP*)rcop);
1895 pm->op_pmreplstart = LINKLIST(rcop);
1904 newSVOP(type, flags, sv)
1910 Newz(1101, svop, 1, SVOP);
1911 svop->op_type = type;
1912 svop->op_ppaddr = ppaddr[type];
1914 svop->op_next = (OP*)svop;
1915 svop->op_flags = flags;
1916 if (opargs[type] & OA_RETSCALAR)
1918 if (opargs[type] & OA_TARGET)
1919 svop->op_targ = pad_alloc(type, SVs_PADTMP);
1920 return CHECKOP(type, svop);
1924 newGVOP(type, flags, gv)
1930 Newz(1101, gvop, 1, GVOP);
1931 gvop->op_type = type;
1932 gvop->op_ppaddr = ppaddr[type];
1933 gvop->op_gv = (GV*)SvREFCNT_inc(gv);
1934 gvop->op_next = (OP*)gvop;
1935 gvop->op_flags = flags;
1936 if (opargs[type] & OA_RETSCALAR)
1938 if (opargs[type] & OA_TARGET)
1939 gvop->op_targ = pad_alloc(type, SVs_PADTMP);
1940 return CHECKOP(type, gvop);
1944 newPVOP(type, flags, pv)
1950 Newz(1101, pvop, 1, PVOP);
1951 pvop->op_type = type;
1952 pvop->op_ppaddr = ppaddr[type];
1954 pvop->op_next = (OP*)pvop;
1955 pvop->op_flags = flags;
1956 if (opargs[type] & OA_RETSCALAR)
1958 if (opargs[type] & OA_TARGET)
1959 pvop->op_targ = pad_alloc(type, SVs_PADTMP);
1960 return CHECKOP(type, pvop);
1964 newCVOP(type, flags, cv, cont)
1971 Newz(1101, cvop, 1, CVOP);
1972 cvop->op_type = type;
1973 cvop->op_ppaddr = ppaddr[type];
1975 cvop->op_cont = cont;
1976 cvop->op_next = (OP*)cvop;
1977 cvop->op_flags = flags;
1978 if (opargs[type] & OA_RETSCALAR)
1980 if (opargs[type] & OA_TARGET)
1981 cvop->op_targ = pad_alloc(type, SVs_PADTMP);
1982 return CHECKOP(type, cvop);
1991 save_hptr(&curstash);
1992 save_item(curstname);
1997 name = SvPV(sv, len);
1998 curstash = gv_stashpv(name,TRUE);
1999 sv_setpvn(curstname, name, len);
2003 sv_setpv(curstname,"<none>");
2011 utilize(aver, id, arg)
2021 if (id->op_type != OP_CONST)
2022 croak("Module name must be constant");
2024 meth = newSVOP(OP_CONST, 0,
2026 ? newSVpv("import", 6)
2027 : newSVpv("unimport", 8)
2030 /* Make copy of id so we don't free it twice */
2031 pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
2033 /* Fake up a require */
2034 rqop = newUNOP(OP_REQUIRE, 0, id);
2036 /* Fake up an import/unimport */
2037 imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
2038 append_elem(OP_LIST,
2039 prepend_elem(OP_LIST, pack, list(arg)),
2040 newUNOP(OP_METHOD, 0, meth)));
2042 /* Fake up the BEGIN {}, which does its thing immediately. */
2043 newSUB(start_subparse(),
2044 newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)),
2045 append_elem(OP_LINESEQ,
2046 newSTATEOP(0, Nullch, rqop),
2047 newSTATEOP(0, Nullch, imop) ));
2054 newSLICEOP(flags, subscript, listval)
2059 return newBINOP(OP_LSLICE, flags,
2060 list(force_list(subscript)),
2061 list(force_list(listval)) );
2071 if (op->op_type == OP_NULL && op->op_flags & OPf_KIDS)
2072 op = cUNOP->op_first;
2074 if (op->op_type == OP_COND_EXPR) {
2075 I32 t = list_assignment(cCONDOP->op_first->op_sibling);
2076 I32 f = list_assignment(cCONDOP->op_first->op_sibling->op_sibling);
2081 yyerror("Assignment to both a list and a scalar");
2085 if (op->op_type == OP_LIST || op->op_flags & OPf_PARENS ||
2086 op->op_type == OP_RV2AV || op->op_type == OP_RV2HV ||
2087 op->op_type == OP_ASLICE || op->op_type == OP_HSLICE)
2090 if (op->op_type == OP_PADAV || op->op_type == OP_PADHV)
2093 if (op->op_type == OP_RV2SV)
2100 newASSIGNOP(flags, left, optype, right)
2109 if (optype == OP_ANDASSIGN || optype == OP_ORASSIGN) {
2110 return newLOGOP(optype, 0,
2111 mod(scalar(left), optype),
2112 newUNOP(OP_SASSIGN, 0, scalar(right)));
2115 return newBINOP(optype, OPf_STACKED,
2116 mod(scalar(left), optype), scalar(right));
2120 if (list_assignment(left)) {
2122 eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
2123 left = mod(left, OP_AASSIGN);
2131 if (right && right->op_type == OP_SPLIT) {
2132 if ((op = ((LISTOP*)right)->op_first) && op->op_type == OP_PUSHRE) {
2133 PMOP *pm = (PMOP*)op;
2134 if (left->op_type == OP_RV2AV &&
2135 !(left->op_private & OPpLVAL_INTRO) )
2137 op = ((UNOP*)left)->op_first;
2138 if (op->op_type == OP_GV && !pm->op_pmreplroot) {
2139 pm->op_pmreplroot = (OP*)((GVOP*)op)->op_gv;
2140 pm->op_pmflags |= PMf_ONCE;
2146 if (modcount < 10000) {
2147 SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
2149 sv_setiv(sv, modcount+1);
2154 op = newBINOP(OP_AASSIGN, flags,
2155 list(force_list(right)),
2156 list(force_list(left)) );
2158 if (!(left->op_private & OPpLVAL_INTRO)) {
2159 static int generation = 100;
2163 for (curop = LINKLIST(op); curop != op; curop = LINKLIST(curop)) {
2164 if (opargs[curop->op_type] & OA_DANGEROUS) {
2165 if (curop->op_type == OP_GV) {
2166 GV *gv = ((GVOP*)curop)->op_gv;
2167 if (gv == defgv || SvCUR(gv) == generation)
2169 SvCUR(gv) = generation;
2171 else if (curop->op_type == OP_PADSV ||
2172 curop->op_type == OP_PADAV ||
2173 curop->op_type == OP_PADHV ||
2174 curop->op_type == OP_PADANY) {
2175 SV **svp = AvARRAY(comppad_name);
2176 SV *sv = svp[curop->op_targ];
2177 if (SvCUR(sv) == generation)
2179 SvCUR(sv) = generation; /* (SvCUR not used any more) */
2181 else if (curop->op_type == OP_RV2CV)
2183 else if (curop->op_type == OP_RV2SV ||
2184 curop->op_type == OP_RV2AV ||
2185 curop->op_type == OP_RV2HV ||
2186 curop->op_type == OP_RV2GV) {
2187 if (lastop->op_type != OP_GV) /* funny deref? */
2196 op->op_private = OPpASSIGN_COMMON;
2201 right = newOP(OP_UNDEF, 0);
2202 if (right->op_type == OP_READLINE) {
2203 right->op_flags |= OPf_STACKED;
2204 return newBINOP(OP_NULL, flags, mod(scalar(left), OP_SASSIGN), scalar(right));
2207 eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/
2208 op = newBINOP(OP_SASSIGN, flags,
2209 scalar(right), mod(scalar(left), OP_SASSIGN) );
2221 newSTATEOP(flags, label, op)
2228 /* Introduce my variables. */
2229 if (min_intro_pending) {
2230 SV **svp = AvARRAY(comppad_name);
2233 for (i = min_intro_pending; i <= max_intro_pending; i++) {
2234 if ((sv = svp[i]) && sv != &sv_undef) {
2235 SvIVX(sv) = 999999999; /* Don't know scope end yet. */
2236 SvNVX(sv) = (double)cop_seqmax;
2239 min_intro_pending = 0;
2240 comppad_name_fill = max_intro_pending; /* Needn't search higher */
2243 Newz(1101, cop, 1, COP);
2244 if (perldb && curcop->cop_line && curstash != debstash) {
2245 cop->op_type = OP_DBSTATE;
2246 cop->op_ppaddr = ppaddr[ OP_DBSTATE ];
2249 cop->op_type = OP_NEXTSTATE;
2250 cop->op_ppaddr = ppaddr[ OP_NEXTSTATE ];
2252 cop->op_flags = flags;
2253 cop->op_private = 0;
2254 cop->op_next = (OP*)cop;
2257 cop->cop_label = label;
2258 hints |= HINT_BLOCK_SCOPE;
2260 cop->cop_seq = cop_seqmax++;
2261 cop->cop_arybase = curcop->cop_arybase;
2263 if (copline == NOLINE)
2264 cop->cop_line = curcop->cop_line;
2266 cop->cop_line = copline;
2269 cop->cop_filegv = SvREFCNT_inc(curcop->cop_filegv);
2270 cop->cop_stash = curstash;
2272 if (perldb && curstash != debstash) {
2273 SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE);
2274 if (svp && *svp != &sv_undef && !SvIOK(*svp)) {
2276 (void)SvIOK_on(*svp);
2277 SvSTASH(*svp) = (HV*)cop;
2281 return prepend_elem(OP_LINESEQ, (OP*)cop, op);
2285 newLOGOP(type, flags, first, other)
2294 if (type == OP_XOR) /* Not short circuit, but here by precedence. */
2295 return newBINOP(type, flags, scalar(first), scalar(other));
2297 scalarboolean(first);
2298 /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
2299 if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) {
2300 if (type == OP_AND || type == OP_OR) {
2306 first = cUNOP->op_first;
2308 first->op_next = op->op_next;
2309 cUNOP->op_first = Nullop;
2313 if (first->op_type == OP_CONST) {
2314 if (dowarn && (first->op_private & OPpCONST_BARE))
2315 warn("Probable precedence problem on %s", op_name[type]);
2316 if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
2325 else if (first->op_type == OP_WANTARRAY) {
2335 if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
2336 other->op_private |= OPpASSIGN_BACKWARDS; /* other is an OP_SASSIGN */
2338 Newz(1101, logop, 1, LOGOP);
2340 logop->op_type = type;
2341 logop->op_ppaddr = ppaddr[type];
2342 logop->op_first = first;
2343 logop->op_flags = flags | OPf_KIDS;
2344 logop->op_other = LINKLIST(other);
2345 logop->op_private = 1;
2347 /* establish postfix order */
2348 logop->op_next = LINKLIST(first);
2349 first->op_next = (OP*)logop;
2350 first->op_sibling = other;
2352 op = newUNOP(OP_NULL, 0, (OP*)logop);
2353 other->op_next = op;
2359 newCONDOP(flags, first, true, false)
2369 return newLOGOP(OP_AND, 0, first, true);
2371 return newLOGOP(OP_OR, 0, first, false);
2373 scalarboolean(first);
2374 if (first->op_type == OP_CONST) {
2375 if (SvTRUE(((SVOP*)first)->op_sv)) {
2386 else if (first->op_type == OP_WANTARRAY) {
2390 Newz(1101, condop, 1, CONDOP);
2392 condop->op_type = OP_COND_EXPR;
2393 condop->op_ppaddr = ppaddr[OP_COND_EXPR];
2394 condop->op_first = first;
2395 condop->op_flags = flags | OPf_KIDS;
2396 condop->op_true = LINKLIST(true);
2397 condop->op_false = LINKLIST(false);
2398 condop->op_private = 1;
2400 /* establish postfix order */
2401 condop->op_next = LINKLIST(first);
2402 first->op_next = (OP*)condop;
2404 first->op_sibling = true;
2405 true->op_sibling = false;
2406 op = newUNOP(OP_NULL, 0, (OP*)condop);
2409 false->op_next = op;
2415 newRANGE(flags, left, right)
2425 Newz(1101, condop, 1, CONDOP);
2427 condop->op_type = OP_RANGE;
2428 condop->op_ppaddr = ppaddr[OP_RANGE];
2429 condop->op_first = left;
2430 condop->op_flags = OPf_KIDS;
2431 condop->op_true = LINKLIST(left);
2432 condop->op_false = LINKLIST(right);
2433 condop->op_private = 1;
2435 left->op_sibling = right;
2437 condop->op_next = (OP*)condop;
2438 flip = newUNOP(OP_FLIP, flags, (OP*)condop);
2439 flop = newUNOP(OP_FLOP, 0, flip);
2440 op = newUNOP(OP_NULL, 0, flop);
2443 left->op_next = flip;
2444 right->op_next = flop;
2446 condop->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
2447 sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV);
2448 flip->op_targ = pad_alloc(OP_RANGE, SVs_PADMY);
2449 sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
2451 flip->op_private = left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
2452 flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
2455 if (!flip->op_private || !flop->op_private)
2456 linklist(op); /* blow off optimizer unless constant */
2462 newLOOPOP(flags, debuggable, expr, block)
2470 int once = block && block->op_flags & OPf_SPECIAL &&
2471 (block->op_type == OP_ENTERSUB || block->op_type == OP_NULL);
2474 if (once && expr->op_type == OP_CONST && !SvTRUE(((SVOP*)expr)->op_sv))
2475 return block; /* do {} while 0 does once */
2476 else if (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)
2477 expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr);
2480 listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
2481 op = newLOGOP(OP_AND, 0, expr, listop);
2483 ((LISTOP*)listop)->op_last->op_next = LINKLIST(op);
2485 if (once && op != listop)
2486 op->op_next = ((LOGOP*)cUNOP->op_first)->op_other;
2489 op = newUNOP(OP_NULL, 0, op); /* or do {} while 1 loses outer block */
2491 op->op_flags |= flags;
2493 op->op_flags |= OPf_SPECIAL; /* suppress POPBLOCK curpm restoration*/
2498 newWHILEOP(flags, debuggable, loop, expr, block, cont)
2512 if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB)) {
2513 expr = newUNOP(OP_DEFINED, 0,
2514 newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), 0, expr) );
2518 block = newOP(OP_NULL, 0);
2521 next = LINKLIST(cont);
2523 cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
2525 listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
2526 redo = LINKLIST(listop);
2529 op = newLOGOP(OP_AND, 0, expr, scalar(listop));
2530 if (op == expr && op->op_type == OP_CONST && !SvTRUE(cSVOP->op_sv)) {
2531 op_free(expr); /* oops, it's a while (0) */
2533 return Nullop; /* (listop already freed by newLOGOP) */
2535 ((LISTOP*)listop)->op_last->op_next = condop =
2536 (op == listop ? redo : LINKLIST(op));
2544 Newz(1101,loop,1,LOOP);
2545 loop->op_type = OP_ENTERLOOP;
2546 loop->op_ppaddr = ppaddr[OP_ENTERLOOP];
2547 loop->op_private = 0;
2548 loop->op_next = (OP*)loop;
2551 op = newBINOP(OP_LEAVELOOP, 0, (OP*)loop, op);
2553 loop->op_redoop = redo;
2554 loop->op_lastop = op;
2557 loop->op_nextop = next;
2559 loop->op_nextop = op;
2561 op->op_flags |= flags;
2566 #ifndef CAN_PROTOTYPE
2567 newFOROP(flags,label,forline,sv,expr,block,cont)
2576 newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
2577 #endif /* CAN_PROTOTYPE */
2584 if (sv->op_type == OP_RV2SV) { /* symbol table variable */
2585 sv->op_type = OP_RV2GV;
2586 sv->op_ppaddr = ppaddr[OP_RV2GV];
2588 else if (sv->op_type == OP_PADSV) { /* private variable */
2589 padoff = sv->op_targ;
2594 croak("Can't use %s for loop variable", op_name[sv->op_type]);
2597 sv = newGVOP(OP_GV, 0, defgv);
2599 loop = (LOOP*)list(convert(OP_ENTERITER, 0,
2600 append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART),
2602 assert(!loop->op_next);
2603 Renew(loop, 1, LOOP);
2604 loop->op_targ = padoff;
2605 return newSTATEOP(0, label, newWHILEOP(flags, 1, loop,
2606 newOP(OP_ITER, 0), block, cont));
2610 newLOOPEX(type, label)
2615 if (type != OP_GOTO || label->op_type == OP_CONST) {
2616 op = newPVOP(type, 0, savepv(
2617 label->op_type == OP_CONST
2618 ? SvPVx(((SVOP*)label)->op_sv, na)
2623 if (label->op_type == OP_ENTERSUB)
2624 label = newUNOP(OP_REFGEN, 0, mod(label, OP_REFGEN));
2625 op = newUNOP(type, OPf_STACKED, label);
2627 hints |= HINT_BLOCK_SCOPE;
2635 if (!CvXSUB(cv) && CvROOT(cv)) {
2637 croak("Can't undef active subroutine");
2643 if (!(SvFLAGS(cv) & SVpcv_CLONED))
2644 op_free(CvROOT(cv));
2645 CvROOT(cv) = Nullop;
2648 SvREFCNT_dec(CvGV(cv));
2650 SvREFCNT_dec(CvOUTSIDE(cv));
2651 CvOUTSIDE(cv) = Nullcv;
2652 if (CvPADLIST(cv)) {
2653 I32 i = AvFILL(CvPADLIST(cv));
2655 SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
2659 SvREFCNT_dec((SV*)CvPADLIST(cv));
2660 CvPADLIST(cv) = Nullav;
2670 AV* protopadlist = CvPADLIST(proto);
2671 AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
2672 AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
2673 SV** svp = AvARRAY(protopad);
2682 cv = compcv = (CV*)NEWSV(1104,0);
2683 sv_upgrade((SV *)cv, SVt_PVCV);
2684 SvFLAGS(cv) |= SVpcv_CLONED;
2686 CvFILEGV(cv) = CvFILEGV(proto);
2687 CvGV(cv) = SvREFCNT_inc(CvGV(proto));
2688 CvSTASH(cv) = CvSTASH(proto);
2689 CvROOT(cv) = CvROOT(proto);
2690 CvSTART(cv) = CvSTART(proto);
2691 if (CvOUTSIDE(proto))
2692 CvOUTSIDE(cv) = (CV*)SvREFCNT_inc((SV*)CvOUTSIDE(proto));
2696 comppadlist = newAV();
2697 AvREAL_off(comppadlist);
2698 av_store(comppadlist, 0, SvREFCNT_inc((SV*)protopad_name));
2699 av_store(comppadlist, 1, (SV*)comppad);
2700 CvPADLIST(cv) = comppadlist;
2701 av_extend(comppad, AvFILL(protopad));
2702 curpad = AvARRAY(comppad);
2704 av = newAV(); /* will be @_ */
2706 av_store(comppad, 0, (SV*)av);
2707 AvFLAGS(av) = AVf_REIFY;
2709 svp = AvARRAY(protopad_name);
2710 for ( ix = AvFILL(protopad); ix > 0; ix--) {
2712 if (svp[ix] != &sv_undef) {
2713 char *name = SvPVX(svp[ix]); /* XXX */
2714 if (SvFLAGS(svp[ix]) & SVf_FAKE) { /* lexical from outside? */
2715 I32 off = pad_findlex(name,ix,curcop->cop_seq, CvOUTSIDE(proto), cxstack_ix);
2717 croak("panic: cv_clone: %s", name);
2719 else { /* our own lexical */
2721 av_store(comppad, ix, sv = (SV*)newAV());
2722 else if (*name == '%')
2723 av_store(comppad, ix, sv = (SV*)newHV());
2725 av_store(comppad, ix, sv = NEWSV(0,0));
2730 av_store(comppad, ix, sv = NEWSV(0,0));
2740 newSUB(floor,op,block)
2746 char *name = op ? SvPVx(cSVOP->op_sv, na) : "__ANON__";
2747 GV *gv = gv_fetchpv(name, GV_ADDMULTI, SVt_PVCV);
2754 if (cv = GvCV(gv)) {
2756 cv = 0; /* just a cached method */
2757 else if (CvROOT(cv) || CvXSUB(cv) || GvFLAGS(gv) & GVf_IMPORTED) {
2758 if (dowarn) { /* already defined (or promised)? */
2759 line_t oldline = curcop->cop_line;
2761 curcop->cop_line = copline;
2762 warn("Subroutine %s redefined",name);
2763 curcop->cop_line = oldline;
2769 if (cv) { /* must reuse cv if autoloaded */
2771 assert(SvREFCNT(CvGV(cv)) > 1);
2772 SvREFCNT_dec(CvGV(cv));
2774 CvOUTSIDE(cv) = CvOUTSIDE(compcv);
2775 CvOUTSIDE(compcv) = 0;
2776 CvPADLIST(cv) = CvPADLIST(compcv);
2777 CvPADLIST(compcv) = 0;
2778 SvREFCNT_dec(compcv);
2785 CvFILEGV(cv) = curcop->cop_filegv;
2786 CvGV(cv) = SvREFCNT_inc(gv);
2787 CvSTASH(cv) = curstash;
2797 av = newAV(); /* Will be @_ */
2799 av_store(comppad, 0, (SV*)av);
2800 AvFLAGS(av) = AVf_REIFY;
2802 for (ix = AvFILL(comppad); ix > 0; ix--) {
2803 if (!SvPADMY(curpad[ix]))
2804 SvPADTMP_on(curpad[ix]);
2807 if (AvFILL(comppad_name) < AvFILL(comppad))
2808 av_store(comppad_name, AvFILL(comppad), Nullsv);
2810 CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
2811 CvSTART(cv) = LINKLIST(CvROOT(cv));
2812 CvROOT(cv)->op_next = 0;
2814 if (s = strrchr(name,':'))
2818 if (strEQ(s, "BEGIN")) {
2819 line_t oldline = compiling.cop_line;
2822 SAVESPTR(compiling.cop_filegv);
2826 av_push(beginav, (SV *)cv);
2827 DEBUG_x( dump_sub(gv) );
2831 rspara = (nrslen == 2);
2838 curcop = &compiling;
2839 curcop->cop_line = oldline; /* might have recursed to yylex */
2842 else if (strEQ(s, "END")) {
2845 av_unshift(endav, 1);
2846 av_store(endav, 0, SvREFCNT_inc(cv));
2848 if (perldb && curstash != debstash) {
2850 SV *tmpstr = sv_newmortal();
2852 sprintf(buf,"%s:%ld",SvPVX(GvSV(curcop->cop_filegv)), (long)subline);
2853 sv = newSVpv(buf,0);
2855 sprintf(buf,"%ld",(long)curcop->cop_line);
2857 gv_efullname(tmpstr,gv);
2858 hv_store(GvHV(DBsub), SvPVX(tmpstr), SvCUR(tmpstr), sv, 0);
2864 GvCV(gv) = 0; /* Will remember in SVOP instead. */
2865 SvFLAGS(cv) |= SVpcv_ANON;
2872 newXSUB(name, ix, subaddr, filename)
2878 CV* cv = newXS(name, (void(*)())subaddr, filename);
2879 CvOLDSTYLE(cv) = TRUE;
2880 CvXSUBANY(cv).any_i32 = ix;
2886 newXS(name, subaddr, filename)
2888 void (*subaddr) _((CV*));
2892 GV *gv = gv_fetchpv((name ? name : "__ANON__"), GV_ADDMULTI, SVt_PVCV);
2897 if (cv = GvCV(gv)) {
2899 cv = 0; /* just a cached method */
2900 else if (CvROOT(cv) || CvXSUB(cv)) { /* already defined? */
2902 line_t oldline = curcop->cop_line;
2904 curcop->cop_line = copline;
2905 warn("Subroutine %s redefined",name);
2906 curcop->cop_line = oldline;
2912 if (cv) { /* must reuse cv if autoloaded */
2913 assert(SvREFCNT(CvGV(cv)) > 1);
2914 SvREFCNT_dec(CvGV(cv));
2917 cv = (CV*)NEWSV(1105,0);
2918 sv_upgrade((SV *)cv, SVt_PVCV);
2921 CvGV(cv) = SvREFCNT_inc(gv);
2923 CvFILEGV(cv) = gv_fetchfile(filename);
2924 CvXSUB(cv) = subaddr;
2927 else if (s = strrchr(name,':'))
2931 if (strEQ(s, "BEGIN")) {
2934 av_push(beginav, SvREFCNT_inc(gv));
2936 else if (strEQ(s, "END")) {
2939 av_unshift(endav, 1);
2940 av_store(endav, 0, SvREFCNT_inc(gv));
2943 GvCV(gv) = 0; /* Will remember elsewhere instead. */
2944 SvFLAGS(cv) |= SVpcv_ANON;
2950 newFORM(floor,op,block)
2962 name = SvPVx(cSVOP->op_sv, na);
2965 gv = gv_fetchpv(name,TRUE, SVt_PVFM);
2967 if (cv = GvFORM(gv)) {
2969 line_t oldline = curcop->cop_line;
2971 curcop->cop_line = copline;
2972 warn("Format %s redefined",name);
2973 curcop->cop_line = oldline;
2979 CvGV(cv) = SvREFCNT_inc(gv);
2980 CvFILEGV(cv) = curcop->cop_filegv;
2982 for (ix = AvFILL(comppad); ix > 0; ix--) {
2983 if (!SvPADMY(curpad[ix]))
2984 SvPADTMP_on(curpad[ix]);
2987 CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
2988 CvSTART(cv) = LINKLIST(CvROOT(cv));
2989 CvROOT(cv)->op_next = 0;
3003 Newz(1101, mop, 1, LOGOP);
3004 mop->op_type = OP_METHOD;
3005 mop->op_ppaddr = ppaddr[OP_METHOD];
3006 mop->op_first = scalar(ref);
3007 mop->op_flags |= OPf_KIDS;
3008 mop->op_private = 1;
3009 mop->op_other = LINKLIST(name);
3010 mop->op_targ = pad_alloc(OP_METHOD, SVs_PADTMP);
3011 mop->op_next = LINKLIST(ref);
3012 ref->op_next = (OP*)mop;
3013 return scalar((OP*)mop);
3020 return newUNOP(OP_REFGEN, 0,
3021 mod(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN));
3028 return newUNOP(OP_REFGEN, 0,
3029 mod(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN));
3033 newANONSUB(floor, block)
3037 return newUNOP(OP_REFGEN, 0,
3038 newSVOP(OP_ANONCODE, 0, (SV*)newSUB(floor, 0, block)));
3045 switch (o->op_type) {
3047 o->op_type = OP_PADAV;
3048 o->op_ppaddr = ppaddr[OP_PADAV];
3049 return ref(newUNOP(OP_RV2AV, 0, scalar(o)), OP_RV2AV);
3052 o->op_type = OP_RV2AV;
3053 o->op_ppaddr = ppaddr[OP_RV2AV];
3058 warn("oops: oopsAV");
3068 switch (o->op_type) {
3071 o->op_type = OP_PADHV;
3072 o->op_ppaddr = ppaddr[OP_PADHV];
3073 return ref(newUNOP(OP_RV2HV, 0, scalar(o)), OP_RV2HV);
3077 o->op_type = OP_RV2HV;
3078 o->op_ppaddr = ppaddr[OP_RV2HV];
3083 warn("oops: oopsHV");
3093 if (o->op_type == OP_PADANY) {
3094 o->op_type = OP_PADAV;
3095 o->op_ppaddr = ppaddr[OP_PADAV];
3098 return newUNOP(OP_RV2AV, 0, scalar(o));
3106 if (type == OP_MAPSTART)
3107 return newUNOP(OP_NULL, 0, o);
3108 return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
3115 if (o->op_type == OP_PADANY) {
3116 o->op_type = OP_PADHV;
3117 o->op_ppaddr = ppaddr[OP_PADHV];
3120 return newUNOP(OP_RV2HV, 0, scalar(o));
3127 croak("NOT IMPL LINE %d",__LINE__);
3136 return newUNOP(OP_RV2CV, 0, scalar(o));
3143 if (o->op_type == OP_PADANY) {
3144 o->op_type = OP_PADSV;
3145 o->op_ppaddr = ppaddr[OP_PADSV];
3148 return newUNOP(OP_RV2SV, 0, scalar(o));
3151 /* Check routines. */
3157 if (cUNOP->op_first->op_type == OP_CONCAT)
3158 op->op_flags |= OPf_STACKED;
3166 if (op->op_flags & OPf_KIDS) {
3169 op = modkids(ck_fun(op), op->op_type);
3170 kid = cUNOP->op_first;
3171 newop = kUNOP->op_first->op_sibling;
3173 (newop->op_sibling ||
3174 !(opargs[newop->op_type] & OA_RETSCALAR) ||
3175 newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
3176 newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
3180 op_free(kUNOP->op_first);
3181 kUNOP->op_first = newop;
3183 op->op_ppaddr = ppaddr[++op->op_type];
3192 if (op->op_flags & OPf_KIDS) {
3193 OP *kid = cUNOP->op_first;
3194 if (kid->op_type != OP_HELEM)
3195 croak("%s argument is not a HASH element", op_name[op->op_type]);
3205 I32 type = op->op_type;
3207 if (op->op_flags & OPf_KIDS) {
3208 if (cLISTOP->op_first->op_type == OP_STUB) {
3210 op = newUNOP(type, OPf_SPECIAL,
3211 newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE, SVt_PVAV)));
3222 hints |= HINT_BLOCK_SCOPE;
3223 if (op->op_flags & OPf_KIDS) {
3224 SVOP *kid = (SVOP*)cUNOP->op_first;
3227 op->op_flags &= ~OPf_KIDS;
3230 else if (kid->op_type == OP_LINESEQ) {
3233 kid->op_next = op->op_next;
3234 cUNOP->op_first = 0;
3237 Newz(1101, enter, 1, LOGOP);
3238 enter->op_type = OP_ENTERTRY;
3239 enter->op_ppaddr = ppaddr[OP_ENTERTRY];
3240 enter->op_private = 0;
3242 /* establish postfix order */
3243 enter->op_next = (OP*)enter;
3245 op = prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
3246 op->op_type = OP_LEAVETRY;
3247 op->op_ppaddr = ppaddr[OP_LEAVETRY];
3248 enter->op_other = op;
3254 op = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3256 op->op_targ = (PADOFFSET)hints;
3265 if (op->op_flags & OPf_STACKED) {
3267 kid = cUNOP->op_first->op_sibling;
3268 if (kid->op_type == OP_RV2GV)
3280 o = fold_constants(o);
3281 if (o->op_type == OP_CONST)
3290 SVOP *kid = (SVOP*)cUNOP->op_first;
3292 op->op_private = (hints & HINT_STRICT_REFS);
3293 if (kid->op_type == OP_CONST) {
3294 int iscv = (op->op_type==OP_RV2CV)*2;
3296 kid->op_type = OP_GV;
3297 for (gv = 0; !gv; iscv++) {
3299 * This is a little tricky. We only want to add the symbol if we
3300 * didn't add it in the lexer. Otherwise we get duplicate strict
3301 * warnings. But if we didn't add it in the lexer, we must at
3302 * least pretend like we wanted to add it even if it existed before,
3303 * or we get possible typo warnings. OPpCONST_ENTERED says
3304 * whether the lexer already added THIS instance of this symbol.
3306 gv = gv_fetchpv(SvPVx(kid->op_sv, na),
3307 iscv | !(kid->op_private & OPpCONST_ENTERED),
3310 : op->op_type == OP_RV2SV
3312 : op->op_type == OP_RV2AV
3314 : op->op_type == OP_RV2HV
3318 SvREFCNT_dec(kid->op_sv);
3319 kid->op_sv = SvREFCNT_inc(gv);
3335 I32 type = op->op_type;
3337 if (op->op_flags & OPf_REF)
3340 if (op->op_flags & OPf_KIDS) {
3341 SVOP *kid = (SVOP*)cUNOP->op_first;
3343 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
3344 OP *newop = newGVOP(type, OPf_REF,
3345 gv_fetchpv(SvPVx(kid->op_sv, na), TRUE, SVt_PVIO));
3352 if (type == OP_FTTTY)
3353 return newGVOP(type, OPf_REF, gv_fetchpv("main'STDIN", TRUE,
3356 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3369 int type = op->op_type;
3370 register I32 oa = opargs[type] >> OASHIFT;
3372 if (op->op_flags & OPf_STACKED) {
3373 if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
3376 return no_fh_allowed(op);
3379 if (op->op_flags & OPf_KIDS) {
3380 tokid = &cLISTOP->op_first;
3381 kid = cLISTOP->op_first;
3382 if (kid->op_type == OP_PUSHMARK ||
3383 kid->op_type == OP_NULL && kid->op_targ == OP_PUSHMARK)
3385 tokid = &kid->op_sibling;
3386 kid = kid->op_sibling;
3388 if (!kid && opargs[type] & OA_DEFGV)
3389 *tokid = kid = newSVREF(newGVOP(OP_GV, 0, defgv));
3393 sibl = kid->op_sibling;
3407 if (kid->op_type == OP_CONST &&
3408 (kid->op_private & OPpCONST_BARE)) {
3409 char *name = SvPVx(((SVOP*)kid)->op_sv, na);
3410 OP *newop = newAVREF(newGVOP(OP_GV, 0,
3411 gv_fetchpv(name, TRUE, SVt_PVAV) ));
3413 warn("Array @%s missing the @ in argument %d of %s()",
3414 name, numargs, op_name[type]);
3417 kid->op_sibling = sibl;
3420 else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV)
3421 bad_type(numargs, "array", op, kid);
3425 if (kid->op_type == OP_CONST &&
3426 (kid->op_private & OPpCONST_BARE)) {
3427 char *name = SvPVx(((SVOP*)kid)->op_sv, na);
3428 OP *newop = newHVREF(newGVOP(OP_GV, 0,
3429 gv_fetchpv(name, TRUE, SVt_PVHV) ));
3431 warn("Hash %%%s missing the %% in argument %d of %s()",
3432 name, numargs, op_name[type]);
3435 kid->op_sibling = sibl;
3438 else if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
3439 bad_type(numargs, "hash", op, kid);
3444 OP *newop = newUNOP(OP_NULL, 0, kid);
3445 kid->op_sibling = 0;
3447 newop->op_next = newop;
3449 kid->op_sibling = sibl;
3454 if (kid->op_type != OP_GV) {
3455 if (kid->op_type == OP_CONST &&
3456 (kid->op_private & OPpCONST_BARE)) {
3457 OP *newop = newGVOP(OP_GV, 0,
3458 gv_fetchpv(SvPVx(((SVOP*)kid)->op_sv, na), TRUE,
3464 kid->op_sibling = 0;
3465 kid = newUNOP(OP_RV2GV, 0, scalar(kid));
3467 kid->op_sibling = sibl;
3473 mod(scalar(kid), type);
3477 tokid = &kid->op_sibling;
3478 kid = kid->op_sibling;
3480 op->op_private = numargs;
3482 return too_many_arguments(op);
3485 else if (opargs[type] & OA_DEFGV) {
3487 return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
3491 while (oa & OA_OPTIONAL)
3493 if (oa && oa != OA_LIST)
3494 return too_few_arguments(op);
3503 GV *gv = newGVgen("main");
3505 append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
3516 OPCODE type = op->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
3518 op->op_ppaddr = ppaddr[OP_GREPSTART];
3519 Newz(1101, gwop, 1, LOGOP);
3521 if (op->op_flags & OPf_STACKED) {
3524 kid = cLISTOP->op_first->op_sibling;
3525 for (k = cLISTOP->op_first->op_sibling->op_next; k; k = k->op_next) {
3528 kid->op_next = (OP*)gwop;
3529 op->op_flags &= ~OPf_STACKED;
3531 kid = cLISTOP->op_first->op_sibling;
3532 if (type == OP_MAPWHILE)
3539 kid = cLISTOP->op_first->op_sibling;
3540 if (kid->op_type != OP_NULL)
3541 croak("panic: ck_grep");
3542 kid = kUNOP->op_first;
3544 gwop->op_type = type;
3545 gwop->op_ppaddr = ppaddr[type];
3546 gwop->op_first = listkids(op);
3547 gwop->op_flags |= OPf_KIDS;
3548 gwop->op_private = 1;
3549 gwop->op_other = LINKLIST(kid);
3550 gwop->op_targ = pad_alloc(type, SVs_PADTMP);
3551 kid->op_next = (OP*)gwop;
3553 kid = cLISTOP->op_first->op_sibling;
3554 if (!kid || !kid->op_sibling)
3555 return too_few_arguments(op);
3556 for (kid = kid->op_sibling; kid; kid = kid->op_sibling)
3557 mod(kid, OP_GREPSTART);
3566 if (op->op_flags & OPf_KIDS) {
3567 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
3568 if (kid && kid->op_type == OP_CONST)
3569 fbm_compile(((SVOP*)kid)->op_sv, 0);
3578 /* XXX length optimization goes here */
3586 return modkids(ck_fun(op), op->op_type);
3593 return refkids(ck_fun(op), op->op_type);
3602 kid = cLISTOP->op_first;
3604 op = force_list(op);
3605 kid = cLISTOP->op_first;
3607 if (kid->op_type == OP_PUSHMARK)
3608 kid = kid->op_sibling;
3609 if (kid && op->op_flags & OPf_STACKED)
3610 kid = kid->op_sibling;
3611 else if (kid && !kid->op_sibling) { /* print HANDLE; */
3612 if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
3613 op->op_flags |= OPf_STACKED; /* make it a filehandle */
3614 kid = newUNOP(OP_RV2GV, OPf_REF, scalar(kid));
3615 cLISTOP->op_first->op_sibling = kid;
3616 cLISTOP->op_last = kid;
3617 kid = kid->op_sibling;
3622 append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3624 return listkids(op);
3631 cPMOP->op_pmflags |= PMf_RUNTIME;
3646 if (cBINOP->op_first->op_flags & OPf_PARENS) {
3647 op->op_private = OPpREPEAT_DOLIST;
3648 cBINOP->op_first = force_list(cBINOP->op_first);
3659 if (op->op_flags & OPf_KIDS) { /* Shall we supply missing .pm? */
3660 SVOP *kid = (SVOP*)cUNOP->op_first;
3662 if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
3664 for (s = SvPVX(kid->op_sv); *s; s++) {
3665 if (*s == ':' && s[1] == ':') {
3667 Move(s+2, s+1, strlen(s+2)+1, char);
3668 --SvCUR(kid->op_sv);
3671 sv_catpvn(kid->op_sv, ".pm", 3);
3681 croak("NOT IMPL LINE %d",__LINE__);
3690 if (op->op_flags & OPf_KIDS) {
3691 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
3692 if (kid && kid->op_sibling) {
3693 op->op_type = OP_SSELECT;
3694 op->op_ppaddr = ppaddr[OP_SSELECT];
3696 return fold_constants(op);
3706 I32 type = op->op_type;
3708 if (!(op->op_flags & OPf_KIDS)) {
3710 return newUNOP(type, 0,
3711 scalar(newUNOP(OP_RV2AV, 0,
3712 scalar(newGVOP(OP_GV, 0,
3713 gv_fetchpv((subline ? "_" : "ARGV"), TRUE, SVt_PVAV) )))));
3715 return scalar(modkids(ck_fun(op), type));
3722 if (op->op_flags & OPf_STACKED) {
3723 OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
3725 kid = kUNOP->op_first; /* get past rv2gv */
3727 if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
3729 if (kid->op_type == OP_SCOPE) {
3733 else if (kid->op_type == OP_LEAVE) {
3734 if (op->op_type == OP_SORT) {
3735 null(kid); /* wipe out leave */
3738 for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
3739 if (k->op_next == kid)
3744 kid->op_next = 0; /* just disconnect the leave */
3745 k = kLISTOP->op_first;
3749 kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
3750 null(kid); /* wipe out rv2gv */
3751 if (op->op_type == OP_SORT)
3755 op->op_flags |= OPf_SPECIAL;
3768 if (op->op_flags & OPf_STACKED)
3769 return no_fh_allowed(op);
3771 kid = cLISTOP->op_first;
3772 if (kid->op_type != OP_NULL)
3773 croak("panic: ck_split");
3774 kid = kid->op_sibling;
3775 op_free(cLISTOP->op_first);
3776 cLISTOP->op_first = kid;
3778 cLISTOP->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
3779 cLISTOP->op_last = kid; /* There was only one element previously */
3782 if (kid->op_type != OP_MATCH) {
3783 OP *sibl = kid->op_sibling;
3784 kid->op_sibling = 0;
3785 kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
3786 if (cLISTOP->op_first == cLISTOP->op_last)
3787 cLISTOP->op_last = kid;
3788 cLISTOP->op_first = kid;
3789 kid->op_sibling = sibl;
3792 if (pm->op_pmshort && !(pm->op_pmflags & PMf_ALL)) {
3793 SvREFCNT_dec(pm->op_pmshort); /* can't use substring to optimize */
3797 kid->op_type = OP_PUSHRE;
3798 kid->op_ppaddr = ppaddr[OP_PUSHRE];
3801 if (!kid->op_sibling)
3802 append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
3804 kid = kid->op_sibling;
3807 if (!kid->op_sibling)
3808 append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0)));
3810 kid = kid->op_sibling;
3813 if (kid->op_sibling)
3814 return too_many_arguments(op);
3823 OP *o = ((cUNOP->op_first->op_sibling)
3824 ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first->op_sibling;
3826 if (o->op_type == OP_RV2CV)
3827 null(o); /* disable rv2cv */
3828 op->op_private = (hints & HINT_STRICT_REFS);
3829 if (perldb && curstash != debstash)
3830 op->op_private |= OPpDEREF_DB;
3831 while (o = o->op_sibling)
3832 mod(o, OP_ENTERSUB);
3840 SvREADONLY_on(cSVOP->op_sv);
3848 if (op->op_flags & OPf_KIDS) {
3849 SVOP *kid = (SVOP*)cUNOP->op_first;
3851 if (kid->op_type == OP_NULL)
3852 kid = (SVOP*)kid->op_sibling;
3854 kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
3855 op->op_flags |= OPf_SPECIAL;
3860 /* A peephole optimizer. We visit the ops in the order they're to execute. */
3866 register OP* oldop = 0;
3867 if (!o || o->op_seq)
3872 for (; o; o = o->op_next) {
3876 switch (o->op_type) {
3879 curcop = ((COP*)o); /* for warnings */
3880 o->op_seq = ++op_seqmax;
3891 if (o->op_next->op_type == OP_STRINGIFY)
3893 o->op_seq = ++op_seqmax;
3896 if ((o->op_flags & (OPf_KNOW|OPf_LIST)) != (OPf_KNOW|OPf_LIST)) {
3897 o->op_seq = ++op_seqmax;
3898 break; /* Scalar stub must produce undef. List stub is noop */
3902 if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
3903 curcop = ((COP*)op);
3909 if (oldop && o->op_next) {
3910 oldop->op_next = o->op_next;
3913 o->op_seq = ++op_seqmax;
3917 if (o->op_next->op_type == OP_RV2SV) {
3918 if (!(o->op_next->op_private & (OPpDEREF_HV|OPpDEREF_AV))) {
3920 o->op_private |= o->op_next->op_private & OPpLVAL_INTRO;
3921 o->op_next = o->op_next->op_next;
3922 o->op_type = OP_GVSV;
3923 o->op_ppaddr = ppaddr[OP_GVSV];
3926 else if (o->op_next->op_type == OP_RV2AV) {
3927 OP* pop = o->op_next->op_next;
3929 if (pop->op_type == OP_CONST &&
3930 (op = pop->op_next) &&
3931 pop->op_next->op_type == OP_AELEM &&
3932 !(pop->op_next->op_private &
3933 (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)) &&
3934 (i = SvIV(((SVOP*)pop)->op_sv) - compiling.cop_arybase)
3938 SvREFCNT_dec(((SVOP*)pop)->op_sv);
3942 o->op_flags |= pop->op_next->op_flags & OPf_MOD;
3943 o->op_next = pop->op_next->op_next;
3944 o->op_type = OP_AELEMFAST;
3945 o->op_ppaddr = ppaddr[OP_AELEMFAST];
3946 o->op_private = (U8)i;
3947 GvAVn((GV*)(((SVOP*)o)->op_sv));
3950 o->op_seq = ++op_seqmax;
3957 o->op_seq = ++op_seqmax;
3958 peep(cLOGOP->op_other);
3962 o->op_seq = ++op_seqmax;
3963 peep(cCONDOP->op_true);
3964 peep(cCONDOP->op_false);
3968 o->op_seq = ++op_seqmax;
3969 peep(cLOOP->op_redoop);
3970 peep(cLOOP->op_nextop);
3971 peep(cLOOP->op_lastop);
3976 o->op_seq = ++op_seqmax;
3977 peep(cPMOP->op_pmreplstart);
3981 o->op_seq = ++op_seqmax;
3982 if (dowarn && o->op_next && o->op_next->op_type == OP_NEXTSTATE) {
3983 if (o->op_next->op_sibling &&
3984 o->op_next->op_sibling->op_type != OP_DIE) {
3985 line_t oldline = curcop->cop_line;
3987 curcop->cop_line = ((COP*)o->op_next)->cop_line;
3988 warn("Statement unlikely to be reached");
3989 warn("(Maybe you meant system() when you said exec()?)\n");
3990 curcop->cop_line = oldline;
3995 o->op_seq = ++op_seqmax;