X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=94c0b392d1e137959c776e24ebfc9c999f316b36;hb=a9ef352ac26829339bf17aa20568b3bde2fb1dd0;hp=fae524eb7113af9e4b13d3a09e18a645a34e9e1c;hpb=2b92dfceaa9d709661beb0761c3c790732df0cbc;p=p5sagit%2Fp5-mst-13.2.git diff --git a/op.c b/op.c index fae524e..94c0b39 100644 --- a/op.c +++ b/op.c @@ -1,6 +1,6 @@ /* 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. @@ -22,8 +22,31 @@ #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. @@ -147,7 +170,7 @@ pad_allocmy(char *name) 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); @@ -170,7 +193,8 @@ pad_allocmy(char *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); @@ -705,7 +729,13 @@ op_free(OP *o) 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 @@ -1721,6 +1751,8 @@ newPROG(OP *o) { 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; @@ -1996,8 +2028,11 @@ append_list(I32 type, LISTOP *first, LISTOP *last) 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; } @@ -2052,7 +2087,7 @@ newLISTOP(I32 type, I32 flags, OP *first, OP *last) { LISTOP *listop; - Newz(1101, listop, 1, LISTOP); + NewOp(1101, listop, 1, LISTOP); listop->op_type = type; listop->op_ppaddr = PL_ppaddr[type]; @@ -2086,7 +2121,7 @@ OP * 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; @@ -2110,7 +2145,7 @@ newUNOP(I32 type, I32 flags, OP *first) 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; @@ -2127,7 +2162,7 @@ OP * 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); @@ -2188,7 +2223,7 @@ pmtrans(OP *o, OP *expr, OP *repl) 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; @@ -2216,7 +2251,7 @@ pmtrans(OP *o, OP *expr, OP *repl) 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); @@ -2424,7 +2459,7 @@ newPMOP(I32 type, I32 flags) 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; @@ -2479,7 +2514,7 @@ pmruntime(OP *o, OP *expr, OP *repl) ? 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); @@ -2505,8 +2540,11 @@ pmruntime(OP *o, OP *expr, OP *repl) 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+", @@ -2571,7 +2609,7 @@ pmruntime(OP *o, OP *expr, OP *repl) 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); @@ -2596,7 +2634,7 @@ OP * 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; @@ -2614,7 +2652,7 @@ newGVOP(I32 type, I32 flags, GV *gv) { 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); @@ -2631,7 +2669,7 @@ OP * 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; @@ -2702,7 +2740,7 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg) 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)), @@ -2721,8 +2759,8 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg) 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, @@ -2748,7 +2786,7 @@ utilize(int aver, I32 floor, OP *version, OP *id, OP *arg) /* 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, @@ -2969,7 +3007,7 @@ newSTATEOP(I32 flags, char *label, OP *o) 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 ]; @@ -3136,7 +3174,7 @@ new_logop(I32 type, I32 flags, OP** firstp, OP** otherp) 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]; @@ -3185,7 +3223,7 @@ newCONDOP(I32 flags, OP *first, OP *trueop, OP *falseop) 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]; @@ -3218,7 +3256,7 @@ newRANGE(I32 flags, OP *left, OP *right) 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]; @@ -3379,7 +3417,7 @@ newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *b 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; @@ -3405,6 +3443,7 @@ OP * 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; @@ -3476,7 +3515,13 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont 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; @@ -4302,7 +4347,7 @@ newAVREF(OP *o) 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); } @@ -4460,7 +4505,7 @@ ck_eval(OP *o) 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; @@ -4776,11 +4821,27 @@ ck_fun(OP *o) } 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; @@ -4855,7 +4916,7 @@ ck_grep(OP *o) 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; @@ -5110,12 +5171,12 @@ ck_sort(OP *o) 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); @@ -5140,7 +5201,6 @@ ck_sort(OP *o) 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 @@ -5163,7 +5223,9 @@ simplify_sort(OP *o) 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 */ @@ -5229,7 +5291,7 @@ ck_split(OP *o) 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 */ } @@ -5567,7 +5629,7 @@ peep(register OP *o) 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;