summaryrefslogtreecommitdiff
path: root/op.c
diff options
context:
space:
mode:
Diffstat (limited to 'op.c')
-rw-r--r--op.c2629
1 files changed, 2629 insertions, 0 deletions
diff --git a/op.c b/op.c
new file mode 100644
index 0000000000..600d3ddcbd
--- /dev/null
+++ b/op.c
@@ -0,0 +1,2629 @@
+/* $RCSfile: cmd.h,v $$Revision: 4.1 $$Date: 92/08/07 17:19:19 $
+ *
+ * Copyright (c) 1991, Larry Wall
+ *
+ * You may distribute under the terms of either the GNU General Public
+ * License or the Artistic License, as specified in the README file.
+ *
+ * $Log: cmd.h,v $
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+
+extern int yychar;
+
+/* Lowest byte of opargs */
+#define OA_MARK 1
+#define OA_FOLDCONST 2
+#define OA_RETSCALAR 4
+#define OA_TARGET 8
+#define OA_RETINTEGER 16
+#define OA_OTHERINT 32
+#define OA_DANGEROUS 64
+
+/* Remaining nybbles of opargs */
+#define OA_SCALAR 1
+#define OA_LIST 2
+#define OA_AVREF 3
+#define OA_HVREF 4
+#define OA_CVREF 5
+#define OA_FILEREF 6
+#define OA_SCALARREF 7
+#define OA_OPTIONAL 8
+
+I32 op_seq;
+
+void
+cpy7bit(d,s,l)
+register char *d;
+register char *s;
+register I32 l;
+{
+ while (l--)
+ *d++ = *s++ & 127;
+ *d = '\0';
+}
+
+int
+yyerror(s)
+char *s;
+{
+ char tmpbuf[258];
+ char tmp2buf[258];
+ char *tname = tmpbuf;
+
+ if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
+ oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
+ while (isSPACE(*oldoldbufptr))
+ oldoldbufptr++;
+ cpy7bit(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
+ sprintf(tname,"next 2 tokens \"%s\"",tmp2buf);
+ }
+ else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
+ oldbufptr != bufptr) {
+ while (isSPACE(*oldbufptr))
+ oldbufptr++;
+ cpy7bit(tmp2buf, oldbufptr, bufptr - oldbufptr);
+ sprintf(tname,"next token \"%s\"",tmp2buf);
+ }
+ else if (yychar > 255)
+ tname = "next token ???";
+ else if (!yychar || (yychar == ';' && !rsfp))
+ (void)strcpy(tname,"at EOF");
+ else if ((yychar & 127) == 127)
+ (void)strcpy(tname,"at end of line");
+ else if (yychar < 32)
+ (void)sprintf(tname,"next char ^%c",yychar+64);
+ else
+ (void)sprintf(tname,"next char %c",yychar);
+ (void)sprintf(buf, "%s at %s line %d, %s\n",
+ s,SvPV(GvSV(curcop->cop_filegv)),curcop->cop_line,tname);
+ if (curcop->cop_line == multi_end && multi_start < multi_end)
+ sprintf(buf+strlen(buf),
+ " (Might be a runaway multi-line %c%c string starting on line %d)\n",
+ multi_open,multi_close,multi_start);
+ if (in_eval)
+ sv_catpv(GvSV(gv_fetchpv("@",TRUE)),buf);
+ else
+ fputs(buf,stderr);
+ if (++error_count >= 10)
+ fatal("%s has too many errors.\n",
+ SvPV(GvSV(curcop->cop_filegv)));
+ return 0;
+}
+
+OP *
+no_fh_allowed(op)
+OP *op;
+{
+ sprintf(tokenbuf,"Missing comma after first argument to %s function",
+ op_name[op->op_type]);
+ yyerror(tokenbuf);
+ return op;
+}
+
+OP *
+too_few_arguments(op)
+OP *op;
+{
+ sprintf(tokenbuf,"Not enough arguments for %s", op_name[op->op_type]);
+ yyerror(tokenbuf);
+ return op;
+}
+
+OP *
+too_many_arguments(op)
+OP *op;
+{
+ sprintf(tokenbuf,"Too many arguments for %s", op_name[op->op_type]);
+ yyerror(tokenbuf);
+ return op;
+}
+
+/* "register" allocation */
+
+PADOFFSET
+pad_alloc(optype,tmptype)
+I32 optype;
+char tmptype;
+{
+ SV *sv;
+ I32 retval;
+
+ if (AvARRAY(comppad) != curpad)
+ fatal("panic: pad_alloc");
+ if (tmptype == 'M') {
+ do {
+ sv = *av_fetch(comppad, AvFILL(comppad) + 1, TRUE);
+ } while (SvSTORAGE(sv)); /* need a fresh one */
+ retval = AvFILL(comppad);
+ }
+ else {
+ do {
+ sv = *av_fetch(comppad, ++padix, TRUE);
+ } while (SvSTORAGE(sv) == 'T' || SvSTORAGE(sv) == 'M');
+ retval = padix;
+ }
+ SvSTORAGE(sv) = tmptype;
+ curpad = AvARRAY(comppad);
+ DEBUG_X(fprintf(stderr, "Pad alloc %d for %s\n", retval, op_name[optype]));
+ return (PADOFFSET)retval;
+}
+
+SV *
+pad_sv(po)
+PADOFFSET po;
+{
+ if (!po)
+ fatal("panic: pad_sv po");
+ DEBUG_X(fprintf(stderr, "Pad sv %d\n", po));
+ return curpad[po]; /* eventually we'll turn this into a macro */
+}
+
+void
+pad_free(po)
+PADOFFSET po;
+{
+ if (AvARRAY(comppad) != curpad)
+ fatal("panic: pad_free curpad");
+ if (!po)
+ fatal("panic: pad_free po");
+ DEBUG_X(fprintf(stderr, "Pad free %d\n", po));
+ if (curpad[po])
+ SvSTORAGE(curpad[po]) = 'F';
+ if (po < padix)
+ padix = po - 1;
+}
+
+void
+pad_swipe(po)
+PADOFFSET po;
+{
+ if (AvARRAY(comppad) != curpad)
+ fatal("panic: pad_swipe curpad");
+ if (!po)
+ fatal("panic: pad_swipe po");
+ DEBUG_X(fprintf(stderr, "Pad swipe %d\n", po));
+ curpad[po] = NEWSV(0,0);
+ SvSTORAGE(curpad[po]) = 'F';
+ if (po < padix)
+ padix = po - 1;
+}
+
+void
+pad_reset()
+{
+ register I32 po;
+
+ if (AvARRAY(comppad) != curpad)
+ fatal("panic: pad_reset curpad");
+ DEBUG_X(fprintf(stderr, "Pad reset\n"));
+ for (po = AvMAX(comppad); po > 0; po--) {
+ if (curpad[po] && SvSTORAGE(curpad[po]) == 'T')
+ SvSTORAGE(curpad[po]) = 'F';
+ }
+ padix = 0;
+}
+
+/* Destructor */
+
+void
+op_free(op)
+OP *op;
+{
+ register OP *kid;
+
+ if (!op)
+ return;
+
+ if (op->op_flags & OPf_KIDS) {
+ for (kid = cUNOP->op_first; kid; kid = kid->op_sibling)
+ op_free(kid);
+ }
+
+ if (op->op_targ > 0)
+ pad_free(op->op_targ);
+
+ switch (op->op_type) {
+ case OP_GV:
+/*XXX sv_free(cGVOP->op_gv); */
+ break;
+ case OP_CONST:
+ sv_free(cSVOP->op_sv);
+ break;
+ }
+
+ Safefree(op);
+}
+
+/* Contextualizers */
+
+#define LINKLIST(o) ((o)->op_next ? (o)->op_next : linklist(o))
+
+OP *
+linklist(op)
+OP *op;
+{
+ register OP *kid;
+
+ if (op->op_next)
+ return op->op_next;
+
+ /* establish postfix order */
+ if (cUNOP->op_first) {
+ op->op_next = LINKLIST(cUNOP->op_first);
+ for (kid = cUNOP->op_first; kid; kid = kid->op_sibling) {
+ if (kid->op_sibling)
+ kid->op_next = LINKLIST(kid->op_sibling);
+ else
+ kid->op_next = op;
+ }
+ }
+ else
+ op->op_next = op;
+
+ return op->op_next;
+}
+
+OP *
+scalarkids(op)
+OP *op;
+{
+ OP *kid;
+ if (op && op->op_flags & OPf_KIDS) {
+ for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ scalar(kid);
+ }
+ return op;
+}
+
+OP *
+scalar(op)
+OP *op;
+{
+ OP *kid;
+
+ if (!op || (op->op_flags & OPf_KNOW)) /* assumes no premature commitment */
+ return op;
+
+ op->op_flags &= ~OPf_LIST;
+ op->op_flags |= OPf_KNOW;
+
+ switch (op->op_type) {
+ case OP_REPEAT:
+ scalar(cBINOP->op_first);
+ return op;
+ case OP_OR:
+ case OP_AND:
+ case OP_COND_EXPR:
+ break;
+ default:
+ case OP_MATCH:
+ case OP_SUBST:
+ case OP_NULL:
+ if (!(op->op_flags & OPf_KIDS))
+ return op;
+ break;
+ case OP_LEAVE:
+ case OP_LEAVETRY:
+ case OP_LINESEQ:
+ for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
+ if (kid->op_sibling)
+ scalarvoid(kid);
+ else
+ scalar(kid);
+ }
+ return op;
+ case OP_LIST:
+ op = prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), op);
+ break;
+ }
+ for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+ scalar(kid);
+ return op;
+}
+
+OP *
+scalarvoid(op)
+OP *op;
+{
+ OP *kid;
+
+ if (!op)
+ return op;
+ if (op->op_flags & OPf_LIST)
+ return op;
+
+ op->op_flags |= OPf_KNOW;
+
+ switch (op->op_type) {
+ default:
+ return op;
+
+ case OP_CONST:
+ op->op_type = OP_NULL; /* don't execute a constant */
+ sv_free(cSVOP->op_sv); /* don't even remember it */
+ break;
+
+ case OP_POSTINC:
+ op->op_type = OP_PREINC;
+ op->op_ppaddr = ppaddr[OP_PREINC];
+ break;
+
+ case OP_POSTDEC:
+ op->op_type = OP_PREDEC;
+ op->op_ppaddr = ppaddr[OP_PREDEC];
+ break;
+
+ case OP_REPEAT:
+ scalarvoid(cBINOP->op_first);
+ break;
+ case OP_OR:
+ case OP_AND:
+ case OP_COND_EXPR:
+ for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+ scalarvoid(kid);
+ break;
+ case OP_ENTERTRY:
+ case OP_ENTER:
+ case OP_SCALAR:
+ case OP_NULL:
+ if (!(op->op_flags & OPf_KIDS))
+ break;
+ case OP_LEAVE:
+ case OP_LEAVETRY:
+ case OP_LINESEQ:
+ for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ scalarvoid(kid);
+ break;
+ case OP_LIST:
+ op = prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), op);
+ for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ scalarvoid(kid);
+ break;
+ }
+ return op;
+}
+
+OP *
+listkids(op)
+OP *op;
+{
+ OP *kid;
+ if (op && op->op_flags & OPf_KIDS) {
+ for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ list(kid);
+ }
+ return op;
+}
+
+OP *
+list(op)
+OP *op;
+{
+ OP *kid;
+
+ if (!op || (op->op_flags & OPf_KNOW)) /* assumes no premature commitment */
+ return op;
+
+ op->op_flags |= (OPf_KNOW | OPf_LIST);
+
+ switch (op->op_type) {
+ case OP_FLOP:
+ case OP_REPEAT:
+ list(cBINOP->op_first);
+ break;
+ case OP_OR:
+ case OP_AND:
+ case OP_COND_EXPR:
+ for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+ list(kid);
+ break;
+ default:
+ case OP_MATCH:
+ case OP_SUBST:
+ case OP_NULL:
+ if (!(op->op_flags & OPf_KIDS))
+ break;
+ if (!op->op_next && cUNOP->op_first->op_type == OP_FLOP) {
+ list(cBINOP->op_first);
+ return gen_constant_list(op);
+ }
+ case OP_LIST:
+ listkids(op);
+ break;
+ case OP_LEAVE:
+ case OP_LEAVETRY:
+ case OP_LINESEQ:
+ for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
+ if (kid->op_sibling)
+ scalarvoid(kid);
+ else
+ list(kid);
+ }
+ break;
+ }
+ return op;
+}
+
+OP *
+scalarseq(op)
+OP *op;
+{
+ OP *kid;
+
+ if (op &&
+ (op->op_type == OP_LINESEQ ||
+ op->op_type == OP_LEAVE ||
+ op->op_type == OP_LEAVETRY) )
+ {
+ for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling) {
+ if (kid->op_sibling)
+ scalarvoid(kid);
+ }
+ }
+ return op;
+}
+
+OP *
+refkids(op, type)
+OP *op;
+I32 type;
+{
+ OP *kid;
+ if (op && op->op_flags & OPf_KIDS) {
+ for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ ref(kid, type);
+ }
+ return op;
+}
+
+static I32 refcount;
+
+OP *
+ref(op, type)
+OP *op;
+I32 type;
+{
+ OP *kid;
+ SV *sv;
+
+ if (!op)
+ return op;
+
+ switch (op->op_type) {
+ case OP_ENTERSUBR:
+ if ((type == OP_DEFINED || type == OP_UNDEF || type == OP_REFGEN) &&
+ !(op->op_flags & OPf_STACKED)) {
+ op->op_type = OP_NULL; /* disable entersubr */
+ op->op_ppaddr = ppaddr[OP_NULL];
+ cLISTOP->op_first->op_type = OP_NULL; /* disable pushmark */
+ cLISTOP->op_first->op_ppaddr = ppaddr[OP_NULL];
+ break;
+ }
+ /* FALL THROUGH */
+ default:
+ if (type == OP_DEFINED)
+ return scalar(op); /* ordinary expression, not lvalue */
+ sprintf(tokenbuf, "Can't %s %s in %s",
+ type == OP_REFGEN ? "refer to" : "modify",
+ op_name[op->op_type],
+ type ? op_name[type] : "local");
+ yyerror(tokenbuf);
+ return op;
+
+ case OP_COND_EXPR:
+ for (kid = cUNOP->op_first->op_sibling; kid; kid = kid->op_sibling)
+ ref(kid, type);
+ break;
+
+ case OP_RV2AV:
+ case OP_RV2HV:
+ case OP_RV2GV:
+ ref(cUNOP->op_first, type ? type : op->op_type);
+ /* FALL THROUGH */
+ case OP_AASSIGN:
+ case OP_ASLICE:
+ case OP_HSLICE:
+ case OP_CURCOP:
+ refcount = 10000;
+ break;
+ case OP_UNDEF:
+ case OP_GV:
+ case OP_RV2SV:
+ case OP_AV2ARYLEN:
+ case OP_SASSIGN:
+ case OP_REFGEN:
+ case OP_ANONLIST:
+ case OP_ANONHASH:
+ refcount++;
+ break;
+
+ case OP_PUSHMARK:
+ break;
+
+ case OP_SUBSTR:
+ case OP_VEC:
+ op->op_targ = pad_alloc(op->op_type,'M');
+ sv = PAD_SV(op->op_targ);
+ sv_upgrade(sv, SVt_PVLV);
+ sv_magic(sv, 0, op->op_type == OP_VEC ? 'v' : 'x', 0, 0);
+ curpad[op->op_targ] = sv;
+ /* FALL THROUGH */
+ case OP_NULL:
+ if (!(op->op_flags & OPf_KIDS))
+ fatal("panic: ref");
+ ref(cBINOP->op_first, type ? type : op->op_type);
+ break;
+ case OP_AELEM:
+ case OP_HELEM:
+ ref(cBINOP->op_first, type ? type : op->op_type);
+ op->op_private = type;
+ break;
+
+ case OP_LEAVE:
+ case OP_ENTER:
+ if (type != OP_RV2HV && type != OP_RV2AV)
+ break;
+ if (!(op->op_flags & OPf_KIDS))
+ break;
+ /* FALL THROUGH */
+ case OP_LIST:
+ for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ ref(kid, type);
+ break;
+ }
+ op->op_flags |= OPf_LVAL;
+ if (!type) {
+ op->op_flags &= ~OPf_SPECIAL;
+ op->op_flags |= OPf_LOCAL;
+ }
+ else if (type == OP_AASSIGN || type == OP_SASSIGN)
+ op->op_flags |= OPf_SPECIAL;
+ return op;
+}
+
+OP *
+sawparens(o)
+OP *o;
+{
+ if (o)
+ o->op_flags |= OPf_PARENS;
+ return o;
+}
+
+OP *
+bind_match(type, left, right)
+I32 type;
+OP *left;
+OP *right;
+{
+ OP *op;
+
+ if (right->op_type == OP_MATCH ||
+ right->op_type == OP_SUBST ||
+ right->op_type == OP_TRANS) {
+ right->op_flags |= OPf_STACKED;
+ if (right->op_type != OP_MATCH)
+ left = ref(left, right->op_type);
+ if (right->op_type == OP_TRANS)
+ op = newBINOP(OP_NULL, 0, scalar(left), right);
+ else
+ op = prepend_elem(right->op_type, scalar(left), right);
+ if (type == OP_NOT)
+ return newUNOP(OP_NOT, 0, scalar(op));
+ return op;
+ }
+ else
+ return bind_match(type, left,
+ pmruntime(newPMOP(OP_MATCH, 0), right, Nullop));
+}
+
+OP *
+invert(op)
+OP *op;
+{
+ if (!op)
+ return op;
+ /* XXX need to optimize away NOT NOT here? Or do we let optimizer do it? */
+ return newUNOP(OP_NOT, OPf_SPECIAL, scalar(op));
+}
+
+OP *
+scope(o)
+OP *o;
+{
+ if (o) {
+ o = prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
+ o->op_type = OP_LEAVE;
+ o->op_ppaddr = ppaddr[OP_LEAVE];
+ }
+ return o;
+}
+
+OP *
+block_head(o, startp)
+OP *o;
+OP **startp;
+{
+ if (!o) {
+ *startp = 0;
+ return o;
+ }
+ o = scalarseq(scope(o));
+ *startp = LINKLIST(o);
+ o->op_next = 0;
+ peep(*startp);
+ return o;
+}
+
+OP *
+localize(o)
+OP *o;
+{
+ if (o->op_flags & OPf_PARENS)
+ list(o);
+ else
+ scalar(o);
+ return ref(o, Nullop); /* a bit kludgey */
+}
+
+OP *
+jmaybe(o)
+OP *o;
+{
+ if (o->op_type == OP_LIST) {
+ o = convert(OP_JOIN, 0,
+ prepend_elem(OP_LIST,
+ newSVREF(newGVOP(OP_GV, 0, gv_fetchpv(";", TRUE))),
+ o));
+ }
+ return o;
+}
+
+OP *
+fold_constants(o)
+register OP *o;
+{
+ register OP *curop;
+ I32 type = o->op_type;
+ SV *sv;
+
+ if (opargs[type] & OA_RETSCALAR)
+ scalar(o);
+ if (opargs[type] & OA_TARGET)
+ o->op_targ = pad_alloc(type,'T');
+
+ if (!(opargs[type] & OA_FOLDCONST))
+ goto nope;
+
+ for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
+ if (curop->op_type != OP_CONST && curop->op_type != OP_LIST) {
+ goto nope;
+ }
+ }
+
+ curop = LINKLIST(o);
+ o->op_next = 0;
+ op = curop;
+ run();
+ if (o->op_targ && *stack_sp == PAD_SV(o->op_targ))
+ pad_swipe(o->op_targ);
+ op_free(o);
+ if (type == OP_RV2GV)
+ return newGVOP(OP_GV, 0, *(stack_sp--));
+ else
+ return newSVOP(OP_CONST, 0, *(stack_sp--));
+
+ nope:
+ if (!(opargs[type] & OA_OTHERINT))
+ return o;
+ if (!(o->op_flags & OPf_KIDS))
+ return o;
+
+ for (curop = ((UNOP*)o)->op_first; curop; curop = curop->op_sibling) {
+ if (curop->op_type == OP_CONST) {
+ if (SvIOK(((SVOP*)curop)->op_sv))
+ continue;
+ return o;
+ }
+ if (opargs[curop->op_type] & OA_RETINTEGER)
+ continue;
+ return o;
+ }
+
+ o->op_ppaddr = ppaddr[++(o->op_type)];
+ return o;
+}
+
+OP *
+gen_constant_list(o)
+register OP *o;
+{
+ register OP *curop;
+ OP *anonop;
+ I32 tmpmark;
+ I32 tmpsp;
+ I32 oldtmps_floor = tmps_floor;
+ AV *av;
+ GV *gv;
+
+ tmpmark = stack_sp - stack_base;
+ anonop = newANONLIST(o);
+ curop = LINKLIST(anonop);
+ anonop->op_next = 0;
+ op = curop;
+ run();
+ tmpsp = stack_sp - stack_base;
+ tmps_floor = oldtmps_floor;
+ stack_sp = stack_base + tmpmark;
+
+ o->op_type = OP_RV2AV;
+ o->op_ppaddr = ppaddr[OP_RV2AV];
+ o->op_sibling = 0;
+ curop = ((UNOP*)o)->op_first;
+ ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, newSVsv(stack_sp[1]));
+ op_free(curop);
+ curop = ((UNOP*)anonop)->op_first;
+ curop = ((UNOP*)curop)->op_first;
+ curop->op_sibling = 0;
+ op_free(anonop);
+ o->op_next = 0;
+ linklist(o);
+ return list(o);
+}
+
+OP *
+convert(type, flags, op)
+I32 type;
+I32 flags;
+OP* op;
+{
+ OP *kid;
+ OP *last;
+
+ if (opargs[type] & OA_MARK)
+ op = prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), op);
+
+ if (!op || op->op_type != OP_LIST)
+ op = newLISTOP(OP_LIST, 0, op, Nullop);
+
+ op->op_type = type;
+ op->op_ppaddr = ppaddr[type];
+ op->op_flags |= flags;
+
+ op = (*check[type])(op);
+ if (op->op_type != type)
+ return op;
+
+ if (cLISTOP->op_children < 7) {
+ /* XXX do we really need to do this if we're done appending?? */
+ for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ last = kid;
+ cLISTOP->op_last = last; /* in case check substituted last arg */
+ }
+
+ return fold_constants(op);
+}
+
+/* List constructors */
+
+OP *
+append_elem(type, first, last)
+I32 type;
+OP* first;
+OP* last;
+{
+ if (!first)
+ return last;
+ else if (!last)
+ return first;
+ else if (first->op_type == type) {
+ if (first->op_flags & OPf_KIDS)
+ ((LISTOP*)first)->op_last->op_sibling = last;
+ else {
+ first->op_flags |= OPf_KIDS;
+ ((LISTOP*)first)->op_first = last;
+ }
+ ((LISTOP*)first)->op_last = last;
+ ((LISTOP*)first)->op_children++;
+ return first;
+ }
+
+ return newLISTOP(type, 0, first, last);
+}
+
+OP *
+append_list(type, first, last)
+I32 type;
+LISTOP* first;
+LISTOP* last;
+{
+ if (!first)
+ return (OP*)last;
+ else if (!last)
+ return (OP*)first;
+ else if (first->op_type != type)
+ return prepend_elem(type, (OP*)first, (OP*)last);
+ else if (last->op_type != type)
+ return append_elem(type, (OP*)first, (OP*)last);
+
+ first->op_last->op_sibling = last->op_first;
+ first->op_last = last->op_last;
+ first->op_children += last->op_children;
+ if (first->op_children)
+ last->op_flags |= OPf_KIDS;
+
+ Safefree(last);
+ return (OP*)first;
+}
+
+OP *
+prepend_elem(type, first, last)
+I32 type;
+OP* first;
+OP* last;
+{
+ if (!first)
+ return last;
+ else if (!last)
+ return first;
+ else if (last->op_type == type) {
+ if (!(last->op_flags & OPf_KIDS)) {
+ ((LISTOP*)last)->op_last = first;
+ last->op_flags |= OPf_KIDS;
+ }
+ first->op_sibling = ((LISTOP*)last)->op_first;
+ ((LISTOP*)last)->op_first = first;
+ ((LISTOP*)last)->op_children++;
+ return last;
+ }
+
+ return newLISTOP(type, 0, first, last);
+}
+
+/* Constructors */
+
+OP *
+newNULLLIST()
+{
+ return Nullop;
+}
+
+OP *
+newLISTOP(type, flags, first, last)
+I32 type;
+I32 flags;
+OP* first;
+OP* last;
+{
+ LISTOP *listop;
+
+ Newz(1101, listop, 1, LISTOP);
+
+ listop->op_type = type;
+ listop->op_ppaddr = ppaddr[type];
+ listop->op_children = (first != 0) + (last != 0);
+ listop->op_flags = flags;
+ if (listop->op_children)
+ listop->op_flags |= OPf_KIDS;
+
+ if (!last && first)
+ last = first;
+ else if (!first && last)
+ first = last;
+ listop->op_first = first;
+ listop->op_last = last;
+ if (first && first != last)
+ first->op_sibling = last;
+
+ return (OP*)listop;
+}
+
+OP *
+newOP(type, flags)
+I32 type;
+I32 flags;
+{
+ OP *op;
+ Newz(1101, op, 1, OP);
+ op->op_type = type;
+ op->op_ppaddr = ppaddr[type];
+ op->op_flags = flags;
+
+ op->op_next = op;
+ /* op->op_private = 0; */
+ if (opargs[type] & OA_RETSCALAR)
+ scalar(op);
+ if (opargs[type] & OA_TARGET)
+ op->op_targ = pad_alloc(type,'T');
+ return (*check[type])(op);
+}
+
+OP *
+newUNOP(type, flags, first)
+I32 type;
+I32 flags;
+OP* first;
+{
+ UNOP *unop;
+
+ if (opargs[type] & OA_MARK) {
+ if (first->op_type == OP_LIST)
+ prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), first);
+ else
+ return newBINOP(type, flags, newOP(OP_PUSHMARK, 0), first);
+ }
+
+ Newz(1101, unop, 1, UNOP);
+ unop->op_type = type;
+ unop->op_ppaddr = ppaddr[type];
+ unop->op_first = first;
+ unop->op_flags = flags | OPf_KIDS;
+ unop->op_private = 1;
+
+ unop = (UNOP*)(*check[type])((OP*)unop);
+ if (unop->op_next)
+ return (OP*)unop;
+
+ return fold_constants(unop);
+}
+
+OP *
+newBINOP(type, flags, first, last)
+I32 type;
+I32 flags;
+OP* first;
+OP* last;
+{
+ BINOP *binop;
+ Newz(1101, binop, 1, BINOP);
+
+ if (!first)
+ first = newOP(OP_NULL, 0);
+
+ binop->op_type = type;
+ binop->op_ppaddr = ppaddr[type];
+ binop->op_first = first;
+ binop->op_flags = flags | OPf_KIDS;
+ if (!last) {
+ last = first;
+ binop->op_private = 1;
+ }
+ else {
+ binop->op_private = 2;
+ first->op_sibling = last;
+ }
+
+ binop = (BINOP*)(*check[type])((OP*)binop);
+ if (binop->op_next)
+ return (OP*)binop;
+
+ binop->op_last = last = binop->op_first->op_sibling;
+
+ return fold_constants(binop);
+}
+
+OP *
+pmtrans(op, expr, repl)
+OP *op;
+OP *expr;
+OP *repl;
+{
+ PMOP *pm = (PMOP*)op;
+ SV *tstr = ((SVOP*)expr)->op_sv;
+ SV *rstr = ((SVOP*)repl)->op_sv;
+ register char *t = SvPVn(tstr);
+ register char *r = SvPVn(rstr);
+ I32 tlen = SvCUR(tstr);
+ I32 rlen = SvCUR(rstr);
+ register I32 i;
+ register I32 j;
+ I32 squash;
+ I32 delete;
+ I32 complement;
+ register short *tbl;
+
+ tbl = (short*)cPVOP->op_pv;
+ complement = op->op_private & OPpTRANS_COMPLEMENT;
+ delete = op->op_private & OPpTRANS_DELETE;
+ squash = op->op_private & OPpTRANS_SQUASH;
+
+ if (complement) {
+ Zero(tbl, 256, short);
+ for (i = 0; i < tlen; i++)
+ tbl[t[i] & 0377] = -1;
+ for (i = 0, j = 0; i < 256; i++) {
+ if (!tbl[i]) {
+ if (j >= rlen) {
+ if (delete)
+ tbl[i] = -2;
+ else if (rlen)
+ tbl[i] = r[j-1] & 0377;
+ else
+ tbl[i] = i;
+ }
+ else
+ tbl[i] = r[j++] & 0377;
+ }
+ }
+ }
+ else {
+ if (!rlen && !delete) {
+ r = t; rlen = tlen;
+ }
+ for (i = 0; i < 256; i++)
+ tbl[i] = -1;
+ for (i = 0, j = 0; i < tlen; i++,j++) {
+ if (j >= rlen) {
+ if (delete) {
+ if (tbl[t[i] & 0377] == -1)
+ tbl[t[i] & 0377] = -2;
+ continue;
+ }
+ --j;
+ }
+ if (tbl[t[i] & 0377] == -1)
+ tbl[t[i] & 0377] = r[j] & 0377;
+ }
+ }
+ op_free(expr);
+ op_free(repl);
+
+ return op;
+}
+
+OP *
+newPMOP(type, flags)
+I32 type;
+I32 flags;
+{
+ PMOP *pmop;
+
+ Newz(1101, pmop, 1, PMOP);
+ pmop->op_type = type;
+ pmop->op_ppaddr = ppaddr[type];
+ pmop->op_flags = flags;
+ pmop->op_private = 0;
+
+ /* link into pm list */
+ if (type != OP_TRANS) {
+ pmop->op_pmnext = HvPMROOT(curstash);
+ HvPMROOT(curstash) = pmop;
+ }
+
+ return (OP*)pmop;
+}
+
+OP *
+pmruntime(op, expr, repl)
+OP *op;
+OP *expr;
+OP *repl;
+{
+ PMOP *pm;
+ LOGOP *rcop;
+
+ if (op->op_type == OP_TRANS)
+ return pmtrans(op, expr, repl);
+
+ pm = (PMOP*)op;
+
+ if (expr->op_type == OP_CONST) {
+ SV *pat = ((SVOP*)expr)->op_sv;
+ char *p = SvPVn(pat);
+ if ((op->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
+ sv_setpv(pat, "\\s+", 3);
+ p = SvPVn(pat);
+ pm->op_pmflags |= PMf_SKIPWHITE;
+ }
+ scan_prefix(pm, p, SvCUR(pat));
+ if (pm->op_pmshort && (pm->op_pmflags & PMf_SCANFIRST))
+ fbm_compile(pm->op_pmshort, pm->op_pmflags & PMf_FOLD);
+ pm->op_pmregexp = regcomp(p, p + SvCUR(pat), pm->op_pmflags & PMf_FOLD);
+ hoistmust(pm);
+ op_free(expr);
+ }
+ else {
+ Newz(1101, rcop, 1, LOGOP);
+ rcop->op_type = OP_REGCOMP;
+ rcop->op_ppaddr = ppaddr[OP_REGCOMP];
+ rcop->op_first = scalar(expr);
+ rcop->op_flags |= OPf_KIDS;
+ rcop->op_private = 1;
+ rcop->op_other = op;
+
+ /* establish postfix order */
+ rcop->op_next = LINKLIST(expr);
+ expr->op_next = (OP*)rcop;
+
+ prepend_elem(op->op_type, scalar(rcop), op);
+ }
+
+ if (repl) {
+ if (repl->op_type == OP_CONST) {
+ pm->op_pmflags |= PMf_CONST;
+ prepend_elem(op->op_type, scalar(repl), op);
+ }
+ else {
+ OP *curop;
+ OP *lastop = 0;
+ for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) {
+ if (opargs[curop->op_type] & OA_DANGEROUS) {
+ if (curop->op_type == OP_GV) {
+ GV *gv = ((GVOP*)curop)->op_gv;
+ if (index("&`'123456789+", *GvENAME(gv)))
+ break;
+ }
+ else if (curop->op_type == OP_RV2CV)
+ break;
+ else if (curop->op_type == OP_RV2SV ||
+ curop->op_type == OP_RV2AV ||
+ curop->op_type == OP_RV2HV ||
+ curop->op_type == OP_RV2GV) {
+ if (lastop && lastop->op_type != OP_GV) /*funny deref?*/
+ break;
+ }
+ else
+ break;
+ }
+ lastop = curop;
+ }
+ if (curop == repl) {
+ pm->op_pmflags |= PMf_CONST; /* const for long enough */
+ prepend_elem(op->op_type, scalar(repl), op);
+ }
+ else {
+ Newz(1101, rcop, 1, LOGOP);
+ rcop->op_type = OP_SUBSTCONT;
+ rcop->op_ppaddr = ppaddr[OP_SUBSTCONT];
+ rcop->op_first = scalar(repl);
+ rcop->op_flags |= OPf_KIDS;
+ rcop->op_private = 1;
+ rcop->op_other = op;
+
+ /* establish postfix order */
+ rcop->op_next = LINKLIST(repl);
+ repl->op_next = (OP*)rcop;
+
+ pm->op_pmreplroot = scalar(rcop);
+ pm->op_pmreplstart = LINKLIST(rcop);
+ rcop->op_next = 0;
+ }
+ }
+ }
+
+ return (OP*)pm;
+}
+
+OP *
+newSVOP(type, flags, sv)
+I32 type;
+I32 flags;
+SV *sv;
+{
+ SVOP *svop;
+ Newz(1101, svop, 1, SVOP);
+ svop->op_type = type;
+ svop->op_ppaddr = ppaddr[type];
+ svop->op_sv = sv;
+ svop->op_next = (OP*)svop;
+ svop->op_flags = flags;
+ if (opargs[type] & OA_RETSCALAR)
+ scalar(svop);
+ if (opargs[type] & OA_TARGET)
+ svop->op_targ = pad_alloc(type,'T');
+ return (*check[type])((OP*)svop);
+}
+
+OP *
+newGVOP(type, flags, gv)
+I32 type;
+I32 flags;
+GV *gv;
+{
+ GVOP *gvop;
+ Newz(1101, gvop, 1, GVOP);
+ gvop->op_type = type;
+ gvop->op_ppaddr = ppaddr[type];
+ gvop->op_gv = (GV*)sv_ref(gv);
+ gvop->op_next = (OP*)gvop;
+ gvop->op_flags = flags;
+ if (opargs[type] & OA_RETSCALAR)
+ scalar(gvop);
+ if (opargs[type] & OA_TARGET)
+ gvop->op_targ = pad_alloc(type,'T');
+ return (*check[type])((OP*)gvop);
+}
+
+OP *
+newPVOP(type, flags, pv)
+I32 type;
+I32 flags;
+char *pv;
+{
+ PVOP *pvop;
+ Newz(1101, pvop, 1, PVOP);
+ pvop->op_type = type;
+ pvop->op_ppaddr = ppaddr[type];
+ pvop->op_pv = pv;
+ pvop->op_next = (OP*)pvop;
+ pvop->op_flags = flags;
+ if (opargs[type] & OA_RETSCALAR)
+ scalar(pvop);
+ if (opargs[type] & OA_TARGET)
+ pvop->op_targ = pad_alloc(type,'T');
+ return (*check[type])((OP*)pvop);
+}
+
+OP *
+newCVOP(type, flags, cv, cont)
+I32 type;
+I32 flags;
+CV *cv;
+OP *cont;
+{
+ CVOP *cvop;
+ Newz(1101, cvop, 1, CVOP);
+ cvop->op_type = type;
+ cvop->op_ppaddr = ppaddr[type];
+ cvop->op_cv = cv;
+ cvop->op_cont = cont;
+ cvop->op_next = (OP*)cvop;
+ cvop->op_flags = flags;
+ if (opargs[type] & OA_RETSCALAR)
+ scalar(cvop);
+ if (opargs[type] & OA_TARGET)
+ cvop->op_targ = pad_alloc(type,'T');
+ return (*check[type])((OP*)cvop);
+}
+
+void
+package(op)
+OP *op;
+{
+ char tmpbuf[256];
+ GV *tmpgv;
+ SV *sv = cSVOP->op_sv;
+ char *name = SvPVn(sv);
+
+ save_hptr(&curstash);
+ save_item(curstname);
+ sv_setpv(curstname,name);
+ sprintf(tmpbuf,"'_%s",name);
+ tmpgv = gv_fetchpv(tmpbuf,TRUE);
+ if (!GvHV(tmpgv))
+ GvHV(tmpgv) = newHV(0);
+ curstash = GvHV(tmpgv);
+ if (!HvNAME(curstash))
+ HvNAME(curstash) = savestr(name);
+ HvCOEFFSIZE(curstash) = 0;
+ op_free(op);
+ copline = NOLINE;
+ expect = XBLOCK;
+}
+
+OP *
+newSLICEOP(flags, subscript, listval)
+I32 flags;
+OP *subscript;
+OP *listval;
+{
+ return newBINOP(OP_LSLICE, flags,
+ list(prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), subscript)),
+ list(prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), listval)) );
+}
+
+static I32
+list_assignment(op)
+register OP *op;
+{
+ if (!op)
+ return TRUE;
+
+ if (op->op_type == OP_NULL && op->op_flags & OPf_KIDS)
+ op = cUNOP->op_first;
+
+ if (op->op_type == OP_COND_EXPR) {
+ I32 t = list_assignment(cCONDOP->op_first->op_sibling);
+ I32 f = list_assignment(cCONDOP->op_first->op_sibling->op_sibling);
+
+ if (t && f)
+ return TRUE;
+ if (t || f)
+ yyerror("Assignment to both a list and a scalar");
+ return FALSE;
+ }
+
+ if (op->op_type == OP_LIST || op->op_flags & OPf_PARENS ||
+ op->op_type == OP_RV2AV || op->op_type == OP_RV2HV ||
+ op->op_type == OP_ASLICE || op->op_type == OP_HSLICE)
+ return TRUE;
+
+ if (op->op_type == OP_RV2SV)
+ return FALSE;
+
+ return FALSE;
+}
+
+OP *
+newASSIGNOP(flags, left, right)
+I32 flags;
+OP *left;
+OP *right;
+{
+ OP *op;
+
+ if (list_assignment(left)) {
+ refcount = 0;
+ left = ref(left, OP_AASSIGN);
+ if (right && right->op_type == OP_SPLIT) {
+ if ((op = ((LISTOP*)right)->op_first) && op->op_type == OP_PUSHRE) {
+ PMOP *pm = (PMOP*)op;
+ if (left->op_type == OP_RV2AV) {
+ op = ((UNOP*)left)->op_first;
+ if (op->op_type == OP_GV && !pm->op_pmreplroot) {
+ pm->op_pmreplroot = (OP*)((GVOP*)op)->op_gv;
+ pm->op_pmflags |= PMf_ONCE;
+ op_free(left);
+ return right;
+ }
+ }
+ else {
+ if (refcount < 10000) {
+ SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
+ if (SvIV(sv) == 0)
+ sv_setiv(sv, refcount+1);
+ }
+ }
+ }
+ }
+ op = newBINOP(OP_AASSIGN, flags,
+ list(prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), right)),
+ list(prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), left)) );
+ op->op_private = 0;
+ if (!(left->op_flags & OPf_LOCAL)) {
+ static int generation = 0;
+ OP *curop;
+ OP *lastop = op;
+ generation++;
+ for (curop = LINKLIST(op); curop != op; curop = LINKLIST(curop)) {
+ if (opargs[curop->op_type] & OA_DANGEROUS) {
+ if (curop->op_type == OP_GV) {
+ GV *gv = ((GVOP*)curop)->op_gv;
+ if (gv == defgv || SvCUR(gv) == generation)
+ break;
+ SvCUR(gv) = generation;
+ }
+ else if (curop->op_type == OP_RV2CV)
+ break;
+ else if (curop->op_type == OP_RV2SV ||
+ curop->op_type == OP_RV2AV ||
+ curop->op_type == OP_RV2HV ||
+ curop->op_type == OP_RV2GV) {
+ if (lastop->op_type != OP_GV) /* funny deref? */
+ break;
+ }
+ else
+ break;
+ }
+ lastop = curop;
+ }
+ if (curop != op)
+ op->op_private = OPpASSIGN_COMMON;
+ }
+ op->op_targ = pad_alloc(OP_AASSIGN, 'T'); /* for scalar context */
+ return op;
+ }
+ if (!right)
+ right = newOP(OP_UNDEF, 0);
+ if (right->op_type == OP_READLINE) {
+ right->op_flags |= OPf_STACKED;
+ return newBINOP(OP_NULL, flags, ref(scalar(left), OP_SASSIGN), scalar(right));
+ }
+ else
+ op = newBINOP(OP_SASSIGN, flags,
+ scalar(right), ref(scalar(left), OP_SASSIGN) );
+ return op;
+}
+
+OP *
+newSTATEOP(flags, label, op)
+I32 flags;
+char *label;
+OP *op;
+{
+ register COP *cop;
+
+ Newz(1101, cop, 1, COP);
+ cop->op_type = OP_CURCOP;
+ cop->op_ppaddr = ppaddr[OP_CURCOP];
+ cop->op_flags = flags;
+ cop->op_private = 0;
+ cop->op_next = (OP*)cop;
+
+ cop->cop_label = label;
+
+ if (copline == NOLINE)
+ cop->cop_line = curcop->cop_line;
+ else {
+ cop->cop_line = copline;
+ copline = NOLINE;
+ }
+ cop->cop_filegv = curcop->cop_filegv;
+ cop->cop_stash = curstash;
+
+ return prepend_elem(OP_LINESEQ, (OP*)cop, op);
+}
+
+OP *
+newLOGOP(type, flags, first, other)
+I32 type;
+I32 flags;
+OP* first;
+OP* other;
+{
+ LOGOP *logop;
+ OP *op;
+
+ scalar(first);
+ /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
+ if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) {
+ if (type == OP_AND || type == OP_OR) {
+ if (type == OP_AND)
+ type = OP_OR;
+ else
+ type = OP_AND;
+ op = first;
+ first = cUNOP->op_first;
+ if (op->op_next)
+ first->op_next = op->op_next;
+ cUNOP->op_first = Nullop;
+ op_free(op);
+ }
+ }
+ if (first->op_type == OP_CONST) {
+ if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
+ op_free(first);
+ return other;
+ }
+ else {
+ op_free(other);
+ return first;
+ }
+ }
+ else if (first->op_type == OP_WANTARRAY) {
+ if (type == OP_AND)
+ list(other);
+ else
+ scalar(other);
+ }
+
+ if (!other)
+ return first;
+
+ Newz(1101, logop, 1, LOGOP);
+
+ logop->op_type = type;
+ logop->op_ppaddr = ppaddr[type];
+ logop->op_first = first;
+ logop->op_flags = flags | OPf_KIDS;
+ logop->op_other = LINKLIST(other);
+ logop->op_private = 1;
+
+ /* establish postfix order */
+ logop->op_next = LINKLIST(first);
+ first->op_next = (OP*)logop;
+ first->op_sibling = other;
+
+ op = newUNOP(OP_NULL, 0, (OP*)logop);
+ other->op_next = op;
+
+ return op;
+}
+
+OP *
+newCONDOP(flags, first, true, false)
+I32 flags;
+OP* first;
+OP* true;
+OP* false;
+{
+ CONDOP *condop;
+ OP *op;
+
+ if (!false)
+ return newLOGOP(OP_AND, 0, first, true);
+
+ scalar(first);
+ if (first->op_type == OP_CONST) {
+ if (SvTRUE(((SVOP*)first)->op_sv)) {
+ op_free(first);
+ op_free(false);
+ return true;
+ }
+ else {
+ op_free(first);
+ op_free(true);
+ return false;
+ }
+ }
+ else if (first->op_type == OP_WANTARRAY) {
+ list(true);
+ scalar(false);
+ }
+ Newz(1101, condop, 1, CONDOP);
+
+ condop->op_type = OP_COND_EXPR;
+ condop->op_ppaddr = ppaddr[OP_COND_EXPR];
+ condop->op_first = first;
+ condop->op_flags = flags | OPf_KIDS;
+ condop->op_true = LINKLIST(true);
+ condop->op_false = LINKLIST(false);
+ condop->op_private = 1;
+
+ /* establish postfix order */
+ condop->op_next = LINKLIST(first);
+ first->op_next = (OP*)condop;
+
+ first->op_sibling = true;
+ true->op_sibling = false;
+ op = newUNOP(OP_NULL, 0, (OP*)condop);
+
+ true->op_next = op;
+ false->op_next = op;
+
+ return op;
+}
+
+OP *
+newRANGE(flags, left, right)
+I32 flags;
+OP *left;
+OP *right;
+{
+ CONDOP *condop;
+ OP *flip;
+ OP *flop;
+ OP *op;
+
+ Newz(1101, condop, 1, CONDOP);
+
+ condop->op_type = OP_RANGE;
+ condop->op_ppaddr = ppaddr[OP_RANGE];
+ condop->op_first = left;
+ condop->op_flags = OPf_KIDS;
+ condop->op_true = LINKLIST(left);
+ condop->op_false = LINKLIST(right);
+ condop->op_private = 1;
+
+ left->op_sibling = right;
+
+ condop->op_next = (OP*)condop;
+ flip = newUNOP(OP_FLIP, flags, (OP*)condop);
+ flop = newUNOP(OP_FLOP, 0, flip);
+ op = newUNOP(OP_NULL, 0, flop);
+ linklist(flop);
+
+ left->op_next = flip;
+ right->op_next = flop;
+
+ condop->op_targ = pad_alloc(OP_RANGE, 'M');
+ sv_upgrade(PAD_SV(condop->op_targ), SVt_PVNV);
+ flip->op_targ = pad_alloc(OP_RANGE, 'M');
+ sv_upgrade(PAD_SV(flip->op_targ), SVt_PVNV);
+
+ flip->op_private = left->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
+ flop->op_private = right->op_type == OP_CONST ? OPpFLIP_LINENUM : 0;
+
+ flip->op_next = op;
+ if (!flip->op_private || !flop->op_private)
+ linklist(op); /* blow off optimizer unless constant */
+
+ return op;
+}
+
+OP *
+newLOOPOP(flags, debuggable, expr, block)
+I32 flags;
+I32 debuggable;
+OP *expr;
+OP *block;
+{
+ OP* listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
+ OP* op = newLOGOP(OP_AND, 0, expr, listop);
+ ((LISTOP*)listop)->op_last->op_next = LINKLIST(op);
+
+ if (block->op_flags & OPf_SPECIAL && /* skip conditional on do {} ? */
+ (block->op_type == OP_ENTERSUBR || block->op_type == OP_NULL))
+ op->op_next = ((LOGOP*)cUNOP->op_first)->op_other;
+
+ op->op_flags |= flags;
+ return op;
+}
+
+OP *
+newWHILEOP(flags, debuggable, loop, expr, block, cont)
+I32 flags;
+I32 debuggable;
+LOOP *loop;
+OP *expr;
+OP *block;
+OP *cont;
+{
+ OP *redo;
+ OP *next = 0;
+ OP *listop;
+ OP *op;
+ OP *condop;
+
+ if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB))
+ expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), expr);
+
+ if (!block)
+ block = newOP(OP_NULL, 0);
+
+ if (cont)
+ next = LINKLIST(cont);
+ if (expr)
+ cont = append_elem(OP_LINESEQ, cont, newOP(OP_UNSTACK, 0));
+
+ listop = append_list(OP_LINESEQ, block, cont);
+ redo = LINKLIST(listop);
+
+ if (expr) {
+ op = newLOGOP(OP_AND, 0, expr, scalar(listop));
+ ((LISTOP*)listop)->op_last->op_next = condop =
+ (op == listop ? redo : LINKLIST(op));
+ if (!next)
+ next = condop;
+ }
+ else
+ op = listop;
+
+ if (!loop) {
+ Newz(1101,loop,1,LOOP);
+ loop->op_type = OP_ENTERLOOP;
+ loop->op_ppaddr = ppaddr[OP_ENTERLOOP];
+ loop->op_private = 0;
+ loop->op_next = (OP*)loop;
+ }
+
+ op = newBINOP(OP_LEAVELOOP, 0, loop, op);
+
+ loop->op_redoop = redo;
+ loop->op_lastop = op;
+
+ if (next)
+ loop->op_nextop = next;
+ else
+ loop->op_nextop = op;
+
+ op->op_flags |= flags;
+ return op;
+}
+
+OP *
+newFOROP(flags,label,forline,sv,expr,block,cont)
+I32 flags;
+char *label;
+line_t forline;
+OP* sv;
+OP* expr;
+OP*block;
+OP*cont;
+{
+ LOOP *loop;
+
+ copline = forline;
+ if (sv) {
+ if (sv->op_type == OP_RV2SV) {
+ OP *op = sv;
+ sv = cUNOP->op_first;
+ sv->op_next = sv;
+ cUNOP->op_first = Nullop;
+ op_free(op);
+ }
+ else
+ fatal("Can't use %s for loop variable", op_name[sv->op_type]);
+ }
+ else {
+ sv = newGVOP(OP_GV, 0, defgv);
+ }
+ loop = (LOOP*)list(convert(OP_ENTERITER, 0,
+ append_elem(OP_LIST,
+ prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), expr),
+ scalar(sv))));
+ return newSTATEOP(0, label, newWHILEOP(flags, 1,
+ loop, newOP(OP_ITER), block, cont));
+}
+
+void
+cv_free(cv)
+CV *cv;
+{
+ if (!CvUSERSUB(cv) && CvROOT(cv)) {
+ op_free(CvROOT(cv));
+ CvROOT(cv) = Nullop;
+ if (CvDEPTH(cv))
+ warn("Deleting active subroutine"); /* XXX */
+ if (CvPADLIST(cv)) {
+ I32 i = AvFILL(CvPADLIST(cv));
+ while (i > 0) {
+ SV** svp = av_fetch(CvPADLIST(cv), i--, FALSE);
+ if (svp)
+ av_free(*svp);
+ }
+ av_free(CvPADLIST(cv));
+ }
+ }
+ Safefree(cv);
+}
+
+void
+newSUB(floor,op,block)
+I32 floor;
+OP *op;
+OP *block;
+{
+ register CV *cv;
+ char *name = SvPVnx(cSVOP->op_sv);
+ GV *gv = gv_fetchpv(name,TRUE);
+ AV* av;
+
+ if (cv = GvCV(gv)) {
+ if (CvDEPTH(cv))
+ CvDELETED(cv) = TRUE; /* probably an autoloader */
+ else {
+ if (dowarn) {
+ line_t oldline = curcop->cop_line;
+
+ curcop->cop_line = copline;
+ warn("Subroutine %s redefined",name);
+ curcop->cop_line = oldline;
+ }
+ cv_free(cv);
+ }
+ }
+ Newz(101,cv,1,CV);
+ sv_upgrade(cv, SVt_PVCV);
+ GvCV(gv) = cv;
+ CvFILEGV(cv) = curcop->cop_filegv;
+
+ av = newAV();
+ AvREAL_off(av);
+ av_store(av, 1, (SV*)comppad);
+ AvFILL(av) = 1;
+ CvPADLIST(cv) = av;
+
+ CvROOT(cv) = newUNOP(OP_LEAVESUBR, 0, scalarseq(block));
+ CvSTART(cv) = LINKLIST(CvROOT(cv));
+ CvROOT(cv)->op_next = 0;
+ peep(CvSTART(cv));
+ CvDELETED(cv) = FALSE;
+ if (perldb) {
+ SV *sv;
+ SV *tmpstr = sv_mortalcopy(&sv_undef);
+
+ sprintf(buf,"%s:%ld",SvPV(GvSV(curcop->cop_filegv)), subline);
+ sv = newSVpv(buf,0);
+ sv_catpv(sv,"-");
+ sprintf(buf,"%ld",(long)curcop->cop_line);
+ sv_catpv(sv,buf);
+ gv_efullname(tmpstr,gv);
+ hv_store(GvHV(DBsub), SvPV(tmpstr), SvCUR(tmpstr), sv, 0);
+ }
+ op_free(op);
+ copline = NOLINE;
+ leave_scope(floor);
+}
+
+void
+newUSUB(name, ix, subaddr, filename)
+char *name;
+I32 ix;
+I32 (*subaddr)();
+char *filename;
+{
+ register CV *cv;
+ GV *gv = gv_fetchpv(name,allgvs);
+
+ if (!gv) /* unused function */
+ return;
+ if (cv = GvCV(gv)) {
+ if (dowarn)
+ warn("Subroutine %s redefined",name);
+ if (!CvUSERSUB(cv) && CvROOT(cv)) {
+ op_free(CvROOT(cv));
+ CvROOT(cv) = Nullop;
+ }
+ Safefree(cv);
+ }
+ Newz(101,cv,1,CV);
+ sv_upgrade(cv, SVt_PVCV);
+ GvCV(gv) = cv;
+ CvFILEGV(cv) = gv_fetchfile(filename);
+ CvUSERSUB(cv) = subaddr;
+ CvUSERINDEX(cv) = ix;
+ CvDELETED(cv) = FALSE;
+}
+
+void
+newFORM(floor,op,block)
+I32 floor;
+OP *op;
+OP *block;
+{
+ register CV *cv;
+ char *name;
+ GV *gv;
+ AV* av;
+
+ if (op)
+ name = SvPVnx(cSVOP->op_sv);
+ else
+ name = "STDOUT";
+ gv = gv_fetchpv(name,TRUE);
+ if (cv = GvFORM(gv)) {
+ if (dowarn) {
+ line_t oldline = curcop->cop_line;
+
+ curcop->cop_line = copline;
+ warn("Format %s redefined",name);
+ curcop->cop_line = oldline;
+ }
+ cv_free(cv);
+ }
+ Newz(101,cv,1,CV);
+ sv_upgrade(cv, SVt_PVFM);
+ GvFORM(gv) = cv;
+ CvFILEGV(cv) = curcop->cop_filegv;
+
+ CvPADLIST(cv) = av = newAV();
+ AvREAL_off(av);
+ av_store(av, 1, (SV*)comppad);
+ AvFILL(av) = 1;
+
+ CvROOT(cv) = newUNOP(OP_LEAVEWRITE, 0, scalarseq(block));
+ CvSTART(cv) = LINKLIST(CvROOT(cv));
+ CvROOT(cv)->op_next = 0;
+ peep(CvSTART(cv));
+ CvDELETED(cv) = FALSE;
+ FmLINES(cv) = 0;
+ op_free(op);
+ copline = NOLINE;
+ leave_scope(floor);
+}
+
+OP *
+newMETHOD(ref,name)
+OP *ref;
+OP *name;
+{
+ LOGOP* mop;
+ Newz(1101, mop, 1, LOGOP);
+ mop->op_type = OP_METHOD;
+ mop->op_ppaddr = ppaddr[OP_METHOD];
+ mop->op_first = scalar(ref);
+ mop->op_flags |= OPf_KIDS;
+ mop->op_private = 1;
+ mop->op_other = LINKLIST(name);
+ mop->op_targ = pad_alloc(OP_METHOD,'T');
+ mop->op_next = LINKLIST(ref);
+ ref->op_next = (OP*)mop;
+ return (OP*)mop;
+}
+
+OP *
+newANONLIST(op)
+OP* op;
+{
+ return newUNOP(OP_REFGEN, 0, ref(list(convert(OP_ANONLIST, 0, op))));
+}
+
+OP *
+newANONHASH(op)
+OP* op;
+{
+ return newUNOP(OP_REFGEN, 0, ref(list(convert(OP_ANONHASH, 0, op))));
+}
+
+OP *
+oopsAV(o)
+OP *o;
+{
+ if (o->op_type == OP_RV2SV) {
+ o->op_type = OP_RV2AV;
+ o->op_ppaddr = ppaddr[OP_RV2AV];
+ ref(o, OP_RV2AV);
+ }
+ else
+ warn("oops: oopsAV");
+ return o;
+}
+
+OP *
+oopsHV(o)
+OP *o;
+{
+ if (o->op_type == OP_RV2SV || o->op_type == OP_RV2AV) {
+ o->op_type = OP_RV2HV;
+ o->op_ppaddr = ppaddr[OP_RV2HV];
+ ref(o, OP_RV2HV);
+ }
+ else
+ warn("oops: oopsHV");
+ return o;
+}
+
+OP *
+newAVREF(o)
+OP *o;
+{
+ return newUNOP(OP_RV2AV, 0, scalar(o));
+}
+
+OP *
+newGVREF(o)
+OP *o;
+{
+ return newUNOP(OP_RV2GV, 0, scalar(o));
+}
+
+OP *
+newHVREF(o)
+OP *o;
+{
+ return newUNOP(OP_RV2HV, 0, scalar(o));
+}
+
+OP *
+oopsCV(o)
+OP *o;
+{
+ fatal("NOT IMPL LINE %d",__LINE__);
+ /* STUB */
+ return o;
+}
+
+OP *
+newCVREF(o)
+OP *o;
+{
+ return newUNOP(OP_RV2CV, 0, scalar(o));
+}
+
+OP *
+newSVREF(o)
+OP *o;
+{
+ return newUNOP(OP_RV2SV, 0, scalar(o));
+}
+
+/* Check routines. */
+
+OP *
+ck_aelem(op)
+OP *op;
+{
+ /* XXX need to optimize constant subscript here. */
+ return op;
+}
+
+OP *
+ck_concat(op)
+OP *op;
+{
+ if (cUNOP->op_first->op_type == OP_CONCAT)
+ op->op_flags |= OPf_STACKED;
+ return op;
+}
+
+OP *
+ck_chop(op)
+OP *op;
+{
+ if (op->op_flags & OPf_KIDS) {
+ OP* newop;
+ op = refkids(ck_fun(op), op->op_type);
+ if (op->op_private != 1)
+ return op;
+ newop = cUNOP->op_first->op_sibling;
+ if (!newop || newop->op_type != OP_RV2SV)
+ return op;
+ op_free(cUNOP->op_first);
+ cUNOP->op_first = newop;
+ }
+ op->op_type = OP_SCHOP;
+ op->op_ppaddr = ppaddr[OP_SCHOP];
+ return op;
+}
+
+OP *
+ck_eof(op)
+OP *op;
+{
+ I32 type = op->op_type;
+
+ if (op->op_flags & OPf_KIDS)
+ return ck_fun(op);
+
+ if (op->op_flags & OPf_SPECIAL) {
+ op_free(op);
+ op = newUNOP(type, 0, newGVOP(OP_GV, 0, gv_fetchpv("main'ARGV", TRUE)));
+ }
+ return op;
+}
+
+OP *
+ck_eval(op)
+OP *op;
+{
+ if (op->op_flags & OPf_KIDS) {
+ SVOP *kid = (SVOP*)cUNOP->op_first;
+
+ if (kid->op_type == OP_CONST) {
+#ifdef NOTDEF
+ op->op_type = OP_EVALONCE;
+ op->op_ppaddr = ppaddr[OP_EVALONCE];
+#endif
+ }
+ else if (kid->op_type == OP_LINESEQ) {
+ LOGOP *enter;
+
+ kid->op_next = op->op_next;
+ cUNOP->op_first = 0;
+ op_free(op);
+
+ Newz(1101, enter, 1, LOGOP);
+ enter->op_type = OP_ENTERTRY;
+ enter->op_ppaddr = ppaddr[OP_ENTERTRY];
+ enter->op_private = 0;
+
+ /* establish postfix order */
+ enter->op_next = (OP*)enter;
+
+ op = prepend_elem(OP_LINESEQ, enter, kid);
+ op->op_type = OP_LEAVETRY;
+ op->op_ppaddr = ppaddr[OP_LEAVETRY];
+ enter->op_other = op;
+ return op;
+ }
+ }
+ else {
+ op_free(op);
+ op = newUNOP(OP_ENTEREVAL, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
+ }
+ return op;
+}
+
+OP *
+ck_exec(op)
+OP *op;
+{
+ OP *kid;
+ op = ck_fun(op);
+ if (op->op_flags & OPf_STACKED) {
+ kid = cUNOP->op_first->op_sibling;
+ if (kid->op_type == OP_RV2GV) {
+ kid->op_type = OP_NULL;
+ kid->op_ppaddr = ppaddr[OP_NULL];
+ }
+ }
+ return op;
+}
+
+OP *
+ck_gvconst(o)
+register OP *o;
+{
+ o = fold_constants(o);
+ if (o->op_type == OP_CONST)
+ o->op_type = OP_GV;
+ return o;
+}
+
+OP *
+ck_rvconst(op)
+register OP *op;
+{
+ SVOP *kid = (SVOP*)cUNOP->op_first;
+ if (kid->op_type == OP_CONST) {
+ kid->op_type = OP_GV;
+ kid->op_sv = (SV*)gv_fetchpv(SvPVnx(kid->op_sv),
+ 1+(op->op_type==OP_RV2CV));
+ }
+ return op;
+}
+
+OP *
+ck_formline(op)
+OP *op;
+{
+ return ck_fun(op);
+}
+
+OP *
+ck_ftst(op)
+OP *op;
+{
+ I32 type = op->op_type;
+
+ if (op->op_flags & OPf_SPECIAL)
+ return op;
+
+ if (op->op_flags & OPf_KIDS) {
+ SVOP *kid = (SVOP*)cUNOP->op_first;
+
+ if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
+ OP *newop = newGVOP(type, OPf_SPECIAL,
+ gv_fetchpv(SvPVnx(kid->op_sv), TRUE));
+ op_free(op);
+ return newop;
+ }
+ }
+ else {
+ op_free(op);
+ if (type == OP_FTTTY)
+ return newGVOP(type, OPf_SPECIAL, gv_fetchpv("main'STDIN", TRUE));
+ else
+ return newUNOP(type, 0, newSVREF(newGVOP(OP_GV, 0, defgv)));
+ }
+ return op;
+}
+
+OP *
+ck_fun(op)
+OP *op;
+{
+ register OP *kid;
+ OP **tokid;
+ OP *sibl;
+ I32 numargs = 0;
+ register I32 oa = opargs[op->op_type] >> 8;
+
+ if (op->op_flags & OPf_STACKED) {
+ if ((oa & OA_OPTIONAL) && (oa >> 4) && !((oa >> 4) & OA_OPTIONAL))
+ oa &= ~OA_OPTIONAL;
+ else
+ return no_fh_allowed(op);
+ }
+
+ if (op->op_flags & OPf_KIDS) {
+ tokid = &cLISTOP->op_first;
+ kid = cLISTOP->op_first;
+ if (kid->op_type == OP_PUSHMARK) {
+ tokid = &kid->op_sibling;
+ kid = kid->op_sibling;
+ }
+
+ while (oa && kid) {
+ numargs++;
+ sibl = kid->op_sibling;
+ switch (oa & 7) {
+ case OA_SCALAR:
+ scalar(kid);
+ break;
+ case OA_LIST:
+ if (oa < 16) {
+ kid = 0;
+ continue;
+ }
+ else
+ list(kid);
+ break;
+ case OA_AVREF:
+ if (kid->op_type == OP_CONST &&
+ (kid->op_private & OPpCONST_BARE)) {
+ OP *newop = newAVREF(newGVOP(OP_GV, 0,
+ gv_fetchpv(SvPVnx(((SVOP*)kid)->op_sv), TRUE) ));
+ op_free(kid);
+ kid = newop;
+ kid->op_sibling = sibl;
+ *tokid = kid;
+ }
+ ref(kid, op->op_type);
+ break;
+ case OA_HVREF:
+ if (kid->op_type == OP_CONST &&
+ (kid->op_private & OPpCONST_BARE)) {
+ OP *newop = newHVREF(newGVOP(OP_GV, 0,
+ gv_fetchpv(SvPVnx(((SVOP*)kid)->op_sv), TRUE) ));
+ op_free(kid);
+ kid = newop;
+ kid->op_sibling = sibl;
+ *tokid = kid;
+ }
+ ref(kid, op->op_type);
+ break;
+ case OA_CVREF:
+ {
+ OP *newop = newUNOP(OP_NULL, 0, scalar(kid));
+ kid->op_sibling = 0;
+ linklist(kid);
+ newop->op_next = newop;
+ kid = newop;
+ kid->op_sibling = sibl;
+ *tokid = kid;
+ }
+ break;
+ case OA_FILEREF:
+ if (kid->op_type != OP_GV) {
+ if (kid->op_type == OP_CONST &&
+ (kid->op_private & OPpCONST_BARE)) {
+ OP *newop = newGVOP(OP_GV, 0,
+ gv_fetchpv(SvPVnx(((SVOP*)kid)->op_sv), TRUE) );
+ op_free(kid);
+ kid = newop;
+ }
+ else {
+ kid->op_sibling = 0;
+ kid = newUNOP(OP_RV2GV, 0, scalar(kid));
+ }
+ kid->op_sibling = sibl;
+ *tokid = kid;
+ }
+ scalar(kid);
+ break;
+ case OA_SCALARREF:
+ ref(scalar(kid), op->op_type);
+ break;
+ }
+ oa >>= 4;
+ tokid = &kid->op_sibling;
+ kid = kid->op_sibling;
+ }
+ op->op_private = numargs;
+ if (kid)
+ return too_many_arguments(op);
+ listkids(op);
+ }
+ if (oa) {
+ while (oa & OA_OPTIONAL)
+ oa >>= 4;
+ if (oa && oa != OA_LIST)
+ return too_few_arguments(op);
+ }
+ return op;
+}
+
+OP *
+ck_glob(op)
+OP *op;
+{
+ GV *gv = newGVgen();
+ GvIOn(gv);
+ append_elem(OP_GLOB, op, newGVOP(OP_GV, 0, gv));
+ scalarkids(op);
+ return op;
+}
+
+OP *
+ck_grep(op)
+OP *op;
+{
+ LOGOP *gwop;
+ OP *kid;
+
+ op->op_flags &= ~OPf_STACKED; /* XXX do we need to scope() it? */
+ op = ck_fun(op);
+ if (error_count)
+ return op;
+ kid = cLISTOP->op_first->op_sibling;
+ if (kid->op_type != OP_NULL)
+ fatal("panic: ck_grep");
+ kid = kUNOP->op_first;
+
+ Newz(1101, gwop, 1, LOGOP);
+ gwop->op_type = OP_GREPWHILE;
+ gwop->op_ppaddr = ppaddr[OP_GREPWHILE];
+ gwop->op_first = list(op);
+ gwop->op_flags |= OPf_KIDS;
+ gwop->op_private = 1;
+ gwop->op_other = LINKLIST(kid);
+ gwop->op_targ = pad_alloc(OP_GREPWHILE,'T');
+ kid->op_next = (OP*)gwop;
+
+ return (OP*)gwop;
+}
+
+OP *
+ck_index(op)
+OP *op;
+{
+ if (op->op_flags & OPf_KIDS) {
+ OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
+ if (kid && kid->op_type == OP_CONST)
+ fbm_compile(((SVOP*)kid)->op_sv, 0);
+ }
+ return ck_fun(op);
+}
+
+OP *
+ck_lengthconst(op)
+OP *op;
+{
+ /* XXX length optimization goes here */
+ return op;
+}
+
+OP *
+ck_lfun(op)
+OP *op;
+{
+ return refkids(ck_fun(op), op->op_type);
+}
+
+OP *
+ck_listiob(op)
+OP *op;
+{
+ register OP *kid;
+
+ kid = cLISTOP->op_first;
+ if (!kid) {
+ prepend_elem(op->op_type, newOP(OP_PUSHMARK), op);
+ kid = cLISTOP->op_first;
+ }
+ if (kid->op_type == OP_PUSHMARK)
+ kid = kid->op_sibling;
+ if (kid && op->op_flags & OPf_STACKED)
+ kid = kid->op_sibling;
+ else if (kid && !kid->op_sibling) { /* print HANDLE; */
+ if (kid->op_type == OP_CONST && kid->op_private & OPpCONST_BARE) {
+ op->op_flags |= OPf_STACKED; /* make it a filehandle */
+ kid = newUNOP(OP_RV2GV, 0, scalar(kid));
+ cLISTOP->op_first->op_sibling = kid;
+ cLISTOP->op_last = kid;
+ kid = kid->op_sibling;
+ }
+ }
+
+ if (!kid)
+ append_elem(op->op_type, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
+
+ return listkids(op);
+}
+
+OP *
+ck_match(op)
+OP *op;
+{
+ cPMOP->op_pmflags |= PMf_RUNTIME;
+ return op;
+}
+
+OP *
+ck_null(op)
+OP *op;
+{
+ return op;
+}
+
+OP *
+ck_repeat(op)
+OP *op;
+{
+ if (cBINOP->op_first->op_flags & OPf_PARENS) {
+ op->op_private = OPpREPEAT_DOLIST;
+ cBINOP->op_first =
+ prepend_elem(OP_NULL, newOP(OP_PUSHMARK, 0), cBINOP->op_first);
+ }
+ else
+ scalar(op);
+ return op;
+}
+
+OP *
+ck_retarget(op)
+OP *op;
+{
+ fatal("NOT IMPL LINE %d",__LINE__);
+ /* STUB */
+ return op;
+}
+
+OP *
+ck_select(op)
+OP *op;
+{
+ if (op->op_flags & OPf_KIDS) {
+ OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
+ if (kid) {
+ op->op_type = OP_SSELECT;
+ op->op_ppaddr = ppaddr[OP_SSELECT];
+ op = ck_fun(op);
+ return fold_constants(op);
+ }
+ }
+ return ck_fun(op);
+}
+
+OP *
+ck_shift(op)
+OP *op;
+{
+ I32 type = op->op_type;
+
+ if (!(op->op_flags & OPf_KIDS)) {
+ op_free(op);
+ return newUNOP(type, 0,
+ scalar(newUNOP(OP_RV2AV, 0,
+ scalar(newGVOP(OP_GV, 0,
+ gv_fetchpv((subline ? "_" : "ARGV"), TRUE) )))));
+ }
+ return scalar(refkids(ck_fun(op), type));
+}
+
+OP *
+ck_sort(op)
+OP *op;
+{
+ if (op->op_flags & OPf_STACKED) {
+ OP *kid = cLISTOP->op_first->op_sibling; /* get past pushmark */
+ kid = kUNOP->op_first; /* get past sv2gv */
+ if (kid->op_type == OP_LEAVE) {
+ OP *k;
+
+ linklist(kid);
+ kid->op_type = OP_NULL; /* wipe out leave */
+ kid->op_ppaddr = ppaddr[OP_NULL];
+ kid->op_next = kid;
+
+ for (k = kLISTOP->op_first->op_next; k; k = k->op_next) {
+ if (k->op_next == kid)
+ k->op_next = 0;
+ }
+ kid->op_type = OP_NULL; /* wipe out enter */
+ kid->op_ppaddr = ppaddr[OP_NULL];
+
+ kid = cLISTOP->op_first->op_sibling;
+ kid->op_type = OP_NULL; /* wipe out sv2gv */
+ kid->op_ppaddr = ppaddr[OP_NULL];
+ kid->op_next = kid;
+
+ op->op_flags |= OPf_SPECIAL;
+ }
+ }
+ return op;
+}
+
+OP *
+ck_split(op)
+OP *op;
+{
+ register OP *kid;
+
+ if (op->op_flags & OPf_STACKED)
+ return no_fh_allowed(op);
+
+ if (!(op->op_flags & OPf_KIDS))
+ op = prepend_elem(OP_SPLIT,
+ pmruntime(
+ newPMOP(OP_MATCH, OPf_SPECIAL),
+ newSVOP(OP_CONST, 0, newSVpv(" ", 1)),
+ Nullop),
+ op);
+
+ kid = cLISTOP->op_first;
+ if (kid->op_type == OP_PUSHMARK)
+ fatal("panic: ck_split");
+
+ if (kid->op_type != OP_MATCH) {
+ OP *sibl = kid->op_sibling;
+ kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, Nullop);
+ if (cLISTOP->op_first == cLISTOP->op_last)
+ cLISTOP->op_last = kid;
+ cLISTOP->op_first = kid;
+ kid->op_sibling = sibl;
+ }
+
+ kid->op_type = OP_PUSHRE;
+ kid->op_ppaddr = ppaddr[OP_PUSHRE];
+ scalar(kid);
+
+ if (!kid->op_sibling)
+ append_elem(OP_SPLIT, op, newSVREF(newGVOP(OP_GV, 0, defgv)) );
+
+ kid = kid->op_sibling;
+ scalar(kid);
+
+ if (!kid->op_sibling)
+ append_elem(OP_SPLIT, op, newSVOP(OP_CONST, 0, newSViv(0)));
+
+ kid = kid->op_sibling;
+ scalar(kid);
+
+ if (kid->op_sibling)
+ return too_many_arguments(op);
+
+ return op;
+}
+
+OP *
+ck_subr(op)
+OP *op;
+{
+ op->op_private = 0;
+ return op;
+}
+
+OP *
+ck_trunc(op)
+OP *op;
+{
+ if (op->op_flags & OPf_KIDS) {
+ SVOP *kid = (SVOP*)cUNOP->op_first;
+
+ if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE))
+ op->op_flags |= OPf_SPECIAL;
+ }
+ return ck_fun(op);
+}
+
+void
+peep(op)
+register OP* op;
+{
+ register OP* oldop = 0;
+ if (!op || op->op_seq)
+ return;
+ for (; op; op = op->op_next) {
+ if (op->op_seq)
+ return;
+ switch (op->op_type) {
+ case OP_NULL:
+ case OP_SCALAR:
+ if (oldop) {
+ oldop->op_next = op->op_next;
+ continue;
+ }
+ op->op_seq = ++op_seq;
+ break;
+
+ case OP_GV:
+ if (op->op_next->op_type == OP_RV2SV) {
+ op->op_next->op_type = OP_NULL;
+ op->op_next->op_ppaddr = ppaddr[OP_NULL];
+ op->op_flags |= op->op_next->op_flags & OPf_LOCAL;
+ op->op_next = op->op_next->op_next;
+ op->op_type = OP_GVSV;
+ op->op_ppaddr = ppaddr[OP_GVSV];
+ }
+ op->op_seq = ++op_seq;
+ break;
+
+ case OP_GREPWHILE:
+ case OP_AND:
+ case OP_OR:
+ op->op_seq = ++op_seq;
+ peep(cLOGOP->op_other);
+ break;
+
+ case OP_COND_EXPR:
+ op->op_seq = ++op_seq;
+ peep(cCONDOP->op_true);
+ peep(cCONDOP->op_false);
+ break;
+
+ case OP_ENTERLOOP:
+ op->op_seq = ++op_seq;
+ peep(cLOOP->op_redoop);
+ peep(cLOOP->op_nextop);
+ peep(cLOOP->op_lastop);
+ break;
+
+ case OP_MATCH:
+ case OP_SUBST:
+ op->op_seq = ++op_seq;
+ peep(cPMOP->op_pmreplroot);
+ break;
+
+ default:
+ op->op_seq = ++op_seq;
+ break;
+ }
+ oldop = op;
+ }
+}
View Lorry Controller Status