/* 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.
name[2] = toCTRL(name[1]);
name[1] = '^';
}
- croak("Can't use global %s in \"my\"",name);
+ yyerror(form("Can't use global %s in \"my\"",name));
}
if (ckWARN(WARN_UNSAFE) && AvFILLp(PL_comppad_name) >= 0) {
SV **svp = AvARRAY(PL_comppad_name);
sv_setpv(sv, name);
if (PL_in_my_stash) {
if (*name != '$')
- croak("Can't declare class for non-scalar %s in \"my\"",name);
+ yyerror(form("Can't declare class for non-scalar %s in \"my\"",
+ name));
SvOBJECT_on(sv);
(void)SvUPGRADE(sv, SVt_PVMG);
SvSTASH(sv) = (HV*)SvREFCNT_inc(PL_in_my_stash);
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
{
dTHR;
if (PL_in_eval) {
+ if (PL_eval_root)
+ return;
PL_eval_root = newUNOP(OP_LEAVEEVAL, ((PL_in_eval & 4) ? OPf_SPECIAL : 0), o);
PL_eval_start = linklist(PL_eval_root);
PL_eval_root->op_next = 0;
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);
if (repl) {
OP *curop;
- if (pm->op_pmflags & PMf_EVAL)
+ if (pm->op_pmflags & PMf_EVAL) {
curop = 0;
+ if (PL_curcop->cop_line < PL_multi_end)
+ PL_curcop->cop_line = PL_multi_end;
+ }
#ifdef USE_THREADS
else if (repl->op_type == OP_THREADSV
&& strchr("&`'123456789+",
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;
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;
o->op_private |= OPpLOCALE;
#endif
- if (o->op_flags & OPf_STACKED)
+ if (o->op_type == OP_SORT && o->op_flags & OPf_STACKED)
simplify_sort(o);
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
int reversed;
if (!(o->op_flags & OPf_STACKED))
return;
- kid = kUNOP->op_first; /* get past rv2gv */
+ GvMULTI_on(gv_fetchpv("a", TRUE, SVt_PV));
+ GvMULTI_on(gv_fetchpv("b", TRUE, SVt_PV));
+ 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 */
}
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