X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doop.c;h=06b1b38d5c85f4e43518ecc9376448aab054bb26;hb=97017a809da405a36dfccf88d7bd13d26ca0e932;hp=36fb6b37f809d0a0674d6cb50d7263f681f4e3db;hpb=a50d7633b624bae17978449ecd97928ccd5098bb;p=p5sagit%2Fp5-mst-13.2.git diff --git a/doop.c b/doop.c index 36fb6b3..06b1b38 100644 --- a/doop.c +++ b/doop.c @@ -1,6 +1,6 @@ /* doop.c * - * Copyright (c) 1991-1999, 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. @@ -282,7 +282,7 @@ S_do_trans_CU_simple(pTHX_ SV *sv) UV extra = none + 1; UV final; UV uv; - U8 tmpbuf[10]; + U8 tmpbuf[UTF8_MAXLEN]; I32 bits = 16; s = (U8*)SvPV(sv, len); @@ -719,7 +719,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) if (offset >= srclen) retnum = 0; else - retnum = (UV) s[offset] << 8; + retnum = (UV) s[offset] << 8; } else if (size == 32) { if (offset >= srclen) @@ -737,6 +737,58 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) ((UV) s[offset + 1] << 16) + ( s[offset + 2] << 8); } +#ifdef UV_IS_QUAD + else if (size == 64) { + dTHR; + if (ckWARN(WARN_PORTABLE)) + Perl_warner(aTHX_ WARN_PORTABLE, + "Bit vector size > 32 non-portable"); + if (offset >= srclen) + retnum = 0; + else if (offset + 1 >= srclen) + retnum = + (UV) s[offset ] << 56; + else if (offset + 2 >= srclen) + retnum = + ((UV) s[offset ] << 56) + + ((UV) s[offset + 1] << 48); + else if (offset + 3 >= srclen) + retnum = + ((UV) s[offset ] << 56) + + ((UV) s[offset + 1] << 48) + + ((UV) s[offset + 2] << 40); + else if (offset + 4 >= srclen) + retnum = + ((UV) s[offset ] << 56) + + ((UV) s[offset + 1] << 48) + + ((UV) s[offset + 2] << 40) + + ((UV) s[offset + 3] << 32); + else if (offset + 5 >= srclen) + retnum = + ((UV) s[offset ] << 56) + + ((UV) s[offset + 1] << 48) + + ((UV) s[offset + 2] << 40) + + ((UV) s[offset + 3] << 32) + + ( s[offset + 4] << 24); + else if (offset + 6 >= srclen) + retnum = + ((UV) s[offset ] << 56) + + ((UV) s[offset + 1] << 48) + + ((UV) s[offset + 2] << 40) + + ((UV) s[offset + 3] << 32) + + ((UV) s[offset + 4] << 24) + + ((UV) s[offset + 5] << 16); + else + retnum = + ((UV) s[offset ] << 56) + + ((UV) s[offset + 1] << 48) + + ((UV) s[offset + 2] << 40) + + ((UV) s[offset + 3] << 32) + + ((UV) s[offset + 4] << 24) + + ((UV) s[offset + 5] << 16) + + ( s[offset + 6] << 8); + } +#endif } } else if (size < 8) @@ -747,7 +799,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) retnum = s[offset]; else if (size == 16) retnum = - ((UV) s[offset] << 8) + + ((UV) s[offset] << 8) + s[offset + 1]; else if (size == 32) retnum = @@ -755,6 +807,23 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size) ((UV) s[offset + 1] << 16) + ( s[offset + 2] << 8) + s[offset + 3]; +#ifdef UV_IS_QUAD + else if (size == 64) { + dTHR; + if (ckWARN(WARN_PORTABLE)) + Perl_warner(aTHX_ WARN_PORTABLE, + "Bit vector size > 32 non-portable"); + retnum = + ((UV) s[offset ] << 56) + + ((UV) s[offset + 1] << 48) + + ((UV) s[offset + 2] << 40) + + ((UV) s[offset + 3] << 32) + + ((UV) s[offset + 4] << 24) + + ((UV) s[offset + 5] << 16) + + ( s[offset + 6] << 8) + + s[offset + 7]; + } +#endif } return retnum; @@ -800,17 +869,33 @@ Perl_do_vecset(pTHX_ SV *sv) else { offset >>= 3; /* turn into byte offset */ if (size == 8) - s[offset] = lval & 255; + s[offset ] = lval & 0xff; else if (size == 16) { - s[offset] = (lval >> 8) & 255; - s[offset+1] = lval & 255; + s[offset ] = (lval >> 8) & 0xff; + s[offset+1] = lval & 0xff; } else if (size == 32) { - s[offset] = (lval >> 24) & 255; - s[offset+1] = (lval >> 16) & 255; - s[offset+2] = (lval >> 8) & 255; - s[offset+3] = lval & 255; + s[offset ] = (lval >> 24) & 0xff; + s[offset+1] = (lval >> 16) & 0xff; + s[offset+2] = (lval >> 8) & 0xff; + s[offset+3] = lval & 0xff; + } +#ifdef UV_IS_QUAD + else if (size == 64) { + dTHR; + if (ckWARN(WARN_PORTABLE)) + Perl_warner(aTHX_ WARN_PORTABLE, + "Bit vector size > 32 non-portable"); + s[offset ] = (lval >> 56) & 0xff; + s[offset+1] = (lval >> 48) & 0xff; + s[offset+2] = (lval >> 40) & 0xff; + s[offset+3] = (lval >> 32) & 0xff; + s[offset+4] = (lval >> 24) & 0xff; + s[offset+5] = (lval >> 16) & 0xff; + s[offset+6] = (lval >> 8) & 0xff; + s[offset+7] = lval & 0xff; } +#endif } SvSETMAGIC(targ); } @@ -839,7 +924,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) HE* entry; (void)hv_iterinit(hv); /*SUPPRESS 560*/ - while (entry = hv_iternext(hv)) + while ((entry = hv_iternext(hv))) do_chop(astr,hv_iterval(hv,entry)); return; } @@ -848,7 +933,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) s = SvPV(sv, len); if (len && !SvPOK(sv)) s = SvPV_force(sv, len); - if (IN_UTF8) { + if (DO_UTF8(sv)) { if (s && len) { char *send = s + len; char *start = s; @@ -861,22 +946,23 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv) *s = '\0'; SvCUR_set(sv, s - start); SvNIOK_off(sv); + SvUTF8_on(astr); } else sv_setpvn(astr, "", 0); } - else - if (s && len) { + else if (s && len) { s += --len; sv_setpvn(astr, s, 1); *s = '\0'; SvCUR_set(sv, len); + SvUTF8_off(sv); SvNIOK_off(sv); } else sv_setpvn(astr, "", 0); SvSETMAGIC(sv); -} +} I32 Perl_do_chomp(pTHX_ register SV *sv) @@ -908,7 +994,7 @@ Perl_do_chomp(pTHX_ register SV *sv) HE* entry; (void)hv_iterinit(hv); /*SUPPRESS 560*/ - while (entry = hv_iternext(hv)) + while ((entry = hv_iternext(hv))) count += do_chomp(hv_iterval(hv,entry)); return count; } @@ -974,6 +1060,13 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) I32 lensave; char *lsave; char *rsave; + bool left_utf = DO_UTF8(left); + bool right_utf = DO_UTF8(right); + + if (left_utf && !right_utf) + sv_utf8_upgrade(right); + if (!left_utf && right_utf) + sv_utf8_upgrade(left); if (sv != left || (optype != OP_BIT_AND && !SvOK(sv) && !SvGMAGICAL(sv))) sv_setpvn(sv, "", 0); /* avoid undef warning on |= and ^= */ @@ -998,6 +1091,69 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) } SvCUR_set(sv, len); (void)SvPOK_only(sv); + if (left_utf || right_utf) { + UV duc, luc, ruc; + STRLEN lulen = leftlen; + STRLEN rulen = rightlen; + STRLEN dulen = 0; + I32 ulen; + + if (optype != OP_BIT_AND) + dc = SvGROW(sv, leftlen+rightlen+1); + + switch (optype) { + case OP_BIT_AND: + while (lulen && rulen) { + luc = utf8_to_uv((U8*)lc, &ulen); + lc += ulen; + lulen -= ulen; + ruc = utf8_to_uv((U8*)rc, &ulen); + rc += ulen; + rulen -= ulen; + duc = luc & ruc; + dc = (char*)uv_to_utf8((U8*)dc, duc); + } + dulen = dc - SvPVX(sv); + SvCUR_set(sv, dulen); + break; + case OP_BIT_XOR: + while (lulen && rulen) { + luc = utf8_to_uv((U8*)lc, &ulen); + lc += ulen; + lulen -= ulen; + ruc = utf8_to_uv((U8*)rc, &ulen); + rc += ulen; + rulen -= ulen; + duc = luc ^ ruc; + dc = (char*)uv_to_utf8((U8*)dc, duc); + } + goto mop_up_utf; + case OP_BIT_OR: + while (lulen && rulen) { + luc = utf8_to_uv((U8*)lc, &ulen); + lc += ulen; + lulen -= ulen; + ruc = utf8_to_uv((U8*)rc, &ulen); + rc += ulen; + rulen -= ulen; + duc = luc | ruc; + dc = (char*)uv_to_utf8((U8*)dc, duc); + } + mop_up_utf: + dulen = dc - SvPVX(sv); + SvCUR_set(sv, dulen); + if (rulen) + sv_catpvn(sv, rc, rulen); + else if (lulen) + sv_catpvn(sv, lc, lulen); + else + *SvEND(sv) = '\0'; + break; + } + SvUTF8_on(sv); + goto finish; + } + else #ifdef LIBERAL if (len >= sizeof(long)*4 && !((long)dc % sizeof(long)) && @@ -1068,6 +1224,7 @@ Perl_do_vop(pTHX_ I32 optype, SV *sv, SV *left, SV *right) break; } } +finish: SvTAINT(sv); } @@ -1136,7 +1293,7 @@ Perl_do_kv(pTHX) EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues)); PUTBACK; /* hv_iternext and hv_iterval might clobber stack_sp */ - while (entry = hv_iternext(keys)) { + while ((entry = hv_iternext(keys))) { SPAGAIN; if (dokeys) XPUSHs(hv_iterkeysv(entry)); /* won't clobber stack_sp */