X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp.c;h=3d7638e5dbcb88214b2cbbea86b8b70fdc1fb991;hb=c73bb82c00a639630ef310b1ac1d896f5afcedab;hp=4619b29748d296ceb97aadd070e61542dccb8278;hpb=fe5e78edd9ab337ef125ca9ff835e10989fe0004;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp.c b/pp.c index 4619b29..3d7638e 100644 --- a/pp.c +++ b/pp.c @@ -101,9 +101,11 @@ typedef unsigned UBW; # define CAT32(sv,p) sv_catpvn(sv, (char*)(p), SIZE32) #endif +#ifndef PERL_OBJECT static void doencodes _((SV* sv, char* s, I32 len)); static SV* refto _((SV* sv)); static U32 seed _((void)); +#endif static bool srand_called = FALSE; @@ -460,7 +462,7 @@ PP(pp_refgen) RETURN; } -static SV* +STATIC SV* refto(SV *sv) { SV* rv; @@ -528,40 +530,40 @@ PP(pp_gelem) { GV *gv; SV *sv; - SV *ref; + SV *tmpRef; char *elem; djSP; sv = POPs; elem = SvPV(sv, na); gv = (GV*)POPs; - ref = Nullsv; + tmpRef = Nullsv; sv = Nullsv; switch (elem ? *elem : '\0') { case 'A': if (strEQ(elem, "ARRAY")) - ref = (SV*)GvAV(gv); + tmpRef = (SV*)GvAV(gv); break; case 'C': if (strEQ(elem, "CODE")) - ref = (SV*)GvCVu(gv); + tmpRef = (SV*)GvCVu(gv); break; case 'F': if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */ - ref = (SV*)GvIOp(gv); + tmpRef = (SV*)GvIOp(gv); break; case 'G': if (strEQ(elem, "GLOB")) - ref = (SV*)gv; + tmpRef = (SV*)gv; break; case 'H': if (strEQ(elem, "HASH")) - ref = (SV*)GvHV(gv); + tmpRef = (SV*)GvHV(gv); break; case 'I': if (strEQ(elem, "IO")) - ref = (SV*)GvIOp(gv); + tmpRef = (SV*)GvIOp(gv); break; case 'N': if (strEQ(elem, "NAME")) @@ -573,11 +575,11 @@ PP(pp_gelem) break; case 'S': if (strEQ(elem, "SCALAR")) - ref = GvSV(gv); + tmpRef = GvSV(gv); break; } - if (ref) - sv = newRV(ref); + if (tmpRef) + sv = newRV(tmpRef); if (sv) sv_2mortal(sv); else @@ -919,7 +921,7 @@ PP(pp_divide) PP(pp_modulo) { - djSP; dATARGET; tryAMAGICbin(mod,opASSIGN); + djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { UV left; UV right; @@ -1405,7 +1407,7 @@ PP(pp_i_divide) PP(pp_i_modulo) { - djSP; dATARGET; tryAMAGICbin(mod,opASSIGN); + djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { dPOPTOPiirl; if (!right) @@ -1601,7 +1603,7 @@ PP(pp_srand) RETPUSHYES; } -static U32 +STATIC U32 seed(void) { /* @@ -1793,7 +1795,6 @@ PP(pp_substr) djSP; dTARGET; SV *sv; I32 len; - I32 len_ok = 0; STRLEN curlen; I32 pos; I32 rem; @@ -1805,21 +1806,13 @@ PP(pp_substr) STRLEN repl_len; SvTAINTED_off(TARG); /* decontaminate */ - if (MAXARG > 3) { - /* pop off replacement string */ - sv = POPs; - repl = SvPV(sv, repl_len); - /* pop off length */ - sv = POPs; - if (SvOK(sv)) { - len = SvIV(sv); - len_ok++; + if (MAXARG > 2) { + if (MAXARG > 3) { + sv = POPs; + repl = SvPV(sv, repl_len); } - } else if (MAXARG == 3) { len = POPi; - len_ok++; - } - + } pos = POPi; sv = POPs; PUTBACK; @@ -1828,34 +1821,34 @@ PP(pp_substr) pos -= arybase; rem = curlen-pos; fail = rem; - if (len_ok) { - if (len < 0) { - rem += len; - if (rem < 0) - rem = 0; - } - else if (rem > len) - rem = len; - } + if (MAXARG > 2) { + if (len < 0) { + rem += len; + if (rem < 0) + rem = 0; + } + else if (rem > len) + rem = len; + } } else { - pos += curlen; - if (!len_ok) - rem = curlen; - else if (len >= 0) { - rem = pos+len; - if (rem > (I32)curlen) - rem = curlen; - } - else { - rem = curlen+len; - if (rem < pos) - rem = pos; - } - if (pos < 0) - pos = 0; - fail = rem; - rem -= pos; + pos += curlen; + if (MAXARG < 3) + rem = curlen; + else if (len >= 0) { + rem = pos+len; + if (rem > (I32)curlen) + rem = curlen; + } + else { + rem = curlen+len; + if (rem < pos) + rem = pos; + } + if (pos < 0) + pos = 0; + fail = rem; + rem -= pos; } if (fail < 0) { if (dowarn || lvalue || repl) @@ -1892,7 +1885,7 @@ PP(pp_substr) LvTARGOFF(TARG) = pos; LvTARGLEN(TARG) = rem; } - else if (repl) + else if (repl) sv_insert(sv, pos, rem, repl, repl_len); } SPAGAIN; @@ -2416,7 +2409,6 @@ PP(pp_exists) PP(pp_hslice) { djSP; dMARK; dORIGMARK; - register HE *he; register HV *hv = (HV*)POPs; register I32 lval = op->op_flags & OPf_MOD; I32 realhv = (SvTYPE(hv) == SVt_PVHV); @@ -2426,18 +2418,18 @@ PP(pp_hslice) SV *keysv = *MARK; SV **svp; if (realhv) { - he = hv_fetch_ent(hv, keysv, lval, 0); + HE *he = hv_fetch_ent(hv, keysv, lval, 0); svp = he ? &HeVAL(he) : 0; } else { svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0); } if (lval) { - if (!he || HeVAL(he) == &sv_undef) + if (!svp || *svp == &sv_undef) DIE(no_helem, SvPV(keysv, na)); if (op->op_private & OPpLVAL_INTRO) - save_helem(hv, keysv, &HeVAL(he)); + save_helem(hv, keysv, svp); } - *MARK = he ? HeVAL(he) : &sv_undef; + *MARK = svp ? *svp : &sv_undef; } } if (GIMME != G_ARRAY) { @@ -2588,8 +2580,11 @@ PP(pp_splice) DIE(no_aelem, i); if (++MARK < SP) { length = SvIVx(*MARK++); - if (length < 0) - length = 0; + if (length < 0) { + length += AvFILLp(ary) - offset + 1; + if (length < 0) + length = 0; + } } else length = AvMAX(ary) + 1; /* close enough to infinity */ @@ -2884,7 +2879,7 @@ PP(pp_reverse) RETURN; } -static SV * +STATIC SV * mul128(SV *sv, U8 m) { STRLEN len; @@ -3447,6 +3442,9 @@ PP(pp_unpack) break; #ifdef HAS_QUAD case 'q': + along = (strend - s) / sizeof(Quad_t); + if (len > along) + len = along; EXTEND(SP, len); EXTEND_MORTAL(len); while (len-- > 0) { @@ -3465,6 +3463,9 @@ PP(pp_unpack) } break; case 'Q': + along = (strend - s) / sizeof(Quad_t); + if (len > along) + len = along; EXTEND(SP, len); EXTEND_MORTAL(len); while (len-- > 0) { @@ -3613,7 +3614,7 @@ PP(pp_unpack) RETURN; } -static void +STATIC void doencodes(register SV *sv, register char *s, register I32 len) { char hunk[5]; @@ -3637,7 +3638,7 @@ doencodes(register SV *sv, register char *s, register I32 len) sv_catpvn(sv, "\n", 1); } -static SV * +STATIC SV * is_an_int(char *s, STRLEN l) { SV *result = newSVpv("", l); @@ -3685,7 +3686,7 @@ is_an_int(char *s, STRLEN l) return (result); } -static int +STATIC int div128(SV *pnum, bool *done) /* must be '\0' terminated */