X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=f427b3bf07fac01cffefc7aa8221542f01842967;hb=e788e7d35b1f8979a002a1e994535be7aae30018;hp=704ccde0e938328bd5e6efbfc31f0cdad75f1b63;hpb=20408e3ccf502b6ce4033d8203710405ec9ef8f6;p=p5sagit%2Fp5-mst-13.2.git diff --git a/op.c b/op.c index 704ccde..f427b3b 100644 --- a/op.c +++ b/op.c @@ -18,6 +18,12 @@ #include "EXTERN.h" #include "perl.h" +#ifdef PERL_OBJECT +#define CHECKCALL this->*check +#else +#define CHECKCALL *check +#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. @@ -27,13 +33,14 @@ ? ( op_free((OP*)o), \ croak("%s trapped by operation mask", op_desc[type]), \ Nullop ) \ - : (*check[type])((OP*)o)) + : (CHECKCALL[type])((OP*)o)) +static bool scalar_mod_type _((OP *o, I32 type)); +#ifndef PERL_OBJECT static I32 list_assignment _((OP *o)); 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 bool scalar_mod_type _((OP *o, I32 type)); static OP *scalarboolean _((OP *o)); static OP *too_few_arguments _((OP *o, char* name)); static OP *too_many_arguments _((OP *o, char* name)); @@ -42,8 +49,9 @@ static PADOFFSET pad_findlex _((char* name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix)); static OP *newDEFSVOP _((void)); static OP *new_logop _((I32 type, I32 flags, OP **firstp, OP **otherp)); +#endif -static char* +STATIC char* gv_ename(GV *gv) { SV* tmpsv = sv_newmortal(); @@ -51,7 +59,7 @@ gv_ename(GV *gv) return SvPV(tmpsv,na); } -static OP * +STATIC OP * no_fh_allowed(OP *o) { yyerror(form("Missing comma after first argument to %s function", @@ -59,21 +67,21 @@ no_fh_allowed(OP *o) return o; } -static OP * +STATIC OP * too_few_arguments(OP *o, char *name) { yyerror(form("Not enough arguments for %s", name)); return o; } -static OP * +STATIC OP * too_many_arguments(OP *o, char *name) { yyerror(form("Too many arguments for %s", name)); return o; } -static void +STATIC void bad_type(I32 n, char *t, char *name, OP *kid) { yyerror(form("Type of arg %d to %s must be %s (not %s)", @@ -157,7 +165,7 @@ pad_allocmy(char *name) return off; } -static PADOFFSET +STATIC PADOFFSET pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) { dTHR; @@ -532,6 +540,11 @@ find_threadsv(char *name) sawampersand = TRUE; SvREADONLY_on(sv); /* FALL THROUGH */ + + /* XXX %! tied to Errno.pm needs to be added here. + * See gv_fetchpv(). */ + /* case '!': */ + default: sv_magic(sv, 0, 0, name, 1); } @@ -574,7 +587,8 @@ op_free(OP *o) break; #endif /* USE_THREADS */ default: - if (!(o->op_flags & OPf_REF) || (check[o->op_type] != ck_ftst)) + if (!(o->op_flags & OPf_REF) + || (check[o->op_type] != FUNC_NAME_TO_PTR(ck_ftst))) break; /* FALL THROUGH */ case OP_GVSV: @@ -615,7 +629,7 @@ op_free(OP *o) Safefree(o); } -static void +STATIC void null(OP *o) { if (o->op_type != OP_NULL && o->op_type != OP_THREADSV && o->op_targ > 0) @@ -664,7 +678,7 @@ scalarkids(OP *o) return o; } -static OP * +STATIC OP * scalarboolean(OP *o) { if (dowarn && @@ -768,6 +782,10 @@ scalarvoid(OP *o) case OP_REPEAT: if (o->op_flags & OPf_STACKED) break; + goto func_ops; + case OP_SUBSTR: + if (o->op_private == 4) + break; /* FALL THROUGH */ case OP_GVSV: case OP_WANTARRAY: @@ -784,7 +802,6 @@ scalarvoid(OP *o) case OP_HEX: case OP_OCT: case OP_LENGTH: - case OP_SUBSTR: case OP_VEC: case OP_INDEX: case OP_RINDEX: @@ -837,6 +854,7 @@ scalarvoid(OP *o) case OP_GGRNAM: case OP_GGRGID: case OP_GETLOGIN: + func_ops: if (!(o->op_private & OPpLVAL_INTRO)) useless = op_desc[o->op_type]; break; @@ -1034,7 +1052,7 @@ scalarseq(OP *o) return o; } -static OP * +STATIC OP * modkids(OP *o, I32 type) { OP *kid; @@ -1045,8 +1063,6 @@ modkids(OP *o, I32 type) return o; } -static I32 modcount; - OP * mod(OP *o, I32 type) { @@ -1194,10 +1210,14 @@ mod(OP *o, I32 type) case OP_KEYS: if (type != OP_SASSIGN) goto nomod; + goto lvalue_func; + case OP_SUBSTR: + if (o->op_private == 4) /* don't allow 4 arg substr as lvalue */ + goto nomod; /* FALL THROUGH */ case OP_POS: case OP_VEC: - case OP_SUBSTR: + lvalue_func: pad_free(o->op_targ); o->op_targ = pad_alloc(o->op_type, SVs_PADMY); assert(SvTYPE(PAD_SV(o->op_targ)) == SVt_NULL); @@ -1498,11 +1518,21 @@ scope(OP *o) return o; } +void +save_hints(void) +{ + SAVEI32(hints); + SAVESPTR(GvHV(hintgv)); + GvHV(hintgv) = newHVhv(GvHV(hintgv)); + SAVEFREESV(GvHV(hintgv)); +} + int block_start(int full) { dTHR; int retval = savestack_ix; + SAVEI32(comppad_name_floor); if (full) { if ((comppad_name_fill = AvFILLp(comppad_name)) > 0) @@ -1517,7 +1547,7 @@ block_start(int full) SAVEI32(padix_floor); padix_floor = padix; pad_reset_pending = FALSE; - SAVEI32(hints); + SAVEHINTS(); hints &= ~HINT_BLOCK_SCOPE; return retval; } @@ -1537,7 +1567,7 @@ block_end(I32 floor, OP *seq) return retval; } -static OP * +STATIC OP * newDEFSVOP(void) { #ifdef USE_THREADS @@ -1671,7 +1701,7 @@ fold_constants(register OP *o) curop = LINKLIST(o); o->op_next = 0; op = curop; - runops(); + CALLRUNOPS(); sv = *(stack_sp--); if (o->op_targ && sv == PAD_SV(o->op_targ)) /* grab pad temp? */ pad_swipe(o->op_targ); @@ -1683,9 +1713,12 @@ fold_constants(register OP *o) if (type == OP_RV2GV) return newGVOP(OP_GV, 0, (GV*)sv); else { - if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK) { + /* try to smush double to int, but don't smush -2.0 to -2 */ + if ((SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK)) == SVf_NOK && + type != OP_NEGATE) + { IV iv = SvIV(sv); - if ((double)iv == SvNV(sv)) { /* can we smush double to int */ + if ((double)iv == SvNV(sv)) { SvREFCNT_dec(sv); sv = newSViv(iv); } @@ -1733,7 +1766,7 @@ gen_constant_list(register OP *o) op = curop = LINKLIST(o); o->op_next = 0; pp_pushmark(ARGS); - runops(); + CALLRUNOPS(); op = curop; pp_anonlist(ARGS); tmps_floor = oldtmps_floor; @@ -2067,8 +2100,11 @@ newPMOP(I32 type, I32 flags) pmop->op_flags = flags; pmop->op_private = 0 | (flags >> 8); + if (hints & HINT_RE_TAINT) + pmop->op_pmpermflags |= PMf_RETAINT; if (hints & HINT_LOCALE) - pmop->op_pmpermflags = (pmop->op_pmflags |= PMf_LOCALE); + pmop->op_pmpermflags |= PMf_LOCALE; + pmop->op_pmflags = pmop->op_pmpermflags; /* link into pm list */ if (type != OP_TRANS && curstash) { @@ -2084,6 +2120,7 @@ pmruntime(OP *o, OP *expr, OP *repl) { PMOP *pm; LOGOP *rcop; + I32 repl_has_vars = 0; if (o->op_type == OP_TRANS) return pmtrans(o, expr, repl); @@ -2150,13 +2187,15 @@ pmruntime(OP *o, OP *expr, OP *repl) for (curop = LINKLIST(repl); curop!=repl; curop = LINKLIST(curop)) { if (opargs[curop->op_type] & OA_DANGEROUS) { #ifdef USE_THREADS - if (curop->op_type == OP_THREADSV - && strchr("&`'123456789+", curop->op_private)) { - break; + if (curop->op_type == OP_THREADSV) { + repl_has_vars = 1; + if (strchr("&`'123456789+", curop->op_private)) + break; } #else if (curop->op_type == OP_GV) { GV *gv = ((GVOP*)curop)->op_gv; + repl_has_vars = 1; if (strchr("&`'123456789+", *GvENAME(gv))) break; } @@ -2174,7 +2213,7 @@ pmruntime(OP *o, OP *expr, OP *repl) curop->op_type == OP_PADAV || curop->op_type == OP_PADHV || curop->op_type == OP_PADANY) { - /* is okay */ + repl_has_vars = 1; } else break; @@ -2182,12 +2221,19 @@ pmruntime(OP *o, OP *expr, OP *repl) lastop = curop; } } - if (curop == repl) { + if (curop == repl + && !(repl_has_vars + && (!pm->op_pmregexp + || pm->op_pmregexp->reganch & ROPT_EVAL_SEEN))) { pm->op_pmflags |= PMf_CONST; /* const for long enough */ pm->op_pmpermflags |= PMf_CONST; /* const for long enough */ prepend_elem(o->op_type, scalar(repl), o); } else { + if (curop == repl && !pm->op_pmregexp) { /* Has variables. */ + pm->op_pmflags |= PMf_MAYBE_CONST; + pm->op_pmpermflags |= PMf_MAYBE_CONST; + } Newz(1101, rcop, 1, LOGOP); rcop->op_type = OP_SUBSTCONT; rcop->op_ppaddr = ppaddr[OP_SUBSTCONT]; @@ -2370,7 +2416,7 @@ newSLICEOP(I32 flags, OP *subscript, OP *listval) list(force_list(listval)) ); } -static I32 +STATIC I32 list_assignment(register OP *o) { if (!o) @@ -2422,6 +2468,7 @@ newASSIGNOP(I32 flags, OP *left, I32 optype, OP *right) } if (list_assignment(left)) { + dTHR; modcount = 0; eval_start = right; /* Grandfathering $[ assignment here. Bletch.*/ left = mod(left, OP_AASSIGN); @@ -2437,7 +2484,6 @@ newASSIGNOP(I32 flags, OP *left, I32 optype, OP *right) list(force_list(left)) ); o->op_private = 0 | (flags >> 8); if (!(left->op_private & OPpLVAL_INTRO)) { - static int generation = 100; OP *curop; OP *lastop = o; generation++; @@ -2613,7 +2659,7 @@ newLOGOP(I32 type, I32 flags, OP *first, OP *other) return new_logop(type, flags, &first, &other); } -static OP * +STATIC OP * new_logop(I32 type, I32 flags, OP** firstp, OP** otherp) { dTHR; @@ -2670,7 +2716,7 @@ new_logop(I32 type, I32 flags, OP** firstp, OP** otherp) case OP_NULL: if (k2 && k2->op_type == OP_READLINE && (k2->op_flags & OPf_STACKED) - && (k1->op_type == OP_RV2SV || k1->op_type == OP_PADSV)) + && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) warnop = k2->op_type; break; @@ -2832,6 +2878,24 @@ newLOOPOP(I32 flags, I32 debuggable, OP *expr, OP *block) || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB)) { expr = newUNOP(OP_DEFINED, 0, newASSIGNOP(0, newDEFSVOP(), 0, expr) ); + } else if (expr->op_flags & OPf_KIDS) { + OP *k1 = ((UNOP*)expr)->op_first; + OP *k2 = (k1) ? k1->op_sibling : NULL; + switch (expr->op_type) { + case OP_NULL: + if (k2 && k2->op_type == OP_READLINE + && (k2->op_flags & OPf_STACKED) + && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) + expr = newUNOP(OP_DEFINED, 0, expr); + break; + + case OP_SASSIGN: + if (k1->op_type == OP_READDIR + || k1->op_type == OP_GLOB + || k1->op_type == OP_EACH) + expr = newUNOP(OP_DEFINED, 0, expr); + break; + } } } @@ -2867,6 +2931,24 @@ newWHILEOP(I32 flags, I32 debuggable, LOOP *loop, I32 whileline, OP *expr, OP *b || (expr->op_type == OP_NULL && expr->op_targ == OP_GLOB))) { expr = newUNOP(OP_DEFINED, 0, newASSIGNOP(0, newDEFSVOP(), 0, expr) ); + } else if (expr && (expr->op_flags & OPf_KIDS)) { + OP *k1 = ((UNOP*)expr)->op_first; + OP *k2 = (k1) ? k1->op_sibling : NULL; + switch (expr->op_type) { + case OP_NULL: + if (k2 && k2->op_type == OP_READLINE + && (k2->op_flags & OPf_STACKED) + && ((k1->op_flags & OPf_WANT) == OPf_WANT_SCALAR)) + expr = newUNOP(OP_DEFINED, 0, expr); + break; + + case OP_SASSIGN: + if (k1->op_type == OP_READDIR + || k1->op_type == OP_GLOB + || k1->op_type == OP_EACH) + expr = newUNOP(OP_DEFINED, 0, expr); + break; + } } if (!block) @@ -2963,12 +3045,44 @@ newFOROP(I32 flags,char *label,line_t forline,OP *sv,OP *expr,OP *block,OP *cont #endif } if (expr->op_type == OP_RV2AV || expr->op_type == OP_PADAV) { - expr = scalar(ref(expr, OP_ITER)); + expr = mod(force_list(scalar(ref(expr, OP_ITER))), OP_GREPSTART); iterflags |= OPf_STACKED; } + else if (expr->op_type == OP_NULL && + (expr->op_flags & OPf_KIDS) && + ((BINOP*)expr)->op_first->op_type == OP_FLOP) + { + /* Basically turn for($x..$y) into the same as for($x,$y), but we + * set the STACKED flag to indicate that these values are to be + * treated as min/max values by 'pp_iterinit'. + */ + UNOP* flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first; + CONDOP* range = (CONDOP*) flip->op_first; + OP* left = range->op_first; + OP* right = left->op_sibling; + LISTOP* listop; + + range->op_flags &= ~OPf_KIDS; + range->op_first = Nullop; + + listop = (LISTOP*)newLISTOP(OP_LIST, 0, left, right); + listop->op_first->op_next = range->op_true; + left->op_next = range->op_false; + right->op_next = (OP*)listop; + listop->op_next = listop->op_first; + + op_free(expr); + expr = (OP*)(listop); + null(expr); + iterflags |= OPf_STACKED; + } + else { + expr = mod(force_list(expr), OP_GREPSTART); + } + + loop = (LOOP*)list(convert(OP_ENTERITER, iterflags, - append_elem(OP_LIST, mod(force_list(expr), OP_GREPSTART), - scalar(sv)))); + append_elem(OP_LIST, expr, scalar(sv)))); assert(!loop->op_next); Renew(loop, 1, LOOP); loop->op_targ = padoff; @@ -3062,7 +3176,7 @@ cv_undef(CV *cv) } #ifdef DEBUG_CLOSURES -static void +STATIC void cv_dump(cv) CV* cv; { @@ -3107,7 +3221,7 @@ CV* cv; } #endif /* DEBUG_CLOSURES */ -static CV * +STATIC CV * cv_clone2(CV *proto, CV *outside) { dTHR; @@ -3271,16 +3385,27 @@ cv_ckproto(CV *cv, GV *gv, char *p) SV * cv_const_sv(CV *cv) { - OP *o; - SV *sv; - if (!cv || !SvPOK(cv) || SvCUR(cv)) return Nullsv; + return op_const_sv(CvSTART(cv), cv); +} + +SV * +op_const_sv(OP *o, CV *cv) +{ + SV *sv = Nullsv; + + if(!o) + return Nullsv; + + if(o->op_type == OP_LINESEQ && cLISTOPo->op_first) + o = cLISTOPo->op_first->op_sibling; - sv = Nullsv; - for (o = CvSTART(cv); o; o = o->op_next) { + for (; o; o = o->op_next) { OPCODE type = o->op_type; - + + if(sv && o->op_next == o) + return sv; if (type == OP_NEXTSTATE || type == OP_NULL || type == OP_PUSHMARK) continue; if (type == OP_LEAVESUB || type == OP_RETURN) @@ -3289,7 +3414,7 @@ cv_const_sv(CV *cv) return Nullsv; if (type == OP_CONST) sv = cSVOPo->op_sv; - else if (type == OP_PADSV) { + else if (type == OP_PADSV && cv) { AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]); sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv; if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1)) @@ -3308,9 +3433,10 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) { dTHR; char *name = o ? SvPVx(cSVOPo->op_sv, na) : Nullch; - GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV); + GV *gv = gv_fetchpv(name ? name : "__ANON__", + GV_ADDMULTI | (block ? 0 : GV_NOINIT), SVt_PVCV); char *ps = proto ? SvPVx(((SVOP*)proto)->op_sv, na) : Nullch; - register CV *cv; + register CV *cv=0; I32 ix; if (o) @@ -3318,6 +3444,23 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) if (proto) SAVEFREEOP(proto); + if (SvTYPE(gv) != SVt_PVGV) { /* Prototype now, and had + maximum a prototype before. */ + if (SvTYPE(gv) > SVt_NULL) { + if (!SvPOK((SV*)gv) && !(SvIOK((SV*)gv) && SvIVX((SV*)gv) == -1)) + warn("Runaway prototype"); + cv_ckproto((CV*)gv, NULL, ps); + } + if (ps) + sv_setpv((SV*)gv, ps); + else + sv_setiv((SV*)gv, -1); + SvREFCNT_dec(compcv); + cv = compcv = NULL; + sub_generation++; + goto noblock; + } + if (!name || GvCVGEN(gv)) cv = Nullcv; else if (cv = GvCV(gv)) { @@ -3325,16 +3468,18 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) /* already defined (or promised)? */ if (CvROOT(cv) || CvXSUB(cv) || GvASSUMECV(gv)) { SV* const_sv; + bool const_changed = TRUE; if (!block) { /* just a "sub foo;" when &foo is already defined */ SAVEFREESV(compcv); goto done; } /* ahem, death to those who redefine active sort subs */ - if (curstackinfo->si_type == SI_SORT && sortcop == CvSTART(cv)) + if (curstackinfo->si_type == PERLSI_SORT && sortcop == CvSTART(cv)) croak("Can't redefine active sort subroutine %s", name); - const_sv = cv_const_sv(cv); - if (const_sv || dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv)) + if(const_sv = cv_const_sv(cv)) + const_changed = sv_cmp(const_sv, op_const_sv(block, Nullcv)); + if ((const_sv && const_changed) || dowarn && !(CvGV(cv) && GvSTASH(CvGV(cv)) && HvNAME(GvSTASH(CvGV(cv))) && strEQ(HvNAME(GvSTASH(CvGV(cv))), "autouse"))) { @@ -3399,6 +3544,7 @@ newSUB(I32 floor, OP *o, OP *proto, OP *block) } } if (!block) { + noblock: copline = NOLINE; LEAVE_SCOPE(floor); return cv; @@ -3544,7 +3690,7 @@ newCONSTSUB(HV *stash, char *name, SV *sv) } CV * -newXS(char *name, void (*subaddr) (CV *), char *filename) +newXS(char *name, void (*subaddr) (CV * _CPERLproto), char *filename) { dTHR; GV *gv = gv_fetchpv(name ? name : "__ANON__", GV_ADDMULTI, SVt_PVCV); @@ -4038,7 +4184,7 @@ ck_ftst(OP *o) if (o->op_flags & OPf_REF) return o; - if (o->op_flags & OPf_KIDS) { + if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) { SVOP *kid = (SVOP*)cUNOPo->op_first; if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) { @@ -4717,6 +4863,30 @@ ck_svconst(OP *o) } OP * +ck_sysread(OP *o) +{ + if (o->op_flags & OPf_KIDS) { + /* get past pushmark */ + OP *kid = cLISTOPo->op_first->op_sibling; + if (kid && (kid = kid->op_sibling)) { + switch (kid->op_type) { + case OP_THREADSV: + case OP_HELEM: + case OP_AELEM: + case OP_SASSIGN: + case OP_AELEMFAST: + case OP_RV2SV: + case OP_PADSV: + break; + default: + bad_type(2, "scalar", op_desc[o->op_type], kid); + } + } + } + return ck_fun(o); +} + +OP * ck_trunc(OP *o) { if (o->op_flags & OPf_KIDS) { @@ -4828,7 +4998,7 @@ peep(register OP *o) case OP_PADAV: if (o->op_next->op_type == OP_RV2AV - && (o->op_next->op_flags && OPf_REF)) + && (o->op_next->op_flags & OPf_REF)) { null(o->op_next); o->op_next = o->op_next->op_next; @@ -4837,7 +5007,7 @@ peep(register OP *o) case OP_PADHV: if (o->op_next->op_type == OP_RV2HV - && (o->op_next->op_flags && OPf_REF)) + && (o->op_next->op_flags & OPf_REF)) { null(o->op_next); o->op_next = o->op_next->op_next;