summaryrefslogtreecommitdiff
path: root/op.c
diff options
context:
space:
mode:
authorLarry Wall <larry@netlabs.com>1993-10-10 00:00:00 +0000
committerLarry Wall <larry@netlabs.com>1993-10-10 00:00:00 +0000
commit93a17b20b6d176db3f04f51a63b0a781e5ffd11c (patch)
tree764149b1d480d5236d4d62b3228bd57f53a71042 /op.c
parent79072805bf63abe5b5978b5928ab00d360ea3e7f (diff)
downloadperl-93a17b20b6d176db3f04f51a63b0a781e5ffd11c.tar.gz
perl 5.0 alpha 3
[editor's note: the sparc executables have not been included, and emacs backup files have been removed]
Diffstat (limited to 'op.c')
-rw-r--r--op.c350
1 files changed, 307 insertions, 43 deletions
diff --git a/op.c b/op.c
index 600d3ddcbd..9c522b1502 100644
--- a/op.c
+++ b/op.c
@@ -32,8 +32,6 @@ extern int yychar;
#define OA_SCALARREF 7
#define OA_OPTIONAL 8
-I32 op_seq;
-
void
cpy7bit(d,s,l)
register char *d;
@@ -124,6 +122,112 @@ OP *op;
/* "register" allocation */
PADOFFSET
+pad_allocmy(name)
+char *name;
+{
+ PADOFFSET off = pad_alloc(OP_PADSV, 'M');
+ SV *sv = NEWSV(0,0);
+ sv_upgrade(sv, SVt_PVNV);
+ sv_setpv(sv, name);
+ av_store(comppadname, off, sv);
+ SvNV(sv) = (double)cop_seq;
+ SvIV(sv) = 99999999;
+ if (*name == '@')
+ av_store(comppad, off, newAV());
+ else if (*name == '%')
+ av_store(comppad, off, newHV(COEFFSIZE));
+ return off;
+}
+
+PADOFFSET
+pad_findmy(name)
+char *name;
+{
+ I32 off;
+ SV *sv;
+ SV **svp = AvARRAY(comppadname);
+ register I32 i;
+ register CONTEXT *cx;
+ bool saweval;
+ AV *curlist;
+ AV *curname;
+ CV *cv;
+ I32 seq = cop_seq;
+
+ for (off = comppadnamefill; off > 0; off--) {
+ if ((sv = svp[off]) &&
+ seq <= SvIV(sv) &&
+ seq > (I32)SvNV(sv) &&
+ strEQ(SvPV(sv), name))
+ {
+ return (PADOFFSET)off;
+ }
+ }
+
+ /* Nothing in current lexical context--try eval's context, if any.
+ * This is necessary to let the perldb get at lexically scoped variables.
+ * XXX This will also probably interact badly with eval tree caching.
+ */
+
+ saweval = FALSE;
+ for (i = cxstack_ix; i >= 0; i--) {
+ cx = &cxstack[i];
+ switch (cx->cx_type) {
+ default:
+ break;
+ case CXt_EVAL:
+ saweval = TRUE;
+ break;
+ case CXt_SUB:
+ if (!saweval)
+ return 0;
+ cv = cx->blk_sub.cv;
+ if (debstash && CvSTASH(cv) == debstash) /* ignore DB'* scope */
+ continue;
+ seq = cxstack[i+1].blk_oldcop->cop_seq;
+ curlist = CvPADLIST(cv);
+ curname = (AV*)*av_fetch(curlist, 0, FALSE);
+ svp = AvARRAY(curname);
+ for (off = AvFILL(curname); off > 0; off--) {
+ if ((sv = svp[off]) &&
+ seq <= SvIV(sv) &&
+ seq > (I32)SvNV(sv) &&
+ strEQ(SvPV(sv), name))
+ {
+ PADOFFSET newoff = pad_alloc(OP_PADSV, 'M');
+ AV *oldpad = (AV*)*av_fetch(curlist, CvDEPTH(cv), FALSE);
+ SV *oldsv = *av_fetch(oldpad, off, TRUE);
+ SV *sv = NEWSV(0,0);
+ sv_upgrade(sv, SVt_PVNV);
+ sv_setpv(sv, name);
+ av_store(comppadname, newoff, sv);
+ SvNV(sv) = (double)curcop->cop_seq;
+ SvIV(sv) = 99999999;
+ av_store(comppad, newoff, sv_ref(oldsv));
+ return newoff;
+ }
+ }
+ return 0;
+ }
+ }
+
+ return 0;
+}
+
+void
+pad_leavemy(fill)
+I32 fill;
+{
+ I32 off;
+ SV **svp = AvARRAY(comppadname);
+ SV *sv;
+ for (off = AvFILL(comppadname); off > fill; off--) {
+ if (sv = svp[off])
+ SvIV(sv) = cop_seq;
+ }
+}
+
+PADOFFSET
pad_alloc(optype,tmptype)
I32 optype;
char tmptype;
@@ -314,6 +418,7 @@ OP *op;
else
scalar(kid);
}
+ curcop = &compiling;
return op;
case OP_LIST:
op = prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), op);
@@ -339,8 +444,14 @@ OP *op;
switch (op->op_type) {
default:
+ if (dowarn && (opargs[op->op_type] & OA_FOLDCONST))
+ warn("Useless use of %s", op_name[op->op_type]);
return op;
+ case OP_NEXTSTATE:
+ curcop = ((COP*)op); /* for warning above */
+ break;
+
case OP_CONST:
op->op_type = OP_NULL; /* don't execute a constant */
sv_free(cSVOP->op_sv); /* don't even remember it */
@@ -442,6 +553,7 @@ OP *op;
else
list(kid);
}
+ curcop = &compiling;
break;
}
return op;
@@ -462,6 +574,7 @@ OP *op;
if (kid->op_sibling)
scalarvoid(kid);
}
+ curcop = &compiling;
}
return op;
}
@@ -496,10 +609,10 @@ I32 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];
+ op->op_type = OP_RV2CV; /* entersubr => rv2cv */
+ op->op_ppaddr = ppaddr[OP_RV2CV];
+ cUNOP->op_first->op_type = OP_NULL; /* disable pushmark */
+ cUNOP->op_first->op_ppaddr = ppaddr[OP_NULL];
break;
}
/* FALL THROUGH */
@@ -521,14 +634,18 @@ I32 type;
case OP_RV2AV:
case OP_RV2HV:
case OP_RV2GV:
- ref(cUNOP->op_first, type ? type : op->op_type);
+ ref(cUNOP->op_first, op->op_type);
/* FALL THROUGH */
case OP_AASSIGN:
case OP_ASLICE:
case OP_HSLICE:
- case OP_CURCOP:
+ case OP_NEXTSTATE:
+ case OP_DBSTATE:
refcount = 10000;
break;
+ case OP_PADSV:
+ case OP_PADAV:
+ case OP_PADHV:
case OP_UNDEF:
case OP_GV:
case OP_RV2SV:
@@ -559,7 +676,8 @@ I32 type;
case OP_AELEM:
case OP_HELEM:
ref(cBINOP->op_first, type ? type : op->op_type);
- op->op_private = type;
+ if (type == OP_RV2AV || type == OP_RV2HV)
+ op->op_private = type;
break;
case OP_LEAVE:
@@ -577,7 +695,7 @@ I32 type;
op->op_flags |= OPf_LVAL;
if (!type) {
op->op_flags &= ~OPf_SPECIAL;
- op->op_flags |= OPf_LOCAL;
+ op->op_flags |= OPf_INTRO;
}
else if (type == OP_AASSIGN || type == OP_SASSIGN)
op->op_flags |= OPf_SPECIAL;
@@ -585,6 +703,35 @@ I32 type;
}
OP *
+my(op)
+OP *op;
+{
+ OP *kid;
+ SV *sv;
+ I32 type;
+
+ if (!op)
+ return op;
+
+ type = op->op_type;
+ if (type == OP_LIST) {
+ for (kid = cLISTOP->op_first; kid; kid = kid->op_sibling)
+ my(kid);
+ }
+ else if (type != OP_PADSV &&
+ type != OP_PADAV &&
+ type != OP_PADHV &&
+ type != OP_PUSHMARK)
+ {
+ sprintf(tokenbuf, "Can't declare %s in my", op_name[op->op_type]);
+ yyerror(tokenbuf);
+ return op;
+ }
+ op->op_flags |= OPf_LVAL|OPf_INTRO;
+ return op;
+}
+
+OP *
sawparens(o)
OP *o;
{
@@ -659,14 +806,19 @@ OP **startp;
}
OP *
-localize(o)
+localize(o, lex)
OP *o;
+I32 lex;
{
if (o->op_flags & OPf_PARENS)
list(o);
else
scalar(o);
- return ref(o, Nullop); /* a bit kludgey */
+ in_my = FALSE;
+ if (lex)
+ return my(o);
+ else
+ return ref(o, OP_NULL); /* a bit kludgey */
}
OP *
@@ -699,7 +851,10 @@ register OP *o;
goto nope;
for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
- if (curop->op_type != OP_CONST && curop->op_type != OP_LIST) {
+ if (curop->op_type != OP_CONST &&
+ curop->op_type != OP_LIST &&
+ curop->op_type != OP_SCALAR &&
+ curop->op_type != OP_PUSHMARK) {
goto nope;
}
}
@@ -956,6 +1111,9 @@ OP* first;
return newBINOP(type, flags, newOP(OP_PUSHMARK, 0), first);
}
+ if (!first)
+ first = newOP(OP_STUB, 0);
+
Newz(1101, unop, 1, UNOP);
unop->op_type = type;
unop->op_ppaddr = ppaddr[type];
@@ -1114,7 +1272,7 @@ OP *repl;
SV *pat = ((SVOP*)expr)->op_sv;
char *p = SvPVn(pat);
if ((op->op_flags & OPf_SPECIAL) && strEQ(p, " ")) {
- sv_setpv(pat, "\\s+", 3);
+ sv_setpvn(pat, "\\s+", 3);
p = SvPVn(pat);
pm->op_pmflags |= PMf_SKIPWHITE;
}
@@ -1153,7 +1311,7 @@ OP *repl;
if (opargs[curop->op_type] & OA_DANGEROUS) {
if (curop->op_type == OP_GV) {
GV *gv = ((GVOP*)curop)->op_gv;
- if (index("&`'123456789+", *GvENAME(gv)))
+ if (strchr("&`'123456789+", *GvENAME(gv)))
break;
}
else if (curop->op_type == OP_RV2CV)
@@ -1285,21 +1443,29 @@ OP *op;
{
char tmpbuf[256];
GV *tmpgv;
- SV *sv = cSVOP->op_sv;
- char *name = SvPVn(sv);
+ SV *sv;
+ char *name;
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);
+ if (op) {
+ sv = cSVOP->op_sv;
+ name = SvPVn(sv);
+ 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);
+ }
+ else {
+ sv_setpv(curstname,"<none>");
+ curstash = Nullhv;
+ }
copline = NOLINE;
expect = XBLOCK;
}
@@ -1341,6 +1507,9 @@ register OP *op;
op->op_type == OP_ASLICE || op->op_type == OP_HSLICE)
return TRUE;
+ if (op->op_type == OP_PADAV || op->op_type == OP_PADHV)
+ return TRUE;
+
if (op->op_type == OP_RV2SV)
return FALSE;
@@ -1383,7 +1552,7 @@ OP *right;
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)) {
+ if (!(left->op_flags & OPf_INTRO)) {
static int generation = 0;
OP *curop;
OP *lastop = op;
@@ -1436,14 +1605,17 @@ OP *op;
{
register COP *cop;
+ comppadnamefill = AvFILL(comppadname); /* introduce my variables */
+
Newz(1101, cop, 1, COP);
- cop->op_type = OP_CURCOP;
- cop->op_ppaddr = ppaddr[OP_CURCOP];
+ cop->op_type = OP_NEXTSTATE;
+ cop->op_ppaddr = ppaddr[ perldb ? OP_DBSTATE : OP_NEXTSTATE ];
cop->op_flags = flags;
cop->op_private = 0;
cop->op_next = (OP*)cop;
cop->cop_label = label;
+ cop->cop_seq = cop_seq++;
if (copline == NOLINE)
cop->cop_line = curcop->cop_line;
@@ -1454,6 +1626,15 @@ OP *op;
cop->cop_filegv = curcop->cop_filegv;
cop->cop_stash = curstash;
+ if (perldb) {
+ SV **svp = av_fetch(GvAV(curcop->cop_filegv),(I32)cop->cop_line, FALSE);
+ if (svp && *svp != &sv_undef && !SvIOK(*svp)) {
+ SvIV(*svp) = 1;
+ SvIOK_on(*svp);
+ SvSTASH(*svp) = (HV*)cop;
+ }
+ }
+
return prepend_elem(OP_LINESEQ, (OP*)cop, op);
}
@@ -1484,6 +1665,8 @@ OP* other;
}
}
if (first->op_type == OP_CONST) {
+ if (dowarn && (first->op_private & OPpCONST_BARE))
+ warn("Probable precedence problem on %s", op_name[type]);
if ((type == OP_AND) == (SvTRUE(((SVOP*)first)->op_sv))) {
op_free(first);
return other;
@@ -1632,7 +1815,12 @@ OP *expr;
OP *block;
{
OP* listop = append_elem(OP_LINESEQ, block, newOP(OP_UNSTACK, 0));
- OP* op = newLOGOP(OP_AND, 0, expr, listop);
+ OP* op;
+
+ if (expr && (expr->op_type == OP_READLINE || expr->op_type == OP_GLOB))
+ expr = newASSIGNOP(0, newSVREF(newGVOP(OP_GV, 0, defgv)), expr);
+
+ 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 {} ? */
@@ -1736,7 +1924,7 @@ OP*cont;
prepend_elem(OP_LIST, newOP(OP_PUSHMARK, 0), expr),
scalar(sv))));
return newSTATEOP(0, label, newWHILEOP(flags, 1,
- loop, newOP(OP_ITER), block, cont));
+ loop, newOP(OP_ITER, 0), block, cont));
}
void
@@ -1776,7 +1964,7 @@ OP *block;
if (CvDEPTH(cv))
CvDELETED(cv) = TRUE; /* probably an autoloader */
else {
- if (dowarn) {
+ if (dowarn && CvROOT(cv)) {
line_t oldline = curcop->cop_line;
curcop->cop_line = copline;
@@ -1793,15 +1981,56 @@ OP *block;
av = newAV();
AvREAL_off(av);
+ if (AvFILL(comppadname) < AvFILL(comppad))
+ av_store(comppadname, AvFILL(comppad), Nullsv);
+ av_store(av, 0, (SV*)comppadname);
av_store(av, 1, (SV*)comppad);
AvFILL(av) = 1;
CvPADLIST(cv) = av;
+ comppadname = newAV();
+ if (!block) {
+ CvROOT(cv) = 0;
+ op_free(op);
+ copline = NOLINE;
+ leave_scope(floor);
+ return;
+ }
CvROOT(cv) = newUNOP(OP_LEAVESUBR, 0, scalarseq(block));
CvSTART(cv) = LINKLIST(CvROOT(cv));
CvROOT(cv)->op_next = 0;
+ CvSTASH(cv) = curstash;
peep(CvSTART(cv));
CvDELETED(cv) = FALSE;
+ if (strEQ(name, "BEGIN")) {
+ line_t oldline = curcop->cop_line;
+ GV* oldfile = curcop->cop_filegv;
+
+ if (!beginav)
+ beginav = newAV();
+ av_push(beginav, sv_ref(gv));
+ DEBUG_x( dump_sub(gv) );
+ rs = nrs;
+ rslen = nrslen;
+ rschar = nrschar;
+ rspara = (nrslen == 2);
+ calllist(beginav);
+ cv_free(cv);
+ rs = "\n";
+ rslen = 1;
+ rschar = '\n';
+ rspara = 0;
+ GvCV(gv) = 0;
+ curcop = &compiling;
+ curcop->cop_line = oldline; /* might have compiled something */
+ curcop->cop_filegv = oldfile; /* recursively, clobbering these */
+ }
+ else if (strEQ(name, "END")) {
+ if (!endav)
+ endav = newAV();
+ av_unshift(endav, 1);
+ av_store(endav, 0, sv_ref(gv));
+ }
if (perldb) {
SV *sv;
SV *tmpstr = sv_mortalcopy(&sv_undef);
@@ -1847,6 +2076,17 @@ char *filename;
CvUSERSUB(cv) = subaddr;
CvUSERINDEX(cv) = ix;
CvDELETED(cv) = FALSE;
+ if (strEQ(name, "BEGIN")) {
+ if (!beginav)
+ beginav = newAV();
+ av_push(beginav, sv_ref(gv));
+ }
+ else if (strEQ(name, "END")) {
+ if (!endav)
+ endav = newAV();
+ av_unshift(endav, 1);
+ av_store(endav, 0, sv_ref(gv));
+ }
}
void
@@ -1919,20 +2159,24 @@ OP *
newANONLIST(op)
OP* op;
{
- return newUNOP(OP_REFGEN, 0, ref(list(convert(OP_ANONLIST, 0, op))));
+ return newUNOP(OP_REFGEN, 0,
+ ref(list(convert(OP_ANONLIST, 0, op)), OP_REFGEN));
}
OP *
newANONHASH(op)
OP* op;
{
- return newUNOP(OP_REFGEN, 0, ref(list(convert(OP_ANONHASH, 0, op))));
+ return newUNOP(OP_REFGEN, 0,
+ ref(list(convert(OP_ANONHASH, 0, op)), OP_REFGEN));
}
OP *
oopsAV(o)
OP *o;
{
+ if (o->op_type == OP_PADAV)
+ return o;
if (o->op_type == OP_RV2SV) {
o->op_type = OP_RV2AV;
o->op_ppaddr = ppaddr[OP_RV2AV];
@@ -1947,6 +2191,8 @@ OP *
oopsHV(o)
OP *o;
{
+ if (o->op_type == OP_PADHV)
+ return o;
if (o->op_type == OP_RV2SV || o->op_type == OP_RV2AV) {
o->op_type = OP_RV2HV;
o->op_ppaddr = ppaddr[OP_RV2HV];
@@ -1961,6 +2207,8 @@ OP *
newAVREF(o)
OP *o;
{
+ if (o->op_type == OP_PADAV)
+ return o;
return newUNOP(OP_RV2AV, 0, scalar(o));
}
@@ -1975,6 +2223,8 @@ OP *
newHVREF(o)
OP *o;
{
+ if (o->op_type == OP_PADHV)
+ return o;
return newUNOP(OP_RV2HV, 0, scalar(o));
}
@@ -1998,6 +2248,8 @@ OP *
newSVREF(o)
OP *o;
{
+ if (o->op_type == OP_PADSV)
+ return o;
return newUNOP(OP_RV2SV, 0, scalar(o));
}
@@ -2063,11 +2315,10 @@ 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
+ if (!kid) {
+ op->op_flags &= ~OPf_KIDS;
+ op->op_type = OP_NULL;
+ op->op_ppaddr = ppaddr[OP_NULL];
}
else if (kid->op_type == OP_LINESEQ) {
LOGOP *enter;
@@ -2306,7 +2557,10 @@ OP *op;
LOGOP *gwop;
OP *kid;
- op->op_flags &= ~OPf_STACKED; /* XXX do we need to scope() it? */
+ if (op->op_flags & OPf_STACKED) {
+ op = ck_sort(op);
+ op->op_flags &= ~OPf_STACKED;
+ }
op = ck_fun(op);
if (error_count)
return op;
@@ -2363,7 +2617,7 @@ OP *op;
kid = cLISTOP->op_first;
if (!kid) {
- prepend_elem(op->op_type, newOP(OP_PUSHMARK), op);
+ prepend_elem(op->op_type, newOP(OP_PUSHMARK, 0), op);
kid = cLISTOP->op_first;
}
if (kid->op_type == OP_PUSHMARK)
@@ -2545,7 +2799,16 @@ OP *
ck_subr(op)
OP *op;
{
+ OP *o = ((cUNOP->op_first->op_sibling)
+ ? cUNOP : ((UNOP*)cUNOP->op_first))->op_first->op_sibling;
+
+ if (o->op_type == OP_RV2CV) {
+ o->op_type = OP_NULL; /* disable rv2cv */
+ o->op_ppaddr = ppaddr[OP_NULL];
+ }
op->op_private = 0;
+ if (perldb)
+ op->op_private |= OPpSUBR_DB;
return op;
}
@@ -2575,6 +2838,7 @@ register OP* op;
switch (op->op_type) {
case OP_NULL:
case OP_SCALAR:
+ case OP_LINESEQ:
if (oldop) {
oldop->op_next = op->op_next;
continue;
@@ -2586,7 +2850,7 @@ register OP* op;
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_flags |= op->op_next->op_flags & OPf_INTRO;
op->op_next = op->op_next->op_next;
op->op_type = OP_GVSV;
op->op_ppaddr = ppaddr[OP_GVSV];