/* op.c
*
- * Copyright (c) 1991-1997, Larry Wall
+ * Copyright (c) 1991-1999, 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.
#define CHECKCALL this->*PL_check
#else
#define CHECKCALL *PL_check
+#endif
+
+/* #define PL_OP_SLAB_ALLOC */
+
+#ifdef PL_OP_SLAB_ALLOC
+#define SLAB_SIZE 8192
+static char *PL_OpPtr = NULL;
+static int PL_OpSpace = 0;
+#define NewOp(m,var,c,type) do { if ((PL_OpSpace -= c*sizeof(type)) >= 0) \
+ var = (type *)(PL_OpPtr -= c*sizeof(type)); \
+ else \
+ var = (type *) Slab_Alloc(m,c*sizeof(type)); \
+ } while (0)
+
+static void *
+Slab_Alloc(int m, size_t sz)
+{
+ Newz(m,PL_OpPtr,SLAB_SIZE,char);
+ PL_OpSpace = SLAB_SIZE - sz;
+ return PL_OpPtr += PL_OpSpace;
+}
+
+#else
+#define NewOp(m, var, c, type) Newz(m, var, c, type)
#endif
-
/*
* In the following definition, the ", Nullop" is just to make the compiler
* think the expression is of the right type: croak actually does a Siglongjmp.
static void bad_type _((I32 n, char *t, char *name, OP *kid));
static OP *modkids _((OP *o, I32 type));
static OP *no_fh_allowed _((OP *o));
+static void no_bareword_allowed _((OP *o));
static OP *scalarboolean _((OP *o));
static OP *too_few_arguments _((OP *o, char* name));
static OP *too_many_arguments _((OP *o, char* name));
(int)n, name, t, PL_op_desc[kid->op_type]));
}
+STATIC void
+no_bareword_allowed(OP *o)
+{
+ warn("Bareword \"%s\" not allowed while \"strict subs\" in use",
+ SvPV_nolen(cSVOPo->op_sv));
+ ++PL_error_count;
+}
+
void
assertref(OP *o)
{
SV *msg = sv_2mortal(
newSVpvf("(Did you mean $ or @ instead of %c?)\n",
type == OP_ENTERSUB ? '&' : '%'));
- if (PL_in_eval & 2)
+ if (PL_in_eval & EVAL_WARNONLY)
warn("%_", msg);
else if (PL_in_eval)
sv_catsv(GvSV(PL_errgv), msg);
if (o->op_targ > 0)
pad_free(o->op_targ);
+#ifdef PL_OP_SLAB_ALLOC
+ if ((char *) o == PL_OpPtr)
+ {
+ }
+#else
Safefree(o);
+#endif
}
STATIC void
OP *kid;
char* useless = 0;
SV* sv;
+ U8 want;
+
+ if (o->op_type == OP_NEXTSTATE || o->op_type == OP_DBSTATE ||
+ (o->op_type == OP_NULL &&
+ (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)))
+ {
+ dTHR;
+ PL_curcop = (COP*)o; /* for warning below */
+ }
/* assumes no premature commitment */
- U8 want = o->op_flags & OPf_WANT;
- if (!o || (want && want != OPf_WANT_SCALAR) || PL_error_count
+ want = o->op_flags & OPf_WANT;
+ if ((want && want != OPf_WANT_SCALAR) || PL_error_count
|| o->op_type == OP_RETURN)
return o;
useless = "a variable";
break;
- case OP_NEXTSTATE:
- case OP_DBSTATE:
- WITH_THR(PL_curcop = ((COP*)o)); /* for warning below */
- break;
-
case OP_CONST:
sv = cSVOPo->op_sv;
- {
+ if (cSVOPo->op_private & OPpCONST_STRICT)
+ no_bareword_allowed(o);
+ else {
dTHR;
if (ckWARN(WARN_VOID)) {
useless = "a constant";
break;
case OP_NULL:
- if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
- WITH_THR(PL_curcop = ((COP*)o)); /* for warning below */
if (o->op_flags & OPf_STACKED)
break;
/* FALL THROUGH */
+ case OP_NEXTSTATE:
+ case OP_DBSTATE:
case OP_ENTERTRY:
case OP_ENTER:
case OP_SCALAR:
{
dTHR;
if (PL_in_eval) {
- PL_eval_root = newUNOP(OP_LEAVEEVAL, ((PL_in_eval & 4) ? OPf_SPECIAL : 0), o);
+ if (PL_eval_root)
+ return;
+ PL_eval_root = newUNOP(OP_LEAVEEVAL,
+ ((PL_in_eval & EVAL_KEEPERR)
+ ? OPf_SPECIAL : 0), o);
PL_eval_start = linklist(PL_eval_root);
PL_eval_root->op_next = 0;
peep(PL_eval_start);
goto nope;
switch (type) {
+ case OP_NEGATE:
+ /* XXX might want a ck_negate() for this */
+ cUNOPo->op_first->op_private &= ~OPpCONST_STRICT;
+ break;
case OP_SPRINTF:
case OP_UCFIRST:
case OP_LCFIRST:
for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
if (curop->op_type != OP_CONST &&
- curop->op_type != OP_LIST &&
- curop->op_type != OP_SCALAR &&
- curop->op_type != OP_NULL &&
- curop->op_type != OP_PUSHMARK) {
+ curop->op_type != OP_LIST &&
+ curop->op_type != OP_SCALAR &&
+ curop->op_type != OP_NULL &&
+ curop->op_type != OP_PUSHMARK)
+ {
goto nope;
}
}
first->op_children += last->op_children;
if (first->op_children)
first->op_flags |= OPf_KIDS;
-
- Safefree(last);
+
+#ifdef PL_OP_SLAB_ALLOC
+#else
+ Safefree(last);
+#endif
return (OP*)first;
}
{
LISTOP *listop;
- Newz(1101, listop, 1, LISTOP);
+ NewOp(1101, listop, 1, LISTOP);
listop->op_type = type;
listop->op_ppaddr = PL_ppaddr[type];
newOP(I32 type, I32 flags)
{
OP *o;
- Newz(1101, o, 1, OP);
+ NewOp(1101, o, 1, OP);
o->op_type = type;
o->op_ppaddr = PL_ppaddr[type];
o->op_flags = flags;
if (PL_opargs[type] & OA_MARK)
first = force_list(first);
- Newz(1101, unop, 1, UNOP);
+ NewOp(1101, unop, 1, UNOP);
unop->op_type = type;
unop->op_ppaddr = PL_ppaddr[type];
unop->op_first = first;
newBINOP(I32 type, I32 flags, OP *first, OP *last)
{
BINOP *binop;
- Newz(1101, binop, 1, BINOP);
+ NewOp(1101, binop, 1, BINOP);
if (!first)
first = newOP(OP_NULL, 0);
squash = o->op_private & OPpTRANS_SQUASH;
if (o->op_private & (OPpTRANS_FROM_UTF|OPpTRANS_TO_UTF)) {
- SV* listsv = newSVpv("# comment\n",0);
+ SV* listsv = newSVpvn("# comment\n",10);
SV* transv = 0;
U8* tend = t + tlen;
U8* rend = r + rlen;
UV nextmin = 0;
New(1109, cp, tlen, U8*);
i = 0;
- transv = newSVpv("",0);
+ transv = newSVpvn("",0);
while (t < tend) {
cp[i++] = t;
t += UTF8SKIP(t);
dTHR;
PMOP *pmop;
- Newz(1101, pmop, 1, PMOP);
+ NewOp(1101, pmop, 1, PMOP);
pmop->op_type = type;
pmop->op_ppaddr = PL_ppaddr[type];
pmop->op_flags = flags;
? OP_REGCRESET
: OP_REGCMAYBE),0,expr);
- Newz(1101, rcop, 1, LOGOP);
+ NewOp(1101, rcop, 1, LOGOP);
rcop->op_type = OP_REGCOMP;
rcop->op_ppaddr = PL_ppaddr[OP_REGCOMP];
rcop->op_first = scalar(expr);
pm->op_pmflags |= PMf_MAYBE_CONST;
pm->op_pmpermflags |= PMf_MAYBE_CONST;
}
- Newz(1101, rcop, 1, LOGOP);
+ NewOp(1101, rcop, 1, LOGOP);
rcop->op_type = OP_SUBSTCONT;
rcop->op_ppaddr = PL_ppaddr[OP_SUBSTCONT];
rcop->op_first = scalar(repl);
newSVOP(I32 type, I32 flags, SV *sv)
{
SVOP *svop;
- Newz(1101, svop, 1, SVOP);
+ NewOp(1101, svop, 1, SVOP);
svop->op_type = type;
svop->op_ppaddr = PL_ppaddr[type];
svop->op_sv = sv;
{
dTHR;
GVOP *gvop;
- Newz(1101, gvop, 1, GVOP);
+ NewOp(1101, gvop, 1, GVOP);
gvop->op_type = type;
gvop->op_ppaddr = PL_ppaddr[type];
gvop->op_gv = (GV*)SvREFCNT_inc(gv);
newPVOP(I32 type, I32 flags, char *pv)
{
PVOP *pvop;
- Newz(1101, pvop, 1, PVOP);
+ NewOp(1101, pvop, 1, PVOP);
pvop->op_type = type;
pvop->op_ppaddr = PL_ppaddr[type];
pvop->op_pv = pv;
pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
/* Fake up a method call to VERSION */
- meth = newSVOP(OP_CONST, 0, newSVpv("VERSION", 7));
+ meth = newSVOP(OP_CONST, 0, newSVpvn("VERSION", 7));
veop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
append_elem(OP_LIST,
prepend_elem(OP_LIST, pack, list(version)),
pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)id)->op_sv));
meth = newSVOP(OP_CONST, 0,
aver
- ? newSVpv("import", 6)
- : newSVpv("unimport", 8)
+ ? newSVpvn("import", 6)
+ : newSVpvn("unimport", 8)
);
imop = convert(OP_ENTERSUB, OPf_STACKED|OPf_SPECIAL,
append_elem(OP_LIST,
/* Fake up the BEGIN {}, which does its thing immediately. */
newSUB(floor,
- newSVOP(OP_CONST, 0, newSVpv("BEGIN", 5)),
+ newSVOP(OP_CONST, 0, newSVpvn("BEGIN", 5)),
Nullop,
append_elem(OP_LINESEQ,
append_elem(OP_LINESEQ,
U32 seq = intro_my();
register COP *cop;
- Newz(1101, cop, 1, COP);
+ NewOp(1101, cop, 1, COP);
if (PERLDB_LINE && PL_curcop->cop_line && PL_curstash != PL_debstash) {
cop->op_type = OP_DBSTATE;
cop->op_ppaddr = PL_ppaddr[ OP_DBSTATE ];
if (type == OP_ANDASSIGN || type == OP_ORASSIGN)
other->op_private |= OPpASSIGN_BACKWARDS; /* other is an OP_SASSIGN */
- Newz(1101, logop, 1, LOGOP);
+ NewOp(1101, logop, 1, LOGOP);
logop->op_type = type;
logop->op_ppaddr = PL_ppaddr[type];
list(trueop);
scalar(falseop);
}
- Newz(1101, condop, 1, CONDOP);
+ NewOp(1101, condop, 1, CONDOP);
condop->op_type = OP_COND_EXPR;
condop->op_ppaddr = PL_ppaddr[OP_COND_EXPR];
OP *flop;
OP *o;
- Newz(1101, condop, 1, CONDOP);
+ NewOp(1101, condop, 1, CONDOP);
condop->op_type = OP_RANGE;
condop->op_ppaddr = PL_ppaddr[OP_RANGE];
o = listop;
if (!loop) {
- Newz(1101,loop,1,LOOP);
+ NewOp(1101,loop,1,LOOP);
loop->op_type = OP_ENTERLOOP;
loop->op_ppaddr = PL_ppaddr[OP_ENTERLOOP];
loop->op_private = 0;
newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont)
{
LOOP *loop;
+ LOOP *tmp;
OP *wop;
int padoff = 0;
I32 iterflags = 0;
loop = (LOOP*)list(convert(OP_ENTERITER, iterflags,
append_elem(OP_LIST, expr, scalar(sv))));
assert(!loop->op_next);
+#ifdef PL_OP_SLAB_ALLOC
+ NewOp(1234,tmp,1,LOOP);
+ Copy(loop,tmp,1,LOOP);
+ loop = tmp;
+#else
Renew(loop, 1, LOOP);
+#endif
loop->op_targ = padoff;
wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont);
PL_copline = forline;
#ifdef DEBUG_CLOSURES
STATIC void
-cv_dump(cv)
-CV* cv;
+cv_dump(CV *cv)
{
CV *outside = CvOUTSIDE(cv);
AV* padlist = CvPADLIST(cv);
if (strEQ(s, "BEGIN")) {
char *not_safe =
"BEGIN not safe after errors--compilation aborted";
- if (PL_in_eval & 4)
+ if (PL_in_eval & EVAL_KEEPERR)
croak(not_safe);
else {
/* force display of errors found but not reported */
OP *
newGVREF(I32 type, OP *o)
{
- if (type == OP_MAPSTART)
+ if (type == OP_MAPSTART || type == OP_GREPSTART || type == OP_SORT)
return newUNOP(OP_NULL, 0, o);
return ref(newUNOP(OP_RV2GV, OPf_REF, o), type);
}
cUNOPo->op_first = 0;
op_free(o);
- Newz(1101, enter, 1, LOGOP);
+ NewOp(1101, enter, 1, LOGOP);
enter->op_type = OP_ENTERTRY;
enter->op_ppaddr = PL_ppaddr[OP_ENTERTRY];
enter->op_private = 0;
}
else {
I32 flags = OPf_SPECIAL;
+ I32 priv = 0;
/* is this op a FH constructor? */
- if (is_handle_constructor(o,numargs))
- flags = 0;
+ if (is_handle_constructor(o,numargs)) {
+ flags = 0;
+ /* Set a flag to tell rv2gv to vivify
+ * need to "prove" flag does not mean something
+ * else already - NI-S 1999/05/07
+ */
+ priv = OPpDEREF;
+#if 0
+ /* Helps with open($array[$n],...)
+ but is too simplistic - need to do selectively
+ */
+ mod(kid,type);
+#endif
+ }
kid->op_sibling = 0;
kid = newUNOP(OP_RV2GV, flags, scalar(kid));
+ if (priv) {
+ kid->op_private |= priv;
+ }
}
kid->op_sibling = sibl;
*tokid = kid;
OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
o->op_ppaddr = PL_ppaddr[OP_GREPSTART];
- Newz(1101, gwop, 1, LOGOP);
+ NewOp(1101, gwop, 1, LOGOP);
if (o->op_flags & OPf_STACKED) {
OP* k;
if (o->op_flags & OPf_STACKED) { /* may have been cleared */
OP *kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
OP *k;
- kid = kUNOP->op_first; /* get past rv2gv */
+ kid = kUNOP->op_first; /* get past null */
if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
linklist(kid);
peep(k);
kid = cLISTOPo->op_first->op_sibling; /* get past pushmark */
- null(kid); /* wipe out rv2gv */
if (o->op_type == OP_SORT)
kid->op_next = kid;
else
return;
GvMULTI_on(gv_fetchpv("a", TRUE, SVt_PV));
GvMULTI_on(gv_fetchpv("b", TRUE, SVt_PV));
- kid = kUNOP->op_first; /* get past rv2gv */
+ kid = kUNOP->op_first; /* get past null */
if (kid->op_type != OP_SCOPE)
return;
kid = kLISTOP->op_last; /* get past scope */
op_free(cLISTOPo->op_first);
cLISTOPo->op_first = kid;
if (!kid) {
- cLISTOPo->op_first = kid = newSVOP(OP_CONST, 0, newSVpv(" ", 1));
+ cLISTOPo->op_first = kid = newSVOP(OP_CONST, 0, newSVpvn(" ", 1));
cLISTOPo->op_last = kid; /* There was only one element previously */
}
}
}
}
+ else if (cvop->op_type == OP_METHOD) {
+ if (o2->op_type == OP_CONST)
+ o2->op_private &= ~OPpCONST_STRICT;
+ else if (o2->op_type == OP_LIST) {
+ OP *o = ((UNOP*)o2)->op_first->op_sibling;
+ if (o && o->op_type == OP_CONST)
+ o->op_private &= ~OPpCONST_STRICT;
+ }
+ }
o->op_private |= (PL_hints & HINT_STRICT_REFS);
if (PERLDB_SUB && PL_curstash != PL_debstash)
o->op_private |= OPpENTERSUB_DB;
arg++;
if (o2->op_type == OP_RV2GV)
goto wrapref; /* autoconvert GLOB -> GLOBref */
+ else if (o2->op_type == OP_CONST)
+ o2->op_private &= ~OPpCONST_STRICT;
+ else if (o2->op_type == OP_ENTERSUB) {
+ /* accidental subroutine, revert to bareword */
+ OP *gvop = ((UNOP*)o2)->op_first;
+ if (gvop && gvop->op_type == OP_NULL) {
+ gvop = ((UNOP*)gvop)->op_first;
+ if (gvop) {
+ for (; gvop->op_sibling; gvop = gvop->op_sibling)
+ ;
+ if (gvop &&
+ (gvop->op_private & OPpENTERSUB_NOPAREN) &&
+ (gvop = ((UNOP*)gvop)->op_first) &&
+ gvop->op_type == OP_GV)
+ {
+ GV *gv = (GV*)((SVOP*)gvop)->op_sv;
+ OP *sibling = o2->op_sibling;
+ SV *n = newSVpvn("",0);
+ op_free(o2);
+ gv_fullname3(n, gv, "");
+ if (SvCUR(n)>6 && strnEQ(SvPVX(n),"main::",6))
+ sv_chop(n, SvPVX(n)+6);
+ o2 = newSVOP(OP_CONST, 0, n);
+ prev->op_sibling = o2;
+ o2->op_sibling = sibling;
+ }
+ }
+ }
+ }
scalar(o2);
break;
case '\\':
o->op_seq = PL_op_seqmax++;
break;
- case OP_CONCAT:
case OP_CONST:
+ if (cSVOPo->op_private & OPpCONST_STRICT)
+ no_bareword_allowed(o);
+ /* FALL THROUGH */
+ case OP_CONCAT:
case OP_JOIN:
case OP_UC:
case OP_UCFIRST:
char *key;
STRLEN keylen;
- if (o->op_private & (OPpDEREF_HV|OPpDEREF_AV|OPpLVAL_INTRO)
+ if ((o->op_private & (OPpLVAL_INTRO))
|| ((BINOP*)o)->op_last->op_type != OP_CONST)
break;
rop = (UNOP*)((BINOP*)o)->op_first;
projects / p5sagit/p5-mst-13.2.git / blobdiff