# define DO_BO_UNPACK(var, type)
# define DO_BO_PACK(var, type)
-# define DO_BO_UNPACK_PTR(var, type, pre_cast)
-# define DO_BO_PACK_PTR(var, type, pre_cast)
+# define DO_BO_UNPACK_PTR(var, type, pre_cast, post_cast)
+# define DO_BO_PACK_PTR(var, type, pre_cast, post_cast)
# define DO_BO_UNPACK_N(var, type)
# define DO_BO_PACK_N(var, type)
# define DO_BO_UNPACK_P(var)
} \
} STMT_END
-# define DO_BO_UNPACK_PTR(var, type, pre_cast) \
+# define DO_BO_UNPACK_PTR(var, type, pre_cast, post_cast) \
STMT_START { \
switch (TYPE_ENDIANNESS(datumtype)) { \
case TYPE_IS_BIG_ENDIAN: \
- var = (void *) my_betoh ## type ((pre_cast) var); \
+ var = (post_cast*) my_betoh ## type ((pre_cast) var); \
break; \
case TYPE_IS_LITTLE_ENDIAN: \
- var = (void *) my_letoh ## type ((pre_cast) var); \
+ var = (post_cast *) my_letoh ## type ((pre_cast) var); \
break; \
default: \
break; \
} \
} STMT_END
-# define DO_BO_PACK_PTR(var, type, pre_cast) \
+# define DO_BO_PACK_PTR(var, type, pre_cast, post_cast) \
STMT_START { \
switch (TYPE_ENDIANNESS(datumtype)) { \
case TYPE_IS_BIG_ENDIAN: \
- var = (void *) my_htobe ## type ((pre_cast) var); \
+ var = (post_cast *) my_htobe ## type ((pre_cast) var); \
break; \
case TYPE_IS_LITTLE_ENDIAN: \
- var = (void *) my_htole ## type ((pre_cast) var); \
+ var = (post_cast *) my_htole ## type ((pre_cast) var); \
break; \
default: \
break; \
} STMT_END
# if PTRSIZE == INTSIZE
-# define DO_BO_UNPACK_P(var) DO_BO_UNPACK_PTR(var, i, int)
-# define DO_BO_PACK_P(var) DO_BO_PACK_PTR(var, i, int)
+# define DO_BO_UNPACK_P(var) DO_BO_UNPACK_PTR(var, i, int, void)
+# define DO_BO_PACK_P(var) DO_BO_PACK_PTR(var, i, int, void)
+# define DO_BO_UNPACK_PC(var) DO_BO_UNPACK_PTR(var, i, int, char)
+# define DO_BO_PACK_PC(var) DO_BO_PACK_PTR(var, i, int, char)
# elif PTRSIZE == LONGSIZE
-# define DO_BO_UNPACK_P(var) DO_BO_UNPACK_PTR(var, l, long)
-# define DO_BO_PACK_P(var) DO_BO_PACK_PTR(var, l, long)
+# define DO_BO_UNPACK_P(var) DO_BO_UNPACK_PTR(var, l, long, void)
+# define DO_BO_PACK_P(var) DO_BO_PACK_PTR(var, l, long, void)
+# define DO_BO_UNPACK_PC(var) DO_BO_UNPACK_PTR(var, l, long, char)
+# define DO_BO_PACK_PC(var) DO_BO_PACK_PTR(var, l, long, char)
# else
# define DO_BO_UNPACK_P(var) BO_CANT_DOIT(unpack, pointer)
# define DO_BO_PACK_P(var) BO_CANT_DOIT(pack, pointer)
if (bad & 1) {
/* Rewalk the string fragment while warning */
char *ptr;
- flags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
+ const int flags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
for (ptr = *s; ptr < from; ptr += UTF8SKIP(ptr)) {
if (ptr >= end) break;
utf8n_to_uvuni((U8 *) ptr, end-ptr, &retlen, flags);
if (utf8) gl *= UTF8_EXPAND; \
if ((cur) + gl >= (start) + SvLEN(cat)) { \
*cur = '\0'; \
- SvCUR(cat) = (cur) - (start); \
+ SvCUR_set((cat), (cur) - (start)); \
(start) = sv_exp_grow(aTHX_ cat, gl); \
(cur) = (start) + SvCUR(cat); \
} \
while (pat < patend) {
if (pat[0] == '#') {
pat++;
- pat = memchr(pat, '\n', patend-pat);
+ pat = (char *) memchr(pat, '\n', patend-pat);
if (!pat) return FALSE;
} else if (pat[0] == 'U') {
if (first || pat[1] == '0') return TRUE;
while (pat < patend) {
if (pat[0] != '#') return pat[0];
pat++;
- pat = memchr(pat, '\n', patend-pat);
+ pat = (char *) memchr(pat, '\n', patend-pat);
if (!pat) return 0;
pat++;
}
I32
Perl_unpack_str(pTHX_ char *pat, char *patend, char *s, char *strbeg, char *strend, char **new_s, I32 ocnt, U32 flags)
{
- tempsym_t sym = { 0 };
+ tempsym_t sym = { NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0, 0, NULL };
+ (void)strbeg;
+ (void)new_s;
+ (void)ocnt;
if (flags & FLAG_DO_UTF8) flags |= FLAG_WAS_UTF8;
else if (need_utf8(pat, patend)) {
I32
Perl_unpackstring(pTHX_ char *pat, char *patend, char *s, char *strend, U32 flags)
{
- tempsym_t sym = { 0 };
+ tempsym_t sym = { NULL, NULL, NULL, NULL, 0, 0, 0, 0, 0, 0, NULL };
if (flags & FLAG_DO_UTF8) flags |= FLAG_WAS_UTF8;
else if (need_utf8(pat, patend)) {
I32
S_unpack_rec(pTHX_ tempsym_t* symptr, char *s, char *strbeg, char *strend, char **new_s )
{
- dSP;
+ dVAR; dSP;
SV *sv;
I32 start_sp_offset = SP - PL_stack_base;
howlen_t howlen;
const int bits_in_uv = CHAR_BIT * sizeof(cuv);
bool beyond = FALSE;
bool explicit_length;
- bool unpack_only_one = (symptr->flags & FLAG_UNPACK_ONLY_ONE) != 0;
+ const bool unpack_only_one = (symptr->flags & FLAG_UNPACK_ONLY_ONE) != 0;
bool utf8 = (symptr->flags & FLAG_PARSE_UTF8) ? 1 : 0;
symptr->strbeg = s - strbeg;
while (next_symbol(symptr)) {
packprops_t props;
- I32 len, ai32;
+ I32 len;
I32 datumtype = symptr->code;
/* do first one only unless in list context
/ is implemented by unpacking the count, then popping it from the
props = packprops[TYPE_NO_ENDIANNESS(datumtype)];
if (props) {
/* props nonzero means we can process this letter. */
- long size = props & PACK_SIZE_MASK;
- long howmany = (strend - s) / size;
+ const long size = props & PACK_SIZE_MASK;
+ const long howmany = (strend - s) / size;
if (len > howmany)
len = howmany;
case '(':
{
tempsym_t savsym = *symptr;
- U32 group_modifiers = TYPE_MODIFIERS(datumtype & ~symptr->flags);
+ const U32 group_modifiers = TYPE_MODIFIERS(datumtype & ~symptr->flags);
symptr->flags |= group_modifiers;
symptr->patend = savsym.grpend;
symptr->previous = &savsym;
case '.' | TYPE_IS_SHRIEKING:
#endif
case '.': {
- char *from;
+ const char *from;
SV *sv;
#ifdef PERL_PACK_CAN_SHRIEKSIGN
- bool u8 = utf8 && !(datumtype & TYPE_IS_SHRIEKING);
+ const bool u8 = utf8 && !(datumtype & TYPE_IS_SHRIEKING);
#else /* PERL_PACK_CAN_SHRIEKSIGN */
- bool u8 = utf8;
+ const bool u8 = utf8;
#endif
if (howlen == e_star) from = strbeg;
else if (len <= 0) from = s;
from = group ? strbeg + group->strbeg : strbeg;
}
sv = from <= s ?
- newSVuv( u8 ? (UV) utf8_length(from, s) : (UV) (s-from)) :
- newSViv(-(u8 ? (IV) utf8_length(s, from) : (IV) (from-s)));
+ newSVuv( u8 ? (UV) utf8_length((const U8*)from, (const U8*)s) : (UV) (s-from)) :
+ newSViv(-(u8 ? (IV) utf8_length((const U8*)s, (const U8*)from) : (IV) (from-s)));
XPUSHs(sv_2mortal(sv));
break;
}
s -= len;
}
break;
- case 'x' | TYPE_IS_SHRIEKING:
+ case 'x' | TYPE_IS_SHRIEKING: {
+ I32 ai32;
if (!len) /* Avoid division by 0 */
len = 1;
if (utf8) ai32 = utf8_length((U8 *) strbeg, (U8 *) s) % len;
else ai32 = (s - strbeg) % len;
if (ai32 == 0) break;
len -= ai32;
+ }
/* FALL THROUGH */
case 'x':
if (utf8) {
str = SvPVX(sv);
if (datumtype == 'b') {
U8 bits = 0;
- ai32 = len;
+ I32 ai32 = len;
for (len = 0; len < ai32; len++) {
if (len & 7) bits >>= 1;
else if (utf8) {
}
} else {
U8 bits = 0;
- ai32 = len;
+ I32 ai32 = len;
for (len = 0; len < ai32; len++) {
if (len & 7) bits <<= 1;
else if (utf8) {
str = SvPVX(sv);
if (datumtype == 'h') {
U8 bits = 0;
- ai32 = len;
+ I32 ai32 = len;
for (len = 0; len < ai32; len++) {
if (len & 1) bits >>= 4;
else if (utf8) {
}
} else {
U8 bits = 0;
- ai32 = len;
+ I32 ai32 = len;
for (len = 0; len < ai32; len++) {
if (len & 1) bits <<= 4;
else if (utf8) {
while (len-- > 0) {
char *aptr;
SHIFT_VAR(utf8, s, strend, aptr, datumtype);
- DO_BO_UNPACK_P(aptr);
+ DO_BO_UNPACK_PC(aptr);
/* newSVpv generates undef if aptr is NULL */
PUSHs(sv_2mortal(newSVpv(aptr, 0)));
}
if (sizeof(char*) <= strend - s) {
char *aptr;
SHIFT_VAR(utf8, s, strend, aptr, datumtype);
- DO_BO_UNPACK_P(aptr);
+ DO_BO_UNPACK_PC(aptr);
/* newSVpvn generates undef if aptr is NULL */
PUSHs(sv_2mortal(newSVpvn(aptr, len)));
}
return (m);
}
-
+#define TEMPSYM_INIT(symptr, p, e) \
+ STMT_START { \
+ (symptr)->patptr = p; \
+ (symptr)->patend = e; \
+ (symptr)->grpbeg = NULL; \
+ (symptr)->grpend = NULL; \
+ (symptr)->grpend = NULL; \
+ (symptr)->code = 0; \
+ (symptr)->length = 0; \
+ (symptr)->howlen = 0; \
+ (symptr)->level = 0; \
+ (symptr)->flags = FLAG_PACK; \
+ (symptr)->strbeg = 0; \
+ (symptr)->previous = NULL; \
+ } STMT_END
/*
=for apidoc pack_cat
void
Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
{
- tempsym_t sym = { 0 };
- sym.patptr = pat;
- sym.patend = patend;
- sym.flags = FLAG_PACK;
+ tempsym_t sym;
+ (void)next_in_list;
+ (void)flags;
+
+ TEMPSYM_INIT(&sym, pat, patend);
(void)pack_rec( cat, &sym, beglist, endlist );
}
Perl_packlist(pTHX_ SV *cat, char *pat, register char *patend, register SV **beglist, SV **endlist )
{
STRLEN no_len;
- tempsym_t sym = { 0 };
+ tempsym_t sym;
- sym.patptr = pat;
- sym.patend = patend;
- sym.flags = FLAG_PACK;
+ TEMPSYM_INIT(&sym, pat, patend);
/* We're going to do changes through SvPVX(cat). Make sure it's valid.
Also make sure any UTF8 flag is loaded */
if (SvOOK(sv)) {
if (SvIVX(sv)) {
- SvLEN(sv) += SvIVX(sv);
+ SvLEN_set(sv, SvLEN(sv) + SvIVX(sv));
from_start -= SvIVX(sv);
SvIV_set(sv, 0);
}
}
if (SvLEN(sv) != 0)
Safefree(from_start);
- SvPVX(sv) = to_start;
- SvCUR(sv) = to_ptr - to_start;
- SvLEN(sv) = len;
+ SvPV_set(sv, to_start);
+ SvCUR_set(sv, to_ptr - to_start);
+ SvLEN_set(sv, len);
SvUTF8_on(sv);
}
if (cur < start+symptr->strbeg) {
/* Make sure group starts don't point into the void */
tempsym_t *group;
- STRLEN length = cur-start;
+ const STRLEN length = cur-start;
for (group = symptr;
group && length < group->strbeg;
group = group->previous) group->strbeg = length;
W_utf8:
if (cur > end) {
*cur = '\0';
- SvCUR(cat) = cur - start;
+ SvCUR_set(cat, cur - start);
GROWING(0, cat, start, cur, len+UTF8_MAXLEN);
end = start+SvLEN(cat)-UTF8_MAXLEN;
if (auv >= 0x100) {
if (!SvUTF8(cat)) {
*cur = '\0';
- SvCUR(cat) = cur - start;
+ SvCUR_set(cat, cur - start);
marked_upgrade(aTHX_ cat, symptr);
lookahead.flags |= FLAG_DO_UTF8;
lookahead.strbeg = symptr->strbeg;
}
if (cur >= end) {
*cur = '\0';
- SvCUR(cat) = cur - start;
+ SvCUR_set(cat, cur - start);
GROWING(0, cat, start, cur, len+1);
end = start+SvLEN(cat)-1;
}
0 : UNICODE_ALLOW_ANY);
if (cur+(endb-buffer)*UTF8_EXPAND >= end) {
*cur = '\0';
- SvCUR(cat) = cur - start;
+ SvCUR_set(cat, cur - start);
GROWING(0, cat, start, cur,
len+(endb-buffer)*UTF8_EXPAND);
end = start+SvLEN(cat);
} else {
if (cur >= end) {
*cur = '\0';
- SvCUR(cat) = cur - start;
+ SvCUR_set(cat, cur - start);
GROWING(0, cat, start, cur, len+UTF8_MAXLEN);
end = start+SvLEN(cat)-UTF8_MAXLEN;
}
if (anv < 0) {
*cur = '\0';
- SvCUR(cat) = cur - start;
+ SvCUR_set(cat, cur - start);
Perl_croak(aTHX_ "Cannot compress negative numbers in pack");
}
else
aptr = SvPV_force_flags(fromstr, n_a, 0);
}
- DO_BO_PACK_P(aptr);
+ DO_BO_PACK_PC(aptr);
PUSH_VAR(utf8, cur, aptr);
}
break;
if (!uni_to_bytes(aTHX_ &aptr, aend, buffer, todo,
'u' | TYPE_IS_PACK)) {
*cur = '\0';
- SvCUR(cat) = cur - start;
+ SvCUR_set(cat, cur - start);
Perl_croak(aTHX_ "Assertion: string is shorter than advertised");
}
end = doencodes(hunk, buffer, todo);
}
}
*cur = '\0';
- SvCUR(cat) = cur - start;
+ SvCUR_set(cat, cur - start);
no_change:
*symptr = lookahead;
}
https://perl5.git.perl.org / perl5.git / blobdiff