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;
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;
SvCUR_set(sv, s - SvPVX(sv));
s = aptr; /* unborrow register */
}
+ s += len;
XPUSHs(sv_2mortal(sv));
break;
case 'B':
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 {
}
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) {
}
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) {
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;
while (len-- > 0) {
COPYNN(s, &ashort, sizeof(short));
s += sizeof(short);
- culong += ashort;
+ if (checksum > bits_in_uv)
+ cdouble += (NV)ashort;
+ else
+ culong += ashort;
}
}
ashort -= 65536;
#endif
s += SIZE16;
- culong += ashort;
+ if (checksum > bits_in_uv)
+ cdouble += (NV)ashort;
+ else
+ culong += ashort;
}
}
}
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
if (datumtype == 'v')
aushort = vtohs(aushort);
#endif
- culong += aushort;
+ if (checksum > bits_in_uv)
+ cdouble += (NV)aushort;
+ else
+ culong += aushort;
}
}
}
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;
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;
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;
along -= 4294967296;
#endif
s += SIZE32;
- if (checksum > 32)
+ if (checksum > bits_in_uv)
cdouble += (NV)along;
else
culong += along;
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;
if (datumtype == 'V')
aulong = vtohl(aulong);
#endif
- if (checksum > 32)
+ if (checksum > bits_in_uv)
cdouble += (NV)aulong;
else
culong += aulong;
}
break;
case 'P':
+ if (star)
+ DIE(aTHX_ "P must have an explicit size");
EXTEND(SP, 1);
if (sizeof(char*) > strend - s)
break;
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 */
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);
case 'a':
fromstr = NEXTFROM;
aptr = SvPV(fromstr, fromlen);
- if (pat[-1] == '*') {
+ if (pat[lengthcode ? -2 : -1] == '*') { /* -2 after '/' */
len = fromlen;
if (datumtype == 'Z')
++len;
fromstr = NEXTFROM;
aptr = SvPV(fromstr, fromlen);
SvGROW(cat, fromlen * 4 / 3);
- if (len <= 1)
+ if (len <= 2)
len = 45;
else
len = len / 3 * 3;
https://perl5.git.perl.org / perl5.git / blobdiff