/* pp_pack.c
*
* Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, by Larry Wall and others
+ * 2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
char *t;
if (!strnEQ(s, "0000", 4)) { /* need to grow sv */
- SV * const tmpNew = newSVpvn("0000000000", 10);
+ SV * const tmpNew = newSVpvs("0000000000");
sv_catsv(tmpNew, sv);
SvREFCNT_dec(sv); /* free old sv */
# 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)
+# elif PTRSIZE == IVSIZE
+# define DO_BO_UNPACK_P(var) DO_BO_UNPACK_PTR(var, l, IV, void)
+# define DO_BO_PACK_P(var) DO_BO_PACK_PTR(var, l, IV, void)
+# define DO_BO_UNPACK_PC(var) DO_BO_UNPACK_PTR(var, l, IV, char)
+# define DO_BO_PACK_PC(var) DO_BO_PACK_PTR(var, l, IV, char)
# else
# define DO_BO_UNPACK_P(var) BO_CANT_DOIT(unpack, pointer)
# define DO_BO_PACK_P(var) BO_CANT_DOIT(pack, pointer)
STATIC bool
next_uni_uu(pTHX_ const char **s, const char *end, I32 *out)
{
+ dVAR;
STRLEN retlen;
const UV val = utf8n_to_uvchr((U8 *) *s, end-*s, &retlen, UTF8_CHECK_ONLY);
if (val >= 0x100 || !ISUUCHAR(val) ||
STRLEN glen = (in_len); \
if (utf8) glen *= UTF8_EXPAND; \
if ((cur) + glen >= (start) + SvLEN(cat)) { \
- (start) = sv_exp_grow(aTHX_ cat, glen); \
+ (start) = sv_exp_grow(cat, glen); \
(cur) = (start) + SvCUR(cat); \
} \
} STMT_END
if ((cur) + gl >= (start) + SvLEN(cat)) { \
*cur = '\0'; \
SvCUR_set((cat), (cur) - (start)); \
- (start) = sv_exp_grow(aTHX_ cat, gl); \
+ (start) = sv_exp_grow(cat, gl); \
(cur) = (start) + SvCUR(cat); \
} \
PUSH_BYTES(utf8, cur, buf, glen); \
}
/*
-=for apidoc unpack_str
-
-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 */
-
-I32
-Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s, const char *strbeg, const char *strend, char **new_s, I32 ocnt, U32 flags)
-{
- tempsym_t sym;
- PERL_UNUSED_ARG(strbeg);
- PERL_UNUSED_ARG(new_s);
- PERL_UNUSED_ARG(ocnt);
-
- if (flags & FLAG_DO_UTF8) flags |= FLAG_WAS_UTF8;
- else if (need_utf8(pat, patend)) {
- /* We probably should try to avoid this in case a scalar context call
- wouldn't get to the "U0" */
- STRLEN len = strend - s;
- s = (char *) bytes_to_utf8((U8 *) s, &len);
- SAVEFREEPV(s);
- strend = s + len;
- flags |= FLAG_DO_UTF8;
- }
-
- if (first_symbol(pat, patend) != 'U' && (flags & FLAG_DO_UTF8))
- flags |= FLAG_PARSE_UTF8;
-
- TEMPSYM_INIT(&sym, pat, patend, flags);
-
- return unpack_rec(&sym, s, s, strend, NULL );
-}
-
-/*
=for apidoc unpackstring
The engine implementing unpack() Perl function. C<unpackstring> puts the
break;
}
- sv = sv_2mortal(NEWSV(35, len ? len : 1));
+ sv = sv_2mortal(newSV(len ? len : 1));
SvPOK_on(sv);
str = SvPVX(sv);
if (datumtype == 'b') {
/* Preliminary length estimate, acceptable for utf8 too */
if (howlen == e_star || len > (strend - s) * 2)
len = (strend - s) * 2;
- sv = sv_2mortal(NEWSV(35, len ? len : 1));
+ sv = sv_2mortal(newSV(len ? len : 1));
SvPOK_on(sv);
str = SvPVX(sv);
if (datumtype == 'h') {
}
{
const STRLEN l = (STRLEN) (strend - s) * 3 / 4;
- sv = sv_2mortal(NEWSV(42, l));
+ sv = sv_2mortal(newSV(l));
if (l) SvPOK_on(sv);
}
if (utf8) {
PP(pp_unpack)
{
+ dVAR;
dSP;
dPOPPOPssrl;
I32 gimme = GIMME_V;
void
Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist )
{
+ dVAR;
STRLEN no_len;
tempsym_t sym;
Only grows the string if there is an actual lack of space
*/
STATIC char *
-sv_exp_grow(pTHX_ SV *sv, STRLEN needed) {
+S_sv_exp_grow(pTHX_ SV *sv, STRLEN needed) {
const STRLEN cur = SvCUR(sv);
const STRLEN len = SvLEN(sv);
STRLEN extend;
SV **
S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
{
+ dVAR;
tempsym_t lookahead;
I32 items = endlist - beglist;
bool found = next_symbol(symptr);
SV *fromstr;
STRLEN fromlen;
I32 len;
- SV *lengthcode = Nullsv;
+ SV *lengthcode = NULL;
I32 datumtype = symptr->code;
howlen_t howlen = symptr->howlen;
char *start = SvPVX(cat);
if (datumtype == 'B')
while (l++ < len) {
if (utf8_source) {
- UV val;
+ UV val = 0;
NEXT_UNI_VAL(val, cur, str, end, utf8_flags);
bits |= val & 1;
} else bits |= *str++ & 1;
/* datumtype == 'b' */
while (l++ < len) {
if (utf8_source) {
- UV val;
+ UV val = 0;
NEXT_UNI_VAL(val, cur, str, end, utf8_flags);
if (val & 1) bits |= 0x80;
} else if (*str++ & 1)
if (datumtype == 'H')
while (l++ < len) {
if (utf8_source) {
- UV val;
+ UV val = 0;
NEXT_UNI_VAL(val, cur, str, end, utf8_flags);
if (val < 256 && isALPHA(val))
bits |= (val + 9) & 0xf;
else
while (l++ < len) {
if (utf8_source) {
- UV val;
+ UV val = 0;
NEXT_UNI_VAL(val, cur, str, end, utf8_flags);
if (val < 256 && isALPHA(val))
bits |= ((val + 9) & 0xf) << 4;
PP(pp_pack)
{
- dSP; dMARK; dORIGMARK; dTARGET;
+ dVAR; dSP; dMARK; dORIGMARK; dTARGET;
register SV *cat = TARG;
STRLEN fromlen;
SV *pat_sv = *++MARK;
projects / p5sagit/p5-mst-13.2.git / blobdiff