diff options
Diffstat (limited to 'contrib/perl5/pp.c')
| -rw-r--r-- | contrib/perl5/pp.c | 685 |
1 files changed, 279 insertions, 406 deletions
diff --git a/contrib/perl5/pp.c b/contrib/perl5/pp.c index cc9a053..58fda0e 100644 --- a/contrib/perl5/pp.c +++ b/contrib/perl5/pp.c @@ -1,10 +1,11 @@ /* pp.c * - * Copyright (c) 1991-2001, Larry Wall + * Copyright (c) 1991-2000, 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. * + * $FreeBSD$ */ /* @@ -82,6 +83,10 @@ static double UV_MAX_cxux = ((double)UV_MAX); /* variations on pp_null */ +#ifdef I_UNISTD +#include <unistd.h> +#endif + /* XXX I can't imagine anyone who doesn't have this actually _needs_ it, since pid_t is an integral type. --AD 2/20/1998 @@ -92,7 +97,7 @@ extern Pid_t getpid (void); PP(pp_stub) { - dSP; + djSP; if (GIMME_V == G_SCALAR) XPUSHs(&PL_sv_undef); RETURN; @@ -107,18 +112,13 @@ PP(pp_scalar) PP(pp_padav) { - dSP; dTARGET; + djSP; dTARGET; if (PL_op->op_private & OPpLVAL_INTRO) SAVECLEARSV(PL_curpad[PL_op->op_targ]); EXTEND(SP, 1); if (PL_op->op_flags & OPf_REF) { PUSHs(TARG); RETURN; - } else if (LVRET) { - if (GIMME == G_SCALAR) - Perl_croak(aTHX_ "Can't return array to lvalue scalar context"); - PUSHs(TARG); - RETURN; } if (GIMME == G_ARRAY) { I32 maxarg = AvFILL((AV*)TARG) + 1; @@ -146,7 +146,7 @@ PP(pp_padav) PP(pp_padhv) { - dSP; dTARGET; + djSP; dTARGET; I32 gimme; XPUSHs(TARG); @@ -154,11 +154,6 @@ PP(pp_padhv) SAVECLEARSV(PL_curpad[PL_op->op_targ]); if (PL_op->op_flags & OPf_REF) RETURN; - else if (LVRET) { - if (GIMME == G_SCALAR) - Perl_croak(aTHX_ "Can't return hash to lvalue scalar context"); - RETURN; - } gimme = GIMME_V; if (gimme == G_ARRAY) { RETURNOP(do_kv()); @@ -184,7 +179,7 @@ PP(pp_padany) PP(pp_rv2gv) { - dSP; dTOPss; + djSP; dTOPss; if (SvROK(sv)) { wasref: @@ -204,7 +199,7 @@ PP(pp_rv2gv) else { if (SvTYPE(sv) != SVt_PVGV) { char *sym; - STRLEN len; + STRLEN n_a; if (SvGMAGICAL(sv)) { mg_get(sv); @@ -242,17 +237,13 @@ PP(pp_rv2gv) report_uninit(); RETSETUNDEF; } - sym = SvPV(sv,len); + sym = SvPV(sv, n_a); if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { sv = (SV*)gv_fetchpv(sym, FALSE, SVt_PVGV); - if (!sv - && (!is_gv_magical(sym,len,0) - || !(sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV)))) - { + if (!sv) RETSETUNDEF; - } } else { if (PL_op->op_private & HINT_STRICT_REFS) @@ -269,7 +260,7 @@ PP(pp_rv2gv) PP(pp_rv2sv) { - dSP; dTOPss; + djSP; dTOPss; if (SvROK(sv)) { wasref: @@ -286,7 +277,7 @@ PP(pp_rv2sv) else { GV *gv = (GV*)sv; char *sym; - STRLEN len; + STRLEN n_a; if (SvTYPE(gv) != SVt_PVGV) { if (SvGMAGICAL(sv)) { @@ -302,17 +293,13 @@ PP(pp_rv2sv) report_uninit(); RETSETUNDEF; } - sym = SvPV(sv, len); + sym = SvPV(sv, n_a); if ((PL_op->op_flags & OPf_SPECIAL) && !(PL_op->op_flags & OPf_MOD)) { gv = (GV*)gv_fetchpv(sym, FALSE, SVt_PV); - if (!gv - && (!is_gv_magical(sym,len,0) - || !(gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV)))) - { + if (!gv) RETSETUNDEF; - } } else { if (PL_op->op_private & HINT_STRICT_REFS) @@ -334,7 +321,7 @@ PP(pp_rv2sv) PP(pp_av2arylen) { - dSP; + djSP; AV *av = (AV*)TOPs; SV *sv = AvARYLEN(av); if (!sv) { @@ -348,9 +335,9 @@ PP(pp_av2arylen) PP(pp_pos) { - dSP; dTARGET; dPOPss; + djSP; dTARGET; dPOPss; - if (PL_op->op_flags & OPf_MOD || LVRET) { + if (PL_op->op_flags & OPf_MOD) { if (SvTYPE(TARG) < SVt_PVLV) { sv_upgrade(TARG, SVt_PVLV); sv_magic(TARG, Nullsv, '.', Nullch, 0); @@ -384,7 +371,7 @@ PP(pp_pos) PP(pp_rv2cv) { - dSP; + djSP; GV *gv; HV *stash; @@ -394,12 +381,8 @@ PP(pp_rv2cv) if (cv) { if (CvCLONE(cv)) cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); - if ((PL_op->op_private & OPpLVAL_INTRO)) { - if (gv && GvCV(gv) == cv && (gv = gv_autoload4(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), FALSE))) - cv = GvCV(gv); - if (!CvLVALUE(cv)) - DIE(aTHX_ "Can't modify non-lvalue subroutine call"); - } + if ((PL_op->op_private & OPpLVAL_INTRO) && !CvLVALUE(cv)) + DIE(aTHX_ "Can't modify non-lvalue subroutine call"); } else cv = (CV*)&PL_sv_undef; @@ -409,7 +392,7 @@ PP(pp_rv2cv) PP(pp_prototype) { - dSP; + djSP; CV *cv; HV *stash; GV *gv; @@ -475,7 +458,7 @@ PP(pp_prototype) PP(pp_anoncode) { - dSP; + djSP; CV* cv = (CV*)PL_curpad[PL_op->op_targ]; if (CvCLONE(cv)) cv = (CV*)sv_2mortal((SV*)cv_clone(cv)); @@ -486,14 +469,14 @@ PP(pp_anoncode) PP(pp_srefgen) { - dSP; + djSP; *SP = refto(*SP); RETURN; } PP(pp_refgen) { - dSP; dMARK; + djSP; dMARK; if (GIMME != G_ARRAY) { if (++MARK <= SP) *MARK = *SP; @@ -543,7 +526,7 @@ S_refto(pTHX_ SV *sv) PP(pp_ref) { - dSP; dTARGET; + djSP; dTARGET; SV *sv; char *pv; @@ -563,7 +546,7 @@ PP(pp_ref) PP(pp_bless) { - dSP; + djSP; HV *stash; if (MAXARG == 1) @@ -588,7 +571,7 @@ PP(pp_gelem) SV *sv; SV *tmpRef; char *elem; - dSP; + djSP; STRLEN n_a; sv = POPs; @@ -649,7 +632,7 @@ PP(pp_gelem) PP(pp_study) { - dSP; dPOPss; + djSP; dPOPss; register unsigned char *s; register I32 pos; register I32 ch; @@ -711,7 +694,7 @@ PP(pp_study) PP(pp_trans) { - dSP; dTARG; + djSP; dTARG; SV *sv; if (PL_op->op_flags & OPf_STACKED) @@ -729,7 +712,7 @@ PP(pp_trans) PP(pp_schop) { - dSP; dTARGET; + djSP; dTARGET; do_chop(TARG, TOPs); SETTARG; RETURN; @@ -737,24 +720,23 @@ PP(pp_schop) PP(pp_chop) { - dSP; dMARK; dTARGET; dORIGMARK; - while (MARK < SP) - do_chop(TARG, *++MARK); - SP = ORIGMARK; + djSP; dMARK; dTARGET; + while (SP > MARK) + do_chop(TARG, POPs); PUSHTARG; RETURN; } PP(pp_schomp) { - dSP; dTARGET; + djSP; dTARGET; SETi(do_chomp(TOPs)); RETURN; } PP(pp_chomp) { - dSP; dMARK; dTARGET; + djSP; dMARK; dTARGET; register I32 count = 0; while (SP > MARK) @@ -765,7 +747,7 @@ PP(pp_chomp) PP(pp_defined) { - dSP; + djSP; register SV* sv; sv = POPs; @@ -795,7 +777,7 @@ PP(pp_defined) PP(pp_undef) { - dSP; + djSP; SV *sv; if (!PL_op->op_private) { @@ -827,7 +809,7 @@ PP(pp_undef) case SVt_PVFM: { /* let user-undef'd sub keep its identity */ - GV* gv = CvGV((CV*)sv); + GV* gv = (GV*)SvREFCNT_inc(CvGV((CV*)sv)); cv_undef((CV*)sv); CvGV((CV*)sv) = gv; } @@ -862,7 +844,7 @@ PP(pp_undef) PP(pp_predec) { - dSP; + djSP; if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) DIE(aTHX_ PL_no_modify); if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) && @@ -879,7 +861,7 @@ PP(pp_predec) PP(pp_postinc) { - dSP; dTARGET; + djSP; dTARGET; if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) DIE(aTHX_ PL_no_modify); sv_setsv(TARG, TOPs); @@ -900,7 +882,7 @@ PP(pp_postinc) PP(pp_postdec) { - dSP; dTARGET; + djSP; dTARGET; if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV) DIE(aTHX_ PL_no_modify); sv_setsv(TARG, TOPs); @@ -921,7 +903,7 @@ PP(pp_postdec) PP(pp_pow) { - dSP; dATARGET; tryAMAGICbin(pow,opASSIGN); + djSP; dATARGET; tryAMAGICbin(pow,opASSIGN); { dPOPTOPnnrl; SETn( Perl_pow( left, right) ); @@ -931,7 +913,7 @@ PP(pp_pow) PP(pp_multiply) { - dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); + djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); { dPOPTOPnnrl; SETn( left * right ); @@ -941,7 +923,7 @@ PP(pp_multiply) PP(pp_divide) { - dSP; dATARGET; tryAMAGICbin(div,opASSIGN); + djSP; dATARGET; tryAMAGICbin(div,opASSIGN); { dPOPPOPnnrl; NV value; @@ -970,7 +952,7 @@ PP(pp_divide) PP(pp_modulo) { - dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); + djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { UV left; UV right; @@ -980,7 +962,7 @@ PP(pp_modulo) NV dright; NV dleft; - if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { + if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { IV i = SvIVX(POPs); right = (right_neg = (i < 0)) ? -i : i; } @@ -992,7 +974,7 @@ PP(pp_modulo) dright = -dright; } - if (!use_double && SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { + if (!use_double && SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) { IV i = SvIVX(POPs); left = (left_neg = (i < 0)) ? -i : i; } @@ -1070,9 +1052,9 @@ PP(pp_modulo) PP(pp_repeat) { - dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN); + djSP; dATARGET; tryAMAGICbin(repeat,opASSIGN); { - register IV count = POPi; + register I32 count = POPi; if (GIMME == G_ARRAY && PL_op->op_private & OPpREPEAT_DOLIST) { dMARK; I32 items = SP - MARK; @@ -1095,13 +1077,12 @@ PP(pp_repeat) SP -= items; } else { /* Note: mark already snarfed by pp_list */ - SV *tmpstr = POPs; + SV *tmpstr; STRLEN len; - bool isutf; + tmpstr = POPs; SvSetSV(TARG, tmpstr); SvPV_force(TARG, len); - isutf = DO_UTF8(TARG); if (count != 1) { if (count < 1) SvCUR_set(TARG, 0); @@ -1112,10 +1093,7 @@ PP(pp_repeat) } *SvEND(TARG) = '\0'; } - if (isutf) - (void)SvPOK_only_UTF8(TARG); - else - (void)SvPOK_only(TARG); + (void)SvPOK_only(TARG); PUSHTARG; } RETURN; @@ -1124,7 +1102,7 @@ PP(pp_repeat) PP(pp_subtract) { - dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); + djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); { dPOPTOPnnrl_ul; SETn( left - right ); @@ -1134,7 +1112,7 @@ PP(pp_subtract) PP(pp_left_shift) { - dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); + djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN); { IV shift = POPi; if (PL_op->op_private & HINT_INTEGER) { @@ -1151,7 +1129,7 @@ PP(pp_left_shift) PP(pp_right_shift) { - dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); + djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN); { IV shift = POPi; if (PL_op->op_private & HINT_INTEGER) { @@ -1168,7 +1146,7 @@ PP(pp_right_shift) PP(pp_lt) { - dSP; tryAMAGICbinSET(lt,0); + djSP; tryAMAGICbinSET(lt,0); { dPOPnv; SETs(boolSV(TOPn < value)); @@ -1178,7 +1156,7 @@ PP(pp_lt) PP(pp_gt) { - dSP; tryAMAGICbinSET(gt,0); + djSP; tryAMAGICbinSET(gt,0); { dPOPnv; SETs(boolSV(TOPn > value)); @@ -1188,7 +1166,7 @@ PP(pp_gt) PP(pp_le) { - dSP; tryAMAGICbinSET(le,0); + djSP; tryAMAGICbinSET(le,0); { dPOPnv; SETs(boolSV(TOPn <= value)); @@ -1198,7 +1176,7 @@ PP(pp_le) PP(pp_ge) { - dSP; tryAMAGICbinSET(ge,0); + djSP; tryAMAGICbinSET(ge,0); { dPOPnv; SETs(boolSV(TOPn >= value)); @@ -1208,7 +1186,7 @@ PP(pp_ge) PP(pp_ne) { - dSP; tryAMAGICbinSET(ne,0); + djSP; tryAMAGICbinSET(ne,0); { dPOPnv; SETs(boolSV(TOPn != value)); @@ -1218,12 +1196,19 @@ PP(pp_ne) PP(pp_ncmp) { - dSP; dTARGET; tryAMAGICbin(ncmp,0); + djSP; dTARGET; tryAMAGICbin(ncmp,0); { dPOPTOPnnrl; I32 value; +#ifdef __osf__ /* XXX Configure probe for isnan and isnanl needed XXX */ +#if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) +#define Perl_isnan isnanl +#else +#define Perl_isnan isnan +#endif +#endif -#ifdef Perl_isnan +#ifdef __osf__ /* XXX fix in 5.6.1 --jhi */ if (Perl_isnan(left) || Perl_isnan(right)) { SETs(&PL_sv_undef); RETURN; @@ -1248,7 +1233,7 @@ PP(pp_ncmp) PP(pp_slt) { - dSP; tryAMAGICbinSET(slt,0); + djSP; tryAMAGICbinSET(slt,0); { dPOPTOPssrl; int cmp = ((PL_op->op_private & OPpLOCALE) @@ -1261,7 +1246,7 @@ PP(pp_slt) PP(pp_sgt) { - dSP; tryAMAGICbinSET(sgt,0); + djSP; tryAMAGICbinSET(sgt,0); { dPOPTOPssrl; int cmp = ((PL_op->op_private & OPpLOCALE) @@ -1274,7 +1259,7 @@ PP(pp_sgt) PP(pp_sle) { - dSP; tryAMAGICbinSET(sle,0); + djSP; tryAMAGICbinSET(sle,0); { dPOPTOPssrl; int cmp = ((PL_op->op_private & OPpLOCALE) @@ -1287,7 +1272,7 @@ PP(pp_sle) PP(pp_sge) { - dSP; tryAMAGICbinSET(sge,0); + djSP; tryAMAGICbinSET(sge,0); { dPOPTOPssrl; int cmp = ((PL_op->op_private & OPpLOCALE) @@ -1300,7 +1285,7 @@ PP(pp_sge) PP(pp_seq) { - dSP; tryAMAGICbinSET(seq,0); + djSP; tryAMAGICbinSET(seq,0); { dPOPTOPssrl; SETs(boolSV(sv_eq(left, right))); @@ -1310,7 +1295,7 @@ PP(pp_seq) PP(pp_sne) { - dSP; tryAMAGICbinSET(sne,0); + djSP; tryAMAGICbinSET(sne,0); { dPOPTOPssrl; SETs(boolSV(!sv_eq(left, right))); @@ -1320,7 +1305,7 @@ PP(pp_sne) PP(pp_scmp) { - dSP; dTARGET; tryAMAGICbin(scmp,0); + djSP; dTARGET; tryAMAGICbin(scmp,0); { dPOPTOPssrl; int cmp = ((PL_op->op_private & OPpLOCALE) @@ -1333,7 +1318,7 @@ PP(pp_scmp) PP(pp_bit_and) { - dSP; dATARGET; tryAMAGICbin(band,opASSIGN); + djSP; dATARGET; tryAMAGICbin(band,opASSIGN); { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { @@ -1356,7 +1341,7 @@ PP(pp_bit_and) PP(pp_bit_xor) { - dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); + djSP; dATARGET; tryAMAGICbin(bxor,opASSIGN); { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { @@ -1379,7 +1364,7 @@ PP(pp_bit_xor) PP(pp_bit_or) { - dSP; dATARGET; tryAMAGICbin(bor,opASSIGN); + djSP; dATARGET; tryAMAGICbin(bor,opASSIGN); { dPOPTOPssrl; if (SvNIOKp(left) || SvNIOKp(right)) { @@ -1402,7 +1387,7 @@ PP(pp_bit_or) PP(pp_negate) { - dSP; dTARGET; tryAMAGICun(neg); + djSP; dTARGET; tryAMAGICun(neg); { dTOPss; if (SvGMAGICAL(sv)) @@ -1436,7 +1421,7 @@ PP(pp_negate) sv_setsv(TARG, sv); *SvPV_force(TARG, len) = *s == '-' ? '+' : '-'; } - else if (DO_UTF8(sv) && UTF8_IS_START(*s) && isIDFIRST_utf8((U8*)s)) { + else if (DO_UTF8(sv) && *(U8*)s >= 0xc0 && isIDFIRST_utf8((U8*)s)) { sv_setpvn(TARG, "-", 1); sv_catsv(TARG, sv); } @@ -1452,14 +1437,14 @@ PP(pp_negate) PP(pp_not) { - dSP; tryAMAGICunSET(not); + djSP; tryAMAGICunSET(not); *PL_stack_sp = boolSV(!SvTRUE(*PL_stack_sp)); return NORMAL; } PP(pp_complement) { - dSP; dTARGET; tryAMAGICun(compl); + djSP; dTARGET; tryAMAGICun(compl); { dTOPss; if (SvNIOKp(sv)) { @@ -1473,72 +1458,21 @@ PP(pp_complement) } } else { - register U8 *tmps; + register char *tmps; + register long *tmpl; register I32 anum; STRLEN len; SvSetSV(TARG, sv); - tmps = (U8*)SvPV_force(TARG, len); + tmps = SvPV_force(TARG, len); anum = len; - if (SvUTF8(TARG)) { - /* Calculate exact length, let's not estimate. */ - STRLEN targlen = 0; - U8 *result; - U8 *send; - STRLEN l; - UV nchar = 0; - UV nwide = 0; - - send = tmps + len; - while (tmps < send) { - UV c = utf8_to_uv(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV); - tmps += UTF8SKIP(tmps); - targlen += UNISKIP(~c); - nchar++; - if (c > 0xff) - nwide++; - } - - /* Now rewind strings and write them. */ - tmps -= len; - - if (nwide) { - Newz(0, result, targlen + 1, U8); - while (tmps < send) { - UV c = utf8_to_uv(tmps, send-tmps, &l, UTF8_ALLOW_ANYUV); - tmps += UTF8SKIP(tmps); - result = uv_to_utf8(result, ~c); - } - *result = '\0'; - result -= targlen; - sv_setpvn(TARG, (char*)result, targlen); - SvUTF8_on(TARG); - } - else { - Newz(0, result, nchar + 1, U8); - while (tmps < send) { - U8 c = (U8)utf8_to_uv(tmps, 0, &l, UTF8_ALLOW_ANY); - tmps += UTF8SKIP(tmps); - *result++ = ~c; - } - *result = '\0'; - result -= nchar; - sv_setpvn(TARG, (char*)result, nchar); - } - Safefree(result); - SETs(TARG); - RETURN; - } #ifdef LIBERAL - { - register long *tmpl; - for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++) - *tmps = ~*tmps; - tmpl = (long*)tmps; - for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++) - *tmpl = ~*tmpl; - tmps = (U8*)tmpl; - } + for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++) + *tmps = ~*tmps; + tmpl = (long*)tmps; + for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++) + *tmpl = ~*tmpl; + tmps = (char*)tmpl; #endif for ( ; anum > 0; anum--, tmps++) *tmps = ~*tmps; @@ -1553,7 +1487,7 @@ PP(pp_complement) PP(pp_i_multiply) { - dSP; dATARGET; tryAMAGICbin(mult,opASSIGN); + djSP; dATARGET; tryAMAGICbin(mult,opASSIGN); { dPOPTOPiirl; SETi( left * right ); @@ -1563,7 +1497,7 @@ PP(pp_i_multiply) PP(pp_i_divide) { - dSP; dATARGET; tryAMAGICbin(div,opASSIGN); + djSP; dATARGET; tryAMAGICbin(div,opASSIGN); { dPOPiv; if (value == 0) @@ -1576,7 +1510,7 @@ PP(pp_i_divide) PP(pp_i_modulo) { - dSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); + djSP; dATARGET; tryAMAGICbin(modulo,opASSIGN); { dPOPTOPiirl; if (!right) @@ -1588,9 +1522,9 @@ PP(pp_i_modulo) PP(pp_i_add) { - dSP; dATARGET; tryAMAGICbin(add,opASSIGN); + djSP; dATARGET; tryAMAGICbin(add,opASSIGN); { - dPOPTOPiirl_ul; + dPOPTOPiirl; SETi( left + right ); RETURN; } @@ -1598,9 +1532,9 @@ PP(pp_i_add) PP(pp_i_subtract) { - dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); + djSP; dATARGET; tryAMAGICbin(subtr,opASSIGN); { - dPOPTOPiirl_ul; + dPOPTOPiirl; SETi( left - right ); RETURN; } @@ -1608,7 +1542,7 @@ PP(pp_i_subtract) PP(pp_i_lt) { - dSP; tryAMAGICbinSET(lt,0); + djSP; tryAMAGICbinSET(lt,0); { dPOPTOPiirl; SETs(boolSV(left < right)); @@ -1618,7 +1552,7 @@ PP(pp_i_lt) PP(pp_i_gt) { - dSP; tryAMAGICbinSET(gt,0); + djSP; tryAMAGICbinSET(gt,0); { dPOPTOPiirl; SETs(boolSV(left > right)); @@ -1628,7 +1562,7 @@ PP(pp_i_gt) PP(pp_i_le) { - dSP; tryAMAGICbinSET(le,0); + djSP; tryAMAGICbinSET(le,0); { dPOPTOPiirl; SETs(boolSV(left <= right)); @@ -1638,7 +1572,7 @@ PP(pp_i_le) PP(pp_i_ge) { - dSP; tryAMAGICbinSET(ge,0); + djSP; tryAMAGICbinSET(ge,0); { dPOPTOPiirl; SETs(boolSV(left >= right)); @@ -1648,7 +1582,7 @@ PP(pp_i_ge) PP(pp_i_eq) { - dSP; tryAMAGICbinSET(eq,0); + djSP; tryAMAGICbinSET(eq,0); { dPOPTOPiirl; SETs(boolSV(left == right)); @@ -1658,7 +1592,7 @@ PP(pp_i_eq) PP(pp_i_ne) { - dSP; tryAMAGICbinSET(ne,0); + djSP; tryAMAGICbinSET(ne,0); { dPOPTOPiirl; SETs(boolSV(left != right)); @@ -1668,7 +1602,7 @@ PP(pp_i_ne) PP(pp_i_ncmp) { - dSP; dTARGET; tryAMAGICbin(ncmp,0); + djSP; dTARGET; tryAMAGICbin(ncmp,0); { dPOPTOPiirl; I32 value; @@ -1686,7 +1620,7 @@ PP(pp_i_ncmp) PP(pp_i_negate) { - dSP; dTARGET; tryAMAGICun(neg); + djSP; dTARGET; tryAMAGICun(neg); SETi(-TOPi); RETURN; } @@ -1695,7 +1629,7 @@ PP(pp_i_negate) PP(pp_atan2) { - dSP; dTARGET; tryAMAGICbin(atan2,0); + djSP; dTARGET; tryAMAGICbin(atan2,0); { dPOPTOPnnrl; SETn(Perl_atan2(left, right)); @@ -1705,7 +1639,7 @@ PP(pp_atan2) PP(pp_sin) { - dSP; dTARGET; tryAMAGICun(sin); + djSP; dTARGET; tryAMAGICun(sin); { NV value; value = POPn; @@ -1717,7 +1651,7 @@ PP(pp_sin) PP(pp_cos) { - dSP; dTARGET; tryAMAGICun(cos); + djSP; dTARGET; tryAMAGICun(cos); { NV value; value = POPn; @@ -1744,7 +1678,7 @@ extern double drand48 (void); PP(pp_rand) { - dSP; dTARGET; + djSP; dTARGET; NV value; if (MAXARG < 1) value = 1.0; @@ -1763,7 +1697,7 @@ PP(pp_rand) PP(pp_srand) { - dSP; + djSP; UV anum; if (MAXARG < 1) anum = seed(); @@ -1800,6 +1734,7 @@ S_seed(pTHX) #define SEED_C3 269 #define SEED_C5 26107 + dTHR; #ifndef PERL_NO_DEV_RANDOM int fd; #endif @@ -1858,7 +1793,7 @@ S_seed(pTHX) PP(pp_exp) { - dSP; dTARGET; tryAMAGICun(exp); + djSP; dTARGET; tryAMAGICun(exp); { NV value; value = POPn; @@ -1870,12 +1805,12 @@ PP(pp_exp) PP(pp_log) { - dSP; dTARGET; tryAMAGICun(log); + djSP; dTARGET; tryAMAGICun(log); { NV value; value = POPn; if (value <= 0.0) { - SET_NUMERIC_STANDARD(); + RESTORE_NUMERIC_STANDARD(); DIE(aTHX_ "Can't take log of %g", value); } value = Perl_log(value); @@ -1886,12 +1821,12 @@ PP(pp_log) PP(pp_sqrt) { - dSP; dTARGET; tryAMAGICun(sqrt); + djSP; dTARGET; tryAMAGICun(sqrt); { NV value; value = POPn; if (value < 0.0) { - SET_NUMERIC_STANDARD(); + RESTORE_NUMERIC_STANDARD(); DIE(aTHX_ "Can't take sqrt of %g", value); } value = Perl_sqrt(value); @@ -1902,7 +1837,7 @@ PP(pp_sqrt) PP(pp_int) { - dSP; dTARGET; + djSP; dTARGET; { NV value = TOPn; IV iv; @@ -1912,24 +1847,11 @@ PP(pp_int) SETi(iv); } else { - if (value >= 0.0) { -#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE) - (void)Perl_modf(value, &value); -#else - double tmp = (double)value; - (void)Perl_modf(tmp, &tmp); - value = (NV)tmp; -#endif - } + if (value >= 0.0) + (void)Perl_modf(value, &value); else { -#if defined(HAS_MODFL) || defined(LONG_DOUBLE_EQUALS_DOUBLE) - (void)Perl_modf(-value, &value); - value = -value; -#else - double tmp = (double)value; - (void)Perl_modf(-tmp, &tmp); - value = -(NV)tmp; -#endif + (void)Perl_modf(-value, &value); + value = -value; } iv = I_V(value); if (iv == value) @@ -1943,7 +1865,7 @@ PP(pp_int) PP(pp_abs) { - dSP; dTARGET; tryAMAGICun(abs); + djSP; dTARGET; tryAMAGICun(abs); { NV value = TOPn; IV iv; @@ -1965,37 +1887,35 @@ PP(pp_abs) PP(pp_hex) { - dSP; dTARGET; + djSP; dTARGET; char *tmps; - STRLEN argtype; - STRLEN len; + I32 argtype; + STRLEN n_a; - tmps = (SvPVx(POPs, len)); - argtype = 1; /* allow underscores */ - XPUSHn(scan_hex(tmps, len, &argtype)); + tmps = POPpx; + XPUSHn(scan_hex(tmps, 99, &argtype)); RETURN; } PP(pp_oct) { - dSP; dTARGET; + djSP; dTARGET; NV value; - STRLEN argtype; + I32 argtype; char *tmps; - STRLEN len; + STRLEN n_a; - tmps = (SvPVx(POPs, len)); - while (*tmps && len && isSPACE(*tmps)) - tmps++, len--; + tmps = POPpx; + while (*tmps && isSPACE(*tmps)) + tmps++; if (*tmps == '0') - tmps++, len--; - argtype = 1; /* allow underscores */ + tmps++; if (*tmps == 'x') - value = scan_hex(++tmps, --len, &argtype); + value = scan_hex(++tmps, 99, &argtype); else if (*tmps == 'b') - value = scan_bin(++tmps, --len, &argtype); + value = scan_bin(++tmps, 99, &argtype); else - value = scan_oct(tmps, len, &argtype); + value = scan_oct(tmps, 99, &argtype); XPUSHn(value); RETURN; } @@ -2004,7 +1924,7 @@ PP(pp_oct) PP(pp_length) { - dSP; dTARGET; + djSP; dTARGET; SV *sv = TOPs; if (DO_UTF8(sv)) @@ -2016,61 +1936,48 @@ PP(pp_length) PP(pp_substr) { - dSP; dTARGET; + djSP; dTARGET; SV *sv; I32 len; STRLEN curlen; - STRLEN utf8_curlen; + STRLEN utfcurlen; I32 pos; I32 rem; I32 fail; - I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET; + I32 lvalue = PL_op->op_flags & OPf_MOD; char *tmps; I32 arybase = PL_curcop->cop_arybase; - SV *repl_sv = NULL; char *repl = 0; STRLEN repl_len; - int num_args = PL_op->op_private & 7; - bool repl_need_utf8_upgrade = FALSE; - bool repl_is_utf8 = FALSE; SvTAINTED_off(TARG); /* decontaminate */ SvUTF8_off(TARG); /* decontaminate */ - if (num_args > 2) { - if (num_args > 3) { - repl_sv = POPs; - repl = SvPV(repl_sv, repl_len); - repl_is_utf8 = DO_UTF8(repl_sv) && SvCUR(repl_sv); + if (MAXARG > 2) { + if (MAXARG > 3) { + sv = POPs; + repl = SvPV(sv, repl_len); } len = POPi; } pos = POPi; sv = POPs; PUTBACK; - if (repl_sv) { - if (repl_is_utf8) { - if (!DO_UTF8(sv)) - sv_utf8_upgrade(sv); - } - else if (DO_UTF8(sv)) - repl_need_utf8_upgrade = TRUE; - } tmps = SvPV(sv, curlen); if (DO_UTF8(sv)) { - utf8_curlen = sv_len_utf8(sv); - if (utf8_curlen == curlen) - utf8_curlen = 0; + utfcurlen = sv_len_utf8(sv); + if (utfcurlen == curlen) + utfcurlen = 0; else - curlen = utf8_curlen; + curlen = utfcurlen; } else - utf8_curlen = 0; + utfcurlen = 0; if (pos >= arybase) { pos -= arybase; rem = curlen-pos; fail = rem; - if (num_args > 2) { + if (MAXARG > 2) { if (len < 0) { rem += len; if (rem < 0) @@ -2082,7 +1989,7 @@ PP(pp_substr) } else { pos += curlen; - if (num_args < 3) + if (MAXARG < 3) rem = curlen; else if (len >= 0) { rem = pos+len; @@ -2107,29 +2014,14 @@ PP(pp_substr) RETPUSHUNDEF; } else { - I32 upos = pos; - I32 urem = rem; - if (utf8_curlen) + if (utfcurlen) { sv_pos_u2b(sv, &pos, &rem); + SvUTF8_on(TARG); + } tmps += pos; sv_setpvn(TARG, tmps, rem); - if (utf8_curlen) - SvUTF8_on(TARG); - if (repl) { - SV* repl_sv_copy = NULL; - - if (repl_need_utf8_upgrade) { - repl_sv_copy = newSVsv(repl_sv); - sv_utf8_upgrade(repl_sv_copy); - repl = SvPV(repl_sv_copy, repl_len); - repl_is_utf8 = DO_UTF8(repl_sv_copy) && SvCUR(sv); - } + if (repl) sv_insert(sv, pos, rem, repl, repl_len); - if (repl_is_utf8) - SvUTF8_on(sv); - if (repl_sv_copy) - SvREFCNT_dec(repl_sv_copy); - } else if (lvalue) { /* it's an lvalue! */ if (!SvGMAGICAL(sv)) { if (SvROK(sv)) { @@ -2140,7 +2032,7 @@ PP(pp_substr) "Attempt to use reference as lvalue in substr"); } if (SvOK(sv)) /* is it defined ? */ - (void)SvPOK_only_UTF8(sv); + (void)SvPOK_only(sv); else sv_setpvn(sv,"",0); /* avoid lexical reincarnation */ } @@ -2156,8 +2048,8 @@ PP(pp_substr) SvREFCNT_dec(LvTARG(TARG)); LvTARG(TARG) = SvREFCNT_inc(sv); } - LvTARGOFF(TARG) = upos; - LvTARGLEN(TARG) = urem; + LvTARGOFF(TARG) = pos; + LvTARGLEN(TARG) = rem; } } SPAGAIN; @@ -2167,11 +2059,11 @@ PP(pp_substr) PP(pp_vec) { - dSP; dTARGET; - register IV size = POPi; - register IV offset = POPi; + djSP; dTARGET; + register I32 size = POPi; + register I32 offset = POPi; register SV *src = POPs; - I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET; + I32 lvalue = PL_op->op_flags & OPf_MOD; SvTAINTED_off(TARG); /* decontaminate */ if (lvalue) { /* it's an lvalue! */ @@ -2196,7 +2088,7 @@ PP(pp_vec) PP(pp_index) { - dSP; dTARGET; + djSP; dTARGET; SV *big; SV *little; I32 offset; @@ -2232,7 +2124,7 @@ PP(pp_index) PP(pp_rindex) { - dSP; dTARGET; + djSP; dTARGET; SV *big; SV *little; STRLEN blen; @@ -2273,7 +2165,7 @@ PP(pp_rindex) PP(pp_sprintf) { - dSP; dMARK; dORIGMARK; dTARGET; + djSP; dMARK; dORIGMARK; dTARGET; do_sprintf(TARG, SP-MARK, MARK+1); TAINT_IF(SvTAINTED(TARG)); SP = ORIGMARK; @@ -2283,20 +2175,26 @@ PP(pp_sprintf) PP(pp_ord) { - dSP; dTARGET; - SV *argsv = POPs; - STRLEN len; - U8 *s = (U8*)SvPVx(argsv, len); + djSP; dTARGET; + UV value; + STRLEN n_a; + SV *tmpsv = POPs; + U8 *tmps = (U8*)SvPVx(tmpsv,n_a); + I32 retlen; - XPUSHu(DO_UTF8(argsv) ? utf8_to_uv_simple(s, 0) : (*s & 0xff)); + if ((*tmps & 0x80) && DO_UTF8(tmpsv)) + value = utf8_to_uv(tmps, &retlen); + else + value = (UV)(*tmps & 255); + XPUSHu(value); RETURN; } PP(pp_chr) { - dSP; dTARGET; + djSP; dTARGET; char *tmps; - UV value = POPu; + U32 value = POPu; (void)SvUPGRADE(TARG,SVt_PV); @@ -2317,6 +2215,7 @@ PP(pp_chr) tmps = SvPVX(TARG); *tmps++ = value; *tmps = '\0'; + SvUTF8_off(TARG); /* decontaminate */ (void)SvPOK_only(TARG); XPUSHs(TARG); RETURN; @@ -2324,7 +2223,7 @@ PP(pp_chr) PP(pp_crypt) { - dSP; dTARGET; dPOPTOPssrl; + djSP; dTARGET; dPOPTOPssrl; STRLEN n_a; #ifdef HAS_CRYPT char *tmps = SvPV(left, n_a); @@ -2343,16 +2242,16 @@ PP(pp_crypt) PP(pp_ucfirst) { - dSP; + djSP; SV *sv = TOPs; register U8 *s; STRLEN slen; - if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) { - STRLEN ulen; - U8 tmpbuf[UTF8_MAXLEN+1]; + if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) { + I32 ulen; + U8 tmpbuf[UTF8_MAXLEN]; U8 *tend; - UV uv = utf8_to_uv(s, slen, &ulen, 0); + UV uv = utf8_to_uv(s, &ulen); if (PL_op->op_private & OPpLOCALE) { TAINT; @@ -2402,16 +2301,16 @@ PP(pp_ucfirst) PP(pp_lcfirst) { - dSP; + djSP; SV *sv = TOPs; register U8 *s; STRLEN slen; - if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) { - STRLEN ulen; - U8 tmpbuf[UTF8_MAXLEN+1]; + if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && (*s & 0xc0) == 0xc0) { + I32 ulen; + U8 tmpbuf[UTF8_MAXLEN]; U8 *tend; - UV uv = utf8_to_uv(s, slen, &ulen, 0); + UV uv = utf8_to_uv(s, &ulen); if (PL_op->op_private & OPpLOCALE) { TAINT; @@ -2461,14 +2360,14 @@ PP(pp_lcfirst) PP(pp_uc) { - dSP; + djSP; SV *sv = TOPs; register U8 *s; STRLEN len; if (DO_UTF8(sv)) { dTARGET; - STRLEN ulen; + I32 ulen; register U8 *d; U8 *send; @@ -2488,7 +2387,7 @@ PP(pp_uc) TAINT; SvTAINTED_on(TARG); while (s < send) { - d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, len, &ulen, 0))); + d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, &ulen))); s += ulen; } } @@ -2535,14 +2434,14 @@ PP(pp_uc) PP(pp_lc) { - dSP; + djSP; SV *sv = TOPs; register U8 *s; STRLEN len; if (DO_UTF8(sv)) { dTARGET; - STRLEN ulen; + I32 ulen; register U8 *d; U8 *send; @@ -2562,7 +2461,7 @@ PP(pp_lc) TAINT; SvTAINTED_on(TARG); while (s < send) { - d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, len, &ulen, 0))); + d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, &ulen))); s += ulen; } } @@ -2610,7 +2509,7 @@ PP(pp_lc) PP(pp_quotemeta) { - dSP; dTARGET; + djSP; dTARGET; SV *sv = TOPs; STRLEN len; register char *s = SvPV(sv,len); @@ -2623,7 +2522,7 @@ PP(pp_quotemeta) d = SvPVX(TARG); if (DO_UTF8(sv)) { while (len) { - if (UTF8_IS_CONTINUED(*s)) { + if (*s & 0x80) { STRLEN ulen = UTF8SKIP(s); if (ulen > len) ulen = len; @@ -2649,7 +2548,7 @@ PP(pp_quotemeta) } *d = '\0'; SvCUR_set(TARG, d - SvPVX(TARG)); - (void)SvPOK_only_UTF8(TARG); + (void)SvPOK_only(TARG); } else sv_setpvn(TARG, s, len); @@ -2663,10 +2562,10 @@ PP(pp_quotemeta) PP(pp_aslice) { - dSP; dMARK; dORIGMARK; + djSP; dMARK; dORIGMARK; register SV** svp; register AV* av = (AV*)POPs; - register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); + register I32 lval = PL_op->op_flags & OPf_MOD; I32 arybase = PL_curcop->cop_arybase; I32 elem; @@ -2708,7 +2607,7 @@ PP(pp_aslice) PP(pp_each) { - dSP; + djSP; HV *hash = (HV*)POPs; HE *entry; I32 gimme = GIMME_V; @@ -2750,7 +2649,7 @@ PP(pp_keys) PP(pp_delete) { - dSP; + djSP; I32 gimme = GIMME_V; I32 discard = (gimme == G_VOID) ? G_DISCARD : 0; SV *sv; @@ -2814,7 +2713,7 @@ PP(pp_delete) PP(pp_exists) { - dSP; + djSP; SV *tmpsv; HV *hv; @@ -2851,9 +2750,9 @@ PP(pp_exists) PP(pp_hslice) { - dSP; dMARK; dORIGMARK; + djSP; dMARK; dORIGMARK; register HV *hv = (HV*)POPs; - register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET); + register I32 lval = PL_op->op_flags & OPf_MOD; I32 realhv = (SvTYPE(hv) == SVt_PVHV); if (!realhv && PL_op->op_private & OPpLVAL_INTRO) @@ -2893,7 +2792,7 @@ PP(pp_hslice) PP(pp_list) { - dSP; dMARK; + djSP; dMARK; if (GIMME != G_ARRAY) { if (++MARK <= SP) *MARK = *SP; /* unwanted list, return last item */ @@ -2906,7 +2805,7 @@ PP(pp_list) PP(pp_lslice) { - dSP; + djSP; SV **lastrelem = PL_stack_sp; SV **lastlelem = PL_stack_base + POPMARK; SV **firstlelem = PL_stack_base + POPMARK + 1; @@ -2961,7 +2860,7 @@ PP(pp_lslice) PP(pp_anonlist) { - dSP; dMARK; dORIGMARK; + djSP; dMARK; dORIGMARK; I32 items = SP - MARK; SV *av = sv_2mortal((SV*)av_make(items, MARK+1)); SP = ORIGMARK; /* av_make() might realloc stack_sp */ @@ -2971,7 +2870,7 @@ PP(pp_anonlist) PP(pp_anonhash) { - dSP; dMARK; dORIGMARK; + djSP; dMARK; dORIGMARK; HV* hv = (HV*)sv_2mortal((SV*)newHV()); while (MARK < SP) { @@ -2990,7 +2889,7 @@ PP(pp_anonhash) PP(pp_splice) { - dSP; dMARK; dORIGMARK; + djSP; dMARK; dORIGMARK; register AV *ary = (AV*)*++MARK; register SV **src; register SV **dst; @@ -3192,7 +3091,7 @@ PP(pp_splice) PP(pp_push) { - dSP; dMARK; dORIGMARK; dTARGET; + djSP; dMARK; dORIGMARK; dTARGET; register AV *ary = (AV*)*++MARK; register SV *sv = &PL_sv_undef; MAGIC *mg; @@ -3222,7 +3121,7 @@ PP(pp_push) PP(pp_pop) { - dSP; + djSP; AV *av = (AV*)POPs; SV *sv = av_pop(av); if (AvREAL(av)) @@ -3233,7 +3132,7 @@ PP(pp_pop) PP(pp_shift) { - dSP; + djSP; AV *av = (AV*)POPs; SV *sv = av_shift(av); EXTEND(SP, 1); @@ -3247,7 +3146,7 @@ PP(pp_shift) PP(pp_unshift) { - dSP; dMARK; dORIGMARK; dTARGET; + djSP; dMARK; dORIGMARK; dTARGET; register AV *ary = (AV*)*++MARK; register SV *sv; register I32 i = 0; @@ -3277,7 +3176,7 @@ PP(pp_unshift) PP(pp_reverse) { - dSP; dMARK; + djSP; dMARK; register SV *tmp; SV **oldsp = SP; @@ -3309,17 +3208,20 @@ PP(pp_reverse) U8* s = (U8*)SvPVX(TARG); U8* send = (U8*)(s + len); while (s < send) { - if (UTF8_IS_ASCII(*s)) { + if (*s < 0x80) { s++; continue; } else { - if (!utf8_to_uv_simple(s, 0)) - break; up = (char*)s; s += UTF8SKIP(s); down = (char*)(s - 1); - /* reverse this character */ + if (s > send || !((*down & 0xc0) == 0x80)) { + if (ckWARN_d(WARN_UTF8)) + Perl_warner(aTHX_ WARN_UTF8, + "Malformed UTF-8 character"); + break; + } while (down > up) { tmp = *up; *up++ = *down; @@ -3335,7 +3237,7 @@ PP(pp_reverse) *up++ = *down; *down-- = tmp; } - (void)SvPOK_only_UTF8(TARG); + (void)SvPOK_only(TARG); } SP = MARK + 1; SETTARG; @@ -3385,7 +3287,7 @@ S_mul128(pTHX_ SV *sv, U8 m) PP(pp_unpack) { - dSP; + djSP; dPOPPOPssrl; I32 start_sp_offset = SP - PL_stack_base; I32 gimme = GIMME_V; @@ -3403,9 +3305,9 @@ PP(pp_unpack) register char *str; /* These must not be in registers: */ - short ashort; + I16 ashort; int aint; - long along; + I32 along; #ifdef HAS_QUAD Quad_t aquad; #endif @@ -3701,9 +3603,7 @@ PP(pp_unpack) len = strend - s; if (checksum) { while (len-- > 0 && s < strend) { - STRLEN alen; - auint = utf8_to_uv((U8*)s, strend - s, &alen, 0); - along = alen; + auint = utf8_to_uv((U8*)s, &along); s += along; if (checksum > 32) cdouble += (NV)auint; @@ -3715,9 +3615,7 @@ PP(pp_unpack) EXTEND(SP, len); EXTEND_MORTAL(len); while (len-- > 0 && s < strend) { - STRLEN alen; - auint = utf8_to_uv((U8*)s, strend - s, &alen, 0); - along = alen; + auint = utf8_to_uv((U8*)s, &along); s += along; sv = NEWSV(37, 0); sv_setuv(sv, (UV)auint); @@ -3958,6 +3856,7 @@ PP(pp_unpack) if (checksum) { #if LONGSIZE != SIZE32 if (natint) { + long along; while (len-- > 0) { COPYNN(s, &along, sizeof(long)); s += sizeof(long); @@ -3971,9 +3870,6 @@ PP(pp_unpack) #endif { while (len-- > 0) { -#if LONGSIZE > SIZE32 && INTSIZE == SIZE32 - I32 along; -#endif COPY32(s, &along); #if LONGSIZE > SIZE32 if (along > 2147483647) @@ -3992,6 +3888,7 @@ PP(pp_unpack) EXTEND_MORTAL(len); #if LONGSIZE != SIZE32 if (natint) { + long along; while (len-- > 0) { COPYNN(s, &along, sizeof(long)); s += sizeof(long); @@ -4004,9 +3901,6 @@ PP(pp_unpack) #endif { while (len-- > 0) { -#if LONGSIZE > SIZE32 && INTSIZE == SIZE32 - I32 along; -#endif COPY32(s, &along); #if LONGSIZE > SIZE32 if (along > 2147483647) @@ -4128,7 +4022,7 @@ PP(pp_unpack) while ((len > 0) && (s < strend)) { auv = (auv << 7) | (*s & 0x7f); - if (UTF8_IS_ASCII(*s++)) { + if (!(*s++ & 0x80)) { bytes = 0; sv = NEWSV(40, 0); sv_setuv(sv, auv); @@ -4140,7 +4034,7 @@ PP(pp_unpack) char *t; STRLEN n_a; - sv = Perl_newSVpvf(aTHX_ "%.*"UVf, (int)TYPE_DIGITS(UV), auv); + sv = Perl_newSVpvf(aTHX_ "%.*Vu", (int)TYPE_DIGITS(UV), auv); while (s < strend) { sv = mul128(sv, *s & 0x7f); if (!(*s++ & 0x80)) { @@ -4472,12 +4366,11 @@ S_div128(pTHX_ SV *pnum, bool *done) PP(pp_pack) { - dSP; dMARK; dORIGMARK; dTARGET; + djSP; dMARK; dORIGMARK; dTARGET; register SV *cat = TARG; register I32 items; STRLEN fromlen; register char *pat = SvPVx(*++MARK, fromlen); - char *patcopy; register char *patend = pat + fromlen; register I32 len; I32 datumtype; @@ -4508,7 +4401,6 @@ PP(pp_pack) items = SP - MARK; MARK++; sv_setpvn(cat, "", 0); - patcopy = pat; while (pat < patend) { SV *lengthcode = Nullsv; #define NEXTFROM ( lengthcode ? lengthcode : items-- > 0 ? *MARK++ : &PL_sv_no) @@ -4516,12 +4408,8 @@ PP(pp_pack) #ifdef PERL_NATINT_PACK natint = 0; #endif - if (isSPACE(datumtype)) { - patcopy++; + if (isSPACE(datumtype)) continue; - } - if (datumtype == 'U' && pat == patcopy+1) - SvUTF8_on(cat); if (datumtype == '#') { while (pat < patend && *pat != '\n') pat++; @@ -4558,8 +4446,7 @@ PP(pp_pack) if ((*pat != 'a' && *pat != 'A' && *pat != 'Z') || pat[1] != '*') DIE(aTHX_ "/ must be followed by a*, A* or Z*"); lengthcode = sv_2mortal(newSViv(sv_len(items > 0 - ? *MARK : &PL_sv_no) - + (*pat == 'Z' ? 1 : 0))); + ? *MARK : &PL_sv_no))); } switch(datumtype) { default: @@ -4753,7 +4640,7 @@ PP(pp_pack) while (len-- > 0) { fromstr = NEXTFROM; auint = SvUV(fromstr); - SvGROW(cat, SvCUR(cat) + UTF8_MAXLEN + 1); + SvGROW(cat, SvCUR(cat) + UTF8_MAXLEN); SvCUR_set(cat, (char*)uv_to_utf8((U8*)SvEND(cat),auint) - SvPVX(cat)); } @@ -4857,14 +4744,10 @@ PP(pp_pack) DIE(aTHX_ "Cannot compress negative numbers"); if ( -#if UVSIZE > 4 && UVSIZE >= NVSIZE - adouble <= 0xffffffff -#else -# ifdef CXUX_BROKEN_CONSTANT_CONVERT +#ifdef CXUX_BROKEN_CONSTANT_CONVERT adouble <= UV_MAX_cxux -# else +#else adouble <= UV_MAX -# endif #endif ) { @@ -4907,9 +4790,8 @@ PP(pp_pack) do { double next = floor(adouble / 128); *--in = (unsigned char)(adouble - (next * 128)) | 0x80; - if (in <= buf) /* this cannot happen ;-) */ + if (--in < buf) /* this cannot happen ;-) */ DIE(aTHX_ "Cannot compress integer"); - in--; adouble = next; } while (adouble > 0); buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */ @@ -5066,21 +4948,19 @@ PP(pp_pack) PP(pp_split) { - dSP; dTARG; + djSP; dTARG; AV *ary; - register IV limit = POPi; /* note, negative is forever */ + register I32 limit = POPi; /* note, negative is forever */ SV *sv = POPs; STRLEN len; register char *s = SvPV(sv, len); - bool do_utf8 = DO_UTF8(sv); char *strend = s + len; register PMOP *pm; register REGEXP *rx; register SV *dstr; register char *m; I32 iters = 0; - STRLEN slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : (strend - s); - I32 maxiters = slen + 10; + I32 maxiters = (strend - s) + 10; I32 i; char *orig; I32 origlimit = limit; @@ -5098,7 +4978,7 @@ PP(pp_split) pm = (PMOP*)POPs; #endif if (!pm || !s) - DIE(aTHX_ "panic: pp_split"); + DIE(aTHX_ "panic: do_split"); rx = pm->op_pmregexp; TAINT_IF((pm->op_pmflags & PMf_LOCALE) && @@ -5174,8 +5054,6 @@ PP(pp_split) sv_setpvn(dstr, s, m-s); if (make_mortal) sv_2mortal(dstr); - if (do_utf8) - (void)SvUTF8_on(dstr); XPUSHs(dstr); s = m + 1; @@ -5196,8 +5074,6 @@ PP(pp_split) sv_setpvn(dstr, s, m-s); if (make_mortal) sv_2mortal(dstr); - if (do_utf8) - (void)SvUTF8_on(dstr); XPUSHs(dstr); s = m; } @@ -5207,11 +5083,11 @@ PP(pp_split) && !(rx->reganch & ROPT_ANCH)) { int tail = (rx->reganch & RE_INTUIT_TAIL); SV *csv = CALLREG_INTUIT_STRING(aTHX_ rx); + char c; len = rx->minlen; - if (len == 1 && !(rx->reganch & ROPT_UTF8) && !tail) { - STRLEN n_a; - char c = *SvPV(csv, n_a); + if (len == 1 && !tail) { + c = *SvPV(csv,len); while (--limit) { /*SUPPRESS 530*/ for (m = s; m < strend && *m != c; m++) ; @@ -5221,15 +5097,8 @@ PP(pp_split) sv_setpvn(dstr, s, m-s); if (make_mortal) sv_2mortal(dstr); - if (do_utf8) - (void)SvUTF8_on(dstr); XPUSHs(dstr); - /* The rx->minlen is in characters but we want to step - * s ahead by bytes. */ - if (do_utf8) - s = (char*)utf8_hop((U8*)m, len); - else - s = m + len; /* Fake \n at the end */ + s = m + 1; } } else { @@ -5243,20 +5112,13 @@ PP(pp_split) sv_setpvn(dstr, s, m-s); if (make_mortal) sv_2mortal(dstr); - if (do_utf8) - (void)SvUTF8_on(dstr); XPUSHs(dstr); - /* The rx->minlen is in characters but we want to step - * s ahead by bytes. */ - if (do_utf8) - s = (char*)utf8_hop((U8*)m, len); - else - s = m + len; /* Fake \n at the end */ + s = m + len; /* Fake \n at the end */ } } } else { - maxiters += slen * rx->nparens; + maxiters += (strend - s) * rx->nparens; while (s < strend && --limit /* && (!rx->check_substr || ((s = CALLREG_INTUIT_START(aTHX_ rx, sv, s, strend, @@ -5277,8 +5139,6 @@ PP(pp_split) sv_setpvn(dstr, s, m-s); if (make_mortal) sv_2mortal(dstr); - if (do_utf8) - (void)SvUTF8_on(dstr); XPUSHs(dstr); if (rx->nparens) { for (i = 1; i <= rx->nparens; i++) { @@ -5292,8 +5152,6 @@ PP(pp_split) dstr = NEWSV(33, 0); if (make_mortal) sv_2mortal(dstr); - if (do_utf8) - (void)SvUTF8_on(dstr); XPUSHs(dstr); } } @@ -5308,13 +5166,10 @@ PP(pp_split) /* keep field after final delim? */ if (s < strend || (iters && origlimit)) { - STRLEN l = strend - s; - dstr = NEWSV(34, l); - sv_setpvn(dstr, s, l); + dstr = NEWSV(34, strend-s); + sv_setpvn(dstr, s, strend-s); if (make_mortal) sv_2mortal(dstr); - if (do_utf8) - (void)SvUTF8_on(dstr); XPUSHs(dstr); iters++; } @@ -5371,6 +5226,7 @@ PP(pp_split) void Perl_unlock_condpair(pTHX_ void *svv) { + dTHR; MAGIC *mg = mg_find((SV*)svv, 'm'); if (!mg) @@ -5388,11 +5244,28 @@ Perl_unlock_condpair(pTHX_ void *svv) PP(pp_lock) { - dSP; + djSP; dTOPss; SV *retsv = sv; #ifdef USE_THREADS - sv_lock(sv); + MAGIC *mg; + + if (SvROK(sv)) + sv = SvRV(sv); + + mg = condpair_magic(sv); + MUTEX_LOCK(MgMUTEXP(mg)); + if (MgOWNER(mg) == thr) + MUTEX_UNLOCK(MgMUTEXP(mg)); + else { + while (MgOWNER(mg)) + COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); + MgOWNER(mg) = thr; + DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": pp_lock lock 0x%"UVxf"\n", + PTR2UV(thr), PTR2UV(sv));) + MUTEX_UNLOCK(MgMUTEXP(mg)); + SAVEDESTRUCTOR_X(Perl_unlock_condpair, sv); + } #endif /* USE_THREADS */ if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV || SvTYPE(retsv) == SVt_PVCV) { @@ -5405,7 +5278,7 @@ PP(pp_lock) PP(pp_threadsv) { #ifdef USE_THREADS - dSP; + djSP; EXTEND(SP, 1); if (PL_op->op_private & OPpLVAL_INTRO) PUSHs(*save_threadsv(PL_op->op_targ)); |
