X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_pack.c;h=594144e5fd5fdd1c671a21f5b3129665a0932240;hb=ccfc67b7b0a9fa9e1a1cbb2090b71ea33fc44ae7;hp=7dc28747eb1e490c50927639e3d64244d4216f15;hpb=2e8215110ed322ac9933ec21f1d5eacadf7b18e6;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pp_pack.c b/pp_pack.c index 7dc2874..594144e 100644 --- a/pp_pack.c +++ b/pp_pack.c @@ -159,26 +159,17 @@ PP(pp_unpack) float afloat; double adouble; I32 checksum = 0; - register U32 culong = 0; + UV culong = 0; NV cdouble = 0.0; + const int bits_in_uv = 8 * sizeof(culong); int commas = 0; int star; #ifdef PERL_NATINT_PACK int natint; /* native integer */ int unatint; /* unsigned native integer */ #endif + bool do_utf8 = DO_UTF8(right); - if (gimme != G_ARRAY) { /* arrange to do first one only */ - /*SUPPRESS 530*/ - for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ; - if (strchr("aAZbBhHP", *patend) || *pat == '%') { - patend++; - while (isDIGIT(*patend) || *patend == '*') - patend++; - } - else - patend++; - } while (pat < patend) { reparse: datumtype = *pat++ & 0xFF; @@ -275,13 +266,14 @@ PP(pp_unpack) goto uchar_checksum; sv = NEWSV(35, len); sv_setpvn(sv, s, len); - s += len; if (datumtype == 'A' || datumtype == 'Z') { aptr = s; /* borrow register */ if (datumtype == 'Z') { /* 'Z' strips stuff after first null */ s = SvPVX(sv); while (*s) s++; + if (star) /* exact for 'Z*' */ + len = s - SvPVX(sv) + 1; } else { /* 'A' strips both nulls and spaces */ s = SvPVX(sv) + len - 1; @@ -292,6 +284,7 @@ PP(pp_unpack) SvCUR_set(sv, s - SvPVX(sv)); s = aptr; /* unborrow register */ } + s += len; XPUSHs(sv_2mortal(sv)); break; case 'B': @@ -399,7 +392,10 @@ PP(pp_unpack) aint = *s++; if (aint >= 128) /* fake up signed chars */ aint -= 256; - culong += aint; + if (checksum > bits_in_uv) + cdouble += (NV)aint; + else + culong += aint; } } else { @@ -416,6 +412,11 @@ PP(pp_unpack) } break; case 'C': + unpack_C: /* unpack U will jump here if not UTF-8 */ + if (len == 0) { + do_utf8 = FALSE; + break; + } if (len > strend - s) len = strend - s; if (checksum) { @@ -437,6 +438,12 @@ PP(pp_unpack) } break; case 'U': + if (len == 0) { + do_utf8 = TRUE; + break; + } + if (!do_utf8) + goto unpack_C; if (len > strend - s) len = strend - s; if (checksum) { @@ -445,7 +452,7 @@ PP(pp_unpack) auint = utf8n_to_uvchr((U8*)s, strend - s, &alen, 0); along = alen; s += along; - if (checksum > 32) + if (checksum > bits_in_uv) cdouble += (NV)auint; else culong += auint; @@ -480,7 +487,10 @@ PP(pp_unpack) while (len-- > 0) { COPYNN(s, &ashort, sizeof(short)); s += sizeof(short); - culong += ashort; + if (checksum > bits_in_uv) + cdouble += (NV)ashort; + else + culong += ashort; } } @@ -494,7 +504,10 @@ PP(pp_unpack) ashort -= 65536; #endif s += SIZE16; - culong += ashort; + if (checksum > bits_in_uv) + cdouble += (NV)ashort; + else + culong += ashort; } } } @@ -547,7 +560,10 @@ PP(pp_unpack) while (len-- > 0) { COPYNN(s, &aushort, sizeof(unsigned short)); s += sizeof(unsigned short); - culong += aushort; + if (checksum > bits_in_uv) + cdouble += (NV)aushort; + else + culong += aushort; } } else @@ -564,7 +580,10 @@ PP(pp_unpack) if (datumtype == 'v') aushort = vtohs(aushort); #endif - culong += aushort; + if (checksum > bits_in_uv) + cdouble += (NV)aushort; + else + culong += aushort; } } } @@ -611,7 +630,7 @@ PP(pp_unpack) while (len-- > 0) { Copy(s, &aint, 1, int); s += sizeof(int); - if (checksum > 32) + if (checksum > bits_in_uv) cdouble += (NV)aint; else culong += aint; @@ -662,7 +681,7 @@ PP(pp_unpack) while (len-- > 0) { Copy(s, &auint, 1, unsigned int); s += sizeof(unsigned int); - if (checksum > 32) + if (checksum > bits_in_uv) cdouble += (NV)auint; else culong += auint; @@ -701,7 +720,7 @@ PP(pp_unpack) while (len-- > 0) { COPYNN(s, &along, sizeof(long)); s += sizeof(long); - if (checksum > 32) + if (checksum > bits_in_uv) cdouble += (NV)along; else culong += along; @@ -720,7 +739,7 @@ PP(pp_unpack) along -= 4294967296; #endif s += SIZE32; - if (checksum > 32) + if (checksum > bits_in_uv) cdouble += (NV)along; else culong += along; @@ -778,7 +797,7 @@ PP(pp_unpack) while (len-- > 0) { COPYNN(s, &aulong, sizeof(unsigned long)); s += sizeof(unsigned long); - if (checksum > 32) + if (checksum > bits_in_uv) cdouble += (NV)aulong; else culong += aulong; @@ -798,7 +817,7 @@ PP(pp_unpack) if (datumtype == 'V') aulong = vtohl(aulong); #endif - if (checksum > 32) + if (checksum > bits_in_uv) cdouble += (NV)aulong; else culong += aulong; @@ -903,6 +922,8 @@ PP(pp_unpack) } break; case 'P': + if (star) + DIE(aTHX_ "P must have an explicit size"); EXTEND(SP, 1); if (sizeof(char*) > strend - s) break; @@ -920,43 +941,67 @@ PP(pp_unpack) along = (strend - s) / sizeof(Quad_t); if (len > along) len = along; - EXTEND(SP, len); - EXTEND_MORTAL(len); - while (len-- > 0) { - if (s + sizeof(Quad_t) > strend) - aquad = 0; - else { + if (checksum) { + while (len-- > 0) { Copy(s, &aquad, 1, Quad_t); s += sizeof(Quad_t); + if (checksum > bits_in_uv) + cdouble += (NV)aquad; + else + culong += aquad; } - sv = NEWSV(42, 0); - if (aquad >= IV_MIN && aquad <= IV_MAX) - sv_setiv(sv, (IV)aquad); - else - sv_setnv(sv, (NV)aquad); - PUSHs(sv_2mortal(sv)); } + else { + EXTEND(SP, len); + EXTEND_MORTAL(len); + while (len-- > 0) { + if (s + sizeof(Quad_t) > strend) + aquad = 0; + else { + Copy(s, &aquad, 1, Quad_t); + s += sizeof(Quad_t); + } + sv = NEWSV(42, 0); + if (aquad >= IV_MIN && aquad <= IV_MAX) + sv_setiv(sv, (IV)aquad); + else + sv_setnv(sv, (NV)aquad); + PUSHs(sv_2mortal(sv)); + } + } break; case 'Q': along = (strend - s) / sizeof(Quad_t); if (len > along) len = along; - EXTEND(SP, len); - EXTEND_MORTAL(len); - while (len-- > 0) { - if (s + sizeof(Uquad_t) > strend) - auquad = 0; - else { + if (checksum) { + while (len-- > 0) { Copy(s, &auquad, 1, Uquad_t); s += sizeof(Uquad_t); - } - sv = NEWSV(43, 0); - if (auquad <= UV_MAX) - sv_setuv(sv, (UV)auquad); - else + if (checksum > bits_in_uv) + cdouble += (NV)auquad; + else + culong += auquad; + } + } + else { + EXTEND(SP, len); + EXTEND_MORTAL(len); + while (len-- > 0) { + if (s + sizeof(Uquad_t) > strend) + auquad = 0; + else { + Copy(s, &auquad, 1, Uquad_t); + s += sizeof(Uquad_t); + } + sv = NEWSV(43, 0); + if (auquad <= UV_MAX) + sv_setuv(sv, (UV)auquad); + else sv_setnv(sv, (NV)auquad); - PUSHs(sv_2mortal(sv)); - } + PUSHs(sv_2mortal(sv)); + } + } break; #endif /* float and double added gnb@melba.bby.oz.au 22/11/89 */ @@ -1070,36 +1115,37 @@ PP(pp_unpack) if (checksum) { sv = NEWSV(42, 0); if (strchr("fFdD", datumtype) || - (checksum > 32 && strchr("iIlLNU", datumtype)) ) { + (checksum > bits_in_uv && strchr("csSiIlLnNUvVqQ", datumtype)) ) { NV trouble; - adouble = 1.0; + adouble = (NV) (1 << (checksum & 15)); while (checksum >= 16) { checksum -= 16; adouble *= 65536.0; } - while (checksum >= 4) { - checksum -= 4; - adouble *= 16.0; - } - while (checksum--) - adouble *= 2.0; - along = (1 << checksum) - 1; while (cdouble < 0.0) cdouble += adouble; cdouble = Perl_modf(cdouble / adouble, &trouble) * adouble; sv_setnv(sv, cdouble); } else { - if (checksum < 32) { - aulong = (1 << checksum) - 1; - culong &= aulong; + if (checksum < bits_in_uv) { + UV mask = ((UV)1 << checksum) - 1; + culong &= mask; } sv_setuv(sv, (UV)culong); } XPUSHs(sv_2mortal(sv)); checksum = 0; } + if (gimme != G_ARRAY && + SP - PL_stack_base == start_sp_offset + 1) { + /* do first one only unless in list context + / is implmented by unpacking the count, then poping it from the + stack, so must check that we're not in the middle of a / */ + if ((pat >= patend) || *pat != '/') + RETURN; + } } if (SP - PL_stack_base == start_sp_offset && gimme == G_SCALAR) PUSHs(&PL_sv_undef); @@ -1342,7 +1388,7 @@ PP(pp_pack) case 'a': fromstr = NEXTFROM; aptr = SvPV(fromstr, fromlen); - if (pat[-1] == '*') { + if (pat[lengthcode ? -2 : -1] == '*') { /* -2 after '/' */ len = fromlen; if (datumtype == 'Z') ++len; @@ -1797,7 +1843,7 @@ PP(pp_pack) fromstr = NEXTFROM; aptr = SvPV(fromstr, fromlen); SvGROW(cat, fromlen * 4 / 3); - if (len <= 1) + if (len <= 2) len = 45; else len = len / 3 * 3;