if (strchr(natstr, code))
code |= TYPE_IS_SHRIEKING;
else
- Perl_croak(aTHX_ "'!' allowed only after types %s in pack/unpack",
+ Perl_croak(aTHX_ "'!' allowed only after types %s in %s",
natstr, symptr->flags & FLAG_PACK ? "pack" : "unpack" );
}
/*
=for apidoc unpack_str
-The engine implementing unpack() Perl function.
+The engine implementing unpack() Perl function. Note: parameters strbeg, new_s
+and ocnt are not used. This call should not be used, use unpackstring instead.
=cut */
return unpack_rec(&sym, s, s, strend, NULL );
}
+/*
+=for apidoc unpackstring
+
+The engine implementing unpack() Perl function. C<unpackstring> puts the
+extracted list items on the stack and returns the number of elements.
+Issue C<PUTBACK> before and C<SPAGAIN> after the call to this function.
+
+=cut */
+
+I32
+Perl_unpackstring(pTHX_ char *pat, register char *patend, register char *s, char *strend, U32 flags)
+{
+ tempsym_t sym = { 0 };
+ sym.patptr = pat;
+ sym.patend = patend;
+ sym.flags = flags;
+
+ return unpack_rec(&sym, s, s, strend, NULL );
+}
+
STATIC
I32
S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, char *strend, char **new_s )
}
}
else {
+ short ashort;
if (len && unpack_only_one)
len = 1;
EXTEND(SP, len);
EXTEND_MORTAL(len);
- short ashort;
while (len-- > 0) {
COPYNN(s, &ashort, sizeof(short));
s += sizeof(short);
break;
case 'S' | TYPE_IS_SHRIEKING:
#if SHORTSIZE != SIZE16
- along = (strend - s) / SIZE16;
+ along = (strend - s) / sizeof(unsigned short);
if (len > along)
len = along;
if (checksum) {
PP(pp_unpack)
{
dSP;
- SV *right = (MAXARG > 1) ? POPs : GvSV(PL_defgv);
- SV *left = POPs;
+ dPOPPOPssrl;
I32 gimme = GIMME_V;
STRLEN llen;
STRLEN rlen;
register I32 cnt;
PUTBACK;
- cnt = unpack_str(pat, patend, s, s, strend, NULL, 0,
+ cnt = unpackstring(pat, patend, s, strend,
((gimme == G_SCALAR) ? FLAG_UNPACK_ONLY_ONE : 0)
| (DO_UTF8(right) ? FLAG_UNPACK_DO_UTF8 : 0));
/*
=for apidoc pack_cat
-The engine implementing pack() Perl function.
+The engine implementing pack() Perl function. Note: parameters next_in_list and
+flags are not used. This call should not be used; use packlist instead.
=cut */
tempsym_t sym = { 0 };
sym.patptr = pat;
sym.patend = patend;
- sym.flags = flags;
+ sym.flags = FLAG_PACK;
+
+ (void)pack_rec( cat, &sym, beglist, endlist );
+}
+
+
+/*
+=for apidoc packlist
+
+The engine implementing pack() Perl function.
+
+=cut */
+
+
+void
+Perl_packlist(pTHX_ SV *cat, char *pat, register char *patend, register SV **beglist, SV **endlist )
+{
+ tempsym_t sym = { 0 };
+ sym.patptr = pat;
+ sym.patend = patend;
+ sym.flags = FLAG_PACK;
(void)pack_rec( cat, &sym, beglist, endlist );
}
given 10**(NV_MAX_10_EXP+1) == 128 ** x solve for x:
x = (NV_MAX_10_EXP+1) * log (10) / log (128)
And with that many bytes only Inf can overflow.
+ Some C compilers are strict about integral constant
+ expressions so we conservatively divide by a slightly
+ smaller integer instead of multiplying by the exact
+ floating-point value.
*/
#ifdef NV_MAX_10_EXP
- char buf[1 + (int)((NV_MAX_10_EXP + 1) * 0.47456)];
+/* char buf[1 + (int)((NV_MAX_10_EXP + 1) * 0.47456)]; -- invalid C */
+ char buf[1 + (int)((NV_MAX_10_EXP + 1) / 2)]; /* valid C */
#else
- char buf[1 + (int)((308 + 1) * 0.47456)];
+/* char buf[1 + (int)((308 + 1) * 0.47456)]; -- invalid C */
+ char buf[1 + (int)((308 + 1) / 2)]; /* valid C */
#endif
char *in = buf + sizeof(buf);
MARK++;
sv_setpvn(cat, "", 0);
- pack_cat(cat, pat, patend, MARK, SP + 1, NULL, FLAG_PACK);
+ packlist(cat, pat, patend, MARK, SP + 1);
SvSETMAGIC(cat);
SP = ORIGMARK;