Some of the MAD structures in headers, plus PL_madskills and PL_xmlfp,

[perl5.git] / pp_pack.c

diff --git a/pp_pack.c b/pp_pack.c
index 479782e..a5b8163 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -1,7 +1,7 @@
 /*    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.
@@ -179,7 +179,7 @@ S_mul128(pTHX_ SV *sv, U8 m)
   char           *t;
 
   if (!strnEQ(s, "0000", 4)) {  /* need to grow sv */
-    SV             *tmpNew = newSVpvn("0000000000", 10);
+    SV * const tmpNew = newSVpvs("0000000000");
 
     sv_catsv(tmpNew, sv);
     SvREFCNT_dec(sv);          /* free old sv */
@@ -322,6 +322,11 @@ S_mul128(pTHX_ SV *sv, U8 m)
 #  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)
@@ -369,7 +374,7 @@ S_mul128(pTHX_ SV *sv, U8 m)
 typedef U8 packprops_t;
 #if 'J'-'I' == 1
 /* ASCII */
-const packprops_t packprops[512] = {
+STATIC const packprops_t packprops[512] = {
     /* normal */
     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
@@ -490,7 +495,7 @@ const packprops_t packprops[512] = {
 };
 #else
 /* EBCDIC (or bust) */
-const packprops_t packprops[512] = {
+STATIC const packprops_t packprops[512] = {
     /* normal */
     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
@@ -612,9 +617,8 @@ const packprops_t packprops[512] = {
 STATIC U8
 uni_to_byte(pTHX_ const char **s, const char *end, I32 datumtype)
 {
-    UV val;
     STRLEN retlen;
-    val = utf8n_to_uvchr((U8 *) *s, end-*s, &retlen,
+    UV val = utf8n_to_uvchr((U8 *) *s, end-*s, &retlen,
                         ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
     /* We try to process malformed UTF-8 as much as possible (preferrably with
        warnings), but these two mean we make no progress in the string and
@@ -685,9 +689,9 @@ uni_to_bytes(pTHX_ const char **s, const char *end, const char *buf, int buf_len
 STATIC bool
 next_uni_uu(pTHX_ const char **s, const char *end, I32 *out)
 {
-    UV val;
+    dVAR;
     STRLEN retlen;
-    val = utf8n_to_uvchr((U8 *) *s, end-*s, &retlen, UTF8_CHECK_ONLY);
+    const UV val = utf8n_to_uvchr((U8 *) *s, end-*s, &retlen, UTF8_CHECK_ONLY);
     if (val >= 0x100 || !ISUUCHAR(val) ||
        retlen == (STRLEN) -1 || retlen == 0) {
        *out = 0;
@@ -701,7 +705,7 @@ next_uni_uu(pTHX_ const char **s, const char *end, I32 *out)
 STATIC void
 bytes_to_uni(pTHX_ const U8 *start, STRLEN len, char **dest) {
     U8 buffer[UTF8_MAXLEN];
-    const U8 *end = start + len;
+    const U8 * const end = start + len;
     char *d = *dest;
     while (start < end) {
         const int length =
@@ -737,7 +741,7 @@ STMT_START {                                        \
     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
@@ -750,7 +754,7 @@ STMT_START {                                        \
     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);          \
@@ -943,7 +947,7 @@ STATIC bool
 S_next_symbol(pTHX_ tempsym_t* symptr )
 {
   const char* patptr = symptr->patptr;
-  const char* patend = symptr->patend;
+  const char* const patend = symptr->patend;
 
   symptr->flags &= ~FLAG_SLASH;
 
@@ -1533,7 +1537,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                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') {
@@ -1570,7 +1574,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
            /* 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') {
@@ -2035,7 +2039,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
            if (symptr->howlen == e_star)
                Perl_croak(aTHX_ "'P' must have an explicit size in unpack");
            EXTEND(SP, 1);
-           if (sizeof(char*) <= strend - s) {
+           if (s + sizeof(char*) <= strend) {
                char *aptr;
                SHIFT_VAR(utf8, s, strend, aptr, datumtype);
                DO_BO_UNPACK_PC(aptr);
@@ -2127,9 +2131,9 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
              * (and just as fast as doing character arithmetic)
              */
             if (PL_uudmap['M'] == 0) {
-                int i;
+               size_t i;
 
-                for (i = 0; i < sizeof(PL_uuemap); i += 1)
+               for (i = 0; i < sizeof(PL_uuemap); ++i)
                     PL_uudmap[(U8)PL_uuemap[i]] = i;
                 /*
                  * Because ' ' and '`' map to the same value,
@@ -2139,7 +2143,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
             }
            {
                 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) {
@@ -2271,6 +2275,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 
 PP(pp_unpack)
 {
+    dVAR;
     dSP;
     dPOPPOPssrl;
     I32 gimme = GIMME_V;
@@ -2421,6 +2426,7 @@ The engine implementing pack() Perl function.
 void
 Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist )
 {
+    dVAR;
     STRLEN no_len;
     tempsym_t sym;
 
@@ -2504,7 +2510,7 @@ marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) {
    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;
@@ -2517,6 +2523,7 @@ STATIC
 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);
@@ -2534,7 +2541,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
        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);
@@ -2987,7 +2994,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    ckWARN(WARN_PACK))
                    Perl_warner(aTHX_ packWARN(WARN_PACK),
                                "Character in 'c' format wrapped in pack");
-               PUSH_BYTE(utf8, cur, aiv & 0xff);
+               PUSH_BYTE(utf8, cur, (U8)(aiv & 0xff));
            }
            break;
        case 'C':
@@ -3004,7 +3011,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    ckWARN(WARN_PACK))
                    Perl_warner(aTHX_ packWARN(WARN_PACK),
                                "Character in 'C' format wrapped in pack");
-               *cur++ = aiv & 0xff;
+               *cur++ = (char)(aiv & 0xff);
            }
            break;
        case 'W': {
@@ -3522,7 +3529,6 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                SvGETMAGIC(fromstr);
                if (!SvOK(fromstr)) aptr = NULL;
                else {
-                   STRLEN n_a;
                    /* XXX better yet, could spirit away the string to
                     * a safe spot and hang on to it until the result
                     * of pack() (and all copies of the result) are
@@ -3534,9 +3540,9 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                                    "Attempt to pack pointer to temporary value");
                    }
                    if (SvPOK(fromstr) || SvNIOK(fromstr))
-                       aptr = SvPV_nomg_const(fromstr, n_a);
+                       aptr = SvPV_nomg_const_nolen(fromstr);
                    else
-                       aptr = SvPV_force_flags(fromstr, n_a, 0);
+                       aptr = SvPV_force_flags_nolen(fromstr, 0);
                }
                DO_BO_PACK_PC(aptr);
                PUSH_VAR(utf8, cur, aptr);
@@ -3550,7 +3556,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            if (len <= 2) len = 45;
            else len = len / 3 * 3;
            if (len >= 64) {
-               Perl_warner(aTHX_ packWARN(WARN_PACK),
+               if (ckWARN(WARN_PACK))
+                   Perl_warner(aTHX_ packWARN(WARN_PACK),
                            "Field too wide in 'u' format in pack");
                len = 63;
            }
@@ -3601,7 +3608,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 
 PP(pp_pack)
 {
-    dSP; dMARK; dORIGMARK; dTARGET;
+    dVAR; dSP; dMARK; dORIGMARK; dTARGET;
     register SV *cat = TARG;
     STRLEN fromlen;
     SV *pat_sv = *++MARK;