This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Fix documentation of WITH_LC_NUMERIC_foo
[perl5.git] / pp_pack.c
diff --git a/pp_pack.c b/pp_pack.c
index 9ed8c59..33cb086 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -45,11 +45,11 @@ typedef struct tempsym {
   const char*    grpbeg;   /* 1st char of ()-group  */
   const char*    grpend;   /* end of ()-group       */
   I32      code;     /* template code (!<>)   */
   const char*    grpbeg;   /* 1st char of ()-group  */
   const char*    grpend;   /* end of ()-group       */
   I32      code;     /* template code (!<>)   */
-  I32      length;   /* length/repeat count   */
-  howlen_t howlen;   /* how length is given   */ 
-  int      level;    /* () nesting level      */
   U32      flags;    /* /=4, comma=2, pack=1  */
                      /*   and group modifiers */
   U32      flags;    /* /=4, comma=2, pack=1  */
                      /*   and group modifiers */
+  SSize_t  length;   /* length/repeat count   */
+  howlen_t howlen;   /* how length is given   */ 
+  int      level;    /* () nesting level      */
   STRLEN   strbeg;   /* offset of group start */
   struct tempsym *previous; /* previous group */
 } tempsym_t;
   STRLEN   strbeg;   /* offset of group start */
   struct tempsym *previous; /* previous group */
 } tempsym_t;
@@ -112,21 +112,17 @@ typedef union {
 /* CROSSCOMPILE and MULTIARCH are going to affect pp_pack() and pp_unpack().
    --jhi Feb 1999 */
 
 /* CROSSCOMPILE and MULTIARCH are going to affect pp_pack() and pp_unpack().
    --jhi Feb 1999 */
 
-#if U16SIZE > SIZE16 || U32SIZE > SIZE32
-#  if BYTEORDER == 0x1234 || BYTEORDER == 0x12345678    /* little-endian */
-#    define OFF16(p)   ((char*)(p))
-#    define OFF32(p)   ((char*)(p))
-#  else
-#    if BYTEORDER == 0x4321 || BYTEORDER == 0x87654321  /* big-endian */
-#      define OFF16(p) ((char*)(p) + (sizeof(U16) - SIZE16))
-#      define OFF32(p) ((char*)(p) + (sizeof(U32) - SIZE32))
-#    else
-       ++++ bad cray byte order
-#    endif
-#  endif
-#else
+#if U16SIZE <= SIZE16 && U32SIZE <= SIZE32
 #  define OFF16(p)     ((char *) (p))
 #  define OFF32(p)     ((char *) (p))
 #  define OFF16(p)     ((char *) (p))
 #  define OFF32(p)     ((char *) (p))
+#elif BYTEORDER == 0x1234 || BYTEORDER == 0x12345678    /* little-endian */
+#  define OFF16(p)     ((char*)(p))
+#  define OFF32(p)     ((char*)(p))
+#elif BYTEORDER == 0x4321 || BYTEORDER == 0x87654321  /* big-endian */
+#  define OFF16(p)     ((char*)(p) + (sizeof(U16) - SIZE16))
+#  define OFF32(p)     ((char*)(p) + (sizeof(U32) - SIZE32))
+#else
+#  error "bad cray byte order"
 #endif
 
 #define PUSH16(utf8, cur, p, needs_swap)                        \
 #endif
 
 #define PUSH16(utf8, cur, p, needs_swap)                        \
@@ -142,7 +138,7 @@ typedef union {
 #  error "Unsupported byteorder"
         /* Need to add code here to re-instate mixed endian support.
            NEEDS_SWAP would need to hold a flag indicating which action to
 #  error "Unsupported byteorder"
         /* Need to add code here to re-instate mixed endian support.
            NEEDS_SWAP would need to hold a flag indicating which action to
-           take, and S_reverse_copy and the code in uni_to_bytes would need
+           take, and S_reverse_copy and the code in S_utf8_to_bytes would need
            logic adding to deal with any mixed-endian transformations needed.
         */
 #endif
            logic adding to deal with any mixed-endian transformations needed.
         */
 #endif
@@ -151,7 +147,7 @@ typedef union {
 #define SHIFT_BYTES(utf8, s, strend, buf, len, datumtype, needs_swap)  \
 STMT_START {                                           \
     if (UNLIKELY(utf8)) {                               \
 #define SHIFT_BYTES(utf8, s, strend, buf, len, datumtype, needs_swap)  \
 STMT_START {                                           \
     if (UNLIKELY(utf8)) {                               \
-        if (!uni_to_bytes(aTHX_ &s, strend,            \
+        if (!S_utf8_to_bytes(aTHX_ &s, strend,         \
          (char *) (buf), len, datumtype)) break;       \
     } else {                                           \
         if (UNLIKELY(needs_swap))                       \
          (char *) (buf), len, datumtype)) break;       \
     } else {                                           \
         if (UNLIKELY(needs_swap))                       \
@@ -195,7 +191,7 @@ S_mul128(pTHX_ SV *sv, U8 m)
 
   PERL_ARGS_ASSERT_MUL128;
 
 
   PERL_ARGS_ASSERT_MUL128;
 
-  if (!strnEQ(s, "0000", 4)) {  /* need to grow sv */
+  if (! memBEGINs(s, len, "0000")) {  /* need to grow sv */
     SV * const tmpNew = newSVpvs("0000000000");
 
     sv_catsv(tmpNew, sv);
     SV * const tmpNew = newSVpvs("0000000000");
 
     sv_catsv(tmpNew, sv);
@@ -216,16 +212,8 @@ S_mul128(pTHX_ SV *sv, U8 m)
 
 /* Explosives and implosives. */
 
 
 /* Explosives and implosives. */
 
-#if 'I' == 73 && 'J' == 74
-/* On an ASCII/ISO kind of system */
-#define ISUUCHAR(ch)    ((ch) >= ' ' && (ch) < 'a')
-#else
-/*
-  Some other sort of character set - use memchr() so we don't match
-  the null byte.
- */
-#define ISUUCHAR(ch)    (memchr(PL_uuemap, (ch), sizeof(PL_uuemap)-1) || (ch) == ' ')
-#endif
+#define ISUUCHAR(ch)    (NATIVE_TO_LATIN1(ch) >= NATIVE_TO_LATIN1(' ')  \
+                      && NATIVE_TO_LATIN1(ch) <  NATIVE_TO_LATIN1('a'))
 
 /* type modifiers */
 #define TYPE_IS_SHRIEKING      0x100
 
 /* type modifiers */
 #define TYPE_IS_SHRIEKING      0x100
@@ -245,7 +233,7 @@ S_mul128(pTHX_ SV *sv, U8 m)
 #define PACK_SIZE_UNPREDICTABLE                0x40    /* Not a fixed size element */
 #define PACK_SIZE_MASK                 0x3F
 
 #define PACK_SIZE_UNPREDICTABLE                0x40    /* Not a fixed size element */
 #define PACK_SIZE_MASK                 0x3F
 
-#include "packsizetables.c"
+#include "packsizetables.inc"
 
 static void
 S_reverse_copy(const char *src, char *dest, STRLEN len)
 
 static void
 S_reverse_copy(const char *src, char *dest, STRLEN len)
@@ -256,15 +244,18 @@ S_reverse_copy(const char *src, char *dest, STRLEN len)
 }
 
 STATIC U8
 }
 
 STATIC U8
-uni_to_byte(pTHX_ const char **s, const char *end, I32 datumtype)
+utf8_to_byte(pTHX_ const char **s, const char *end, I32 datumtype)
 {
     STRLEN retlen;
 {
     STRLEN retlen;
-    UV val = utf8n_to_uvchr((U8 *) *s, end-*s, &retlen,
+    UV val;
+
+    if (*s >= end) {
+       goto croak;
+    }
+    val = utf8n_to_uvchr((U8 *) *s, end-*s, &retlen,
                         ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
                         ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
-    /* We try to process malformed UTF-8 as much as possible (preferably with
-       warnings), but these two mean we make no progress in the string and
-       might enter an infinite loop */
-    if (retlen == (STRLEN) -1 || retlen == 0)
+    if (retlen == (STRLEN) -1)
+      croak:
        Perl_croak(aTHX_ "Malformed UTF-8 string in '%c' format in unpack",
                   (int) TYPE_NO_MODIFIERS(datumtype));
     if (val >= 0x100) {
        Perl_croak(aTHX_ "Malformed UTF-8 string in '%c' format in unpack",
                   (int) TYPE_NO_MODIFIERS(datumtype));
     if (val >= 0x100) {
@@ -278,11 +269,11 @@ uni_to_byte(pTHX_ const char **s, const char *end, I32 datumtype)
 }
 
 #define SHIFT_BYTE(utf8, s, strend, datumtype) ((utf8) ? \
 }
 
 #define SHIFT_BYTE(utf8, s, strend, datumtype) ((utf8) ? \
-       uni_to_byte(aTHX_ &(s), (strend), (datumtype)) : \
+       utf8_to_byte(aTHX_ &(s), (strend), (datumtype)) : \
        *(U8 *)(s)++)
 
 STATIC bool
        *(U8 *)(s)++)
 
 STATIC bool
-uni_to_bytes(pTHX_ const char **s, const char *end, const char *buf, int buf_len, I32 datumtype)
+S_utf8_to_bytes(pTHX_ const char **s, const char *end, const char *buf, SSize_t buf_len, I32 datumtype)
 {
     UV val;
     STRLEN retlen;
 {
     UV val;
     STRLEN retlen;
@@ -298,8 +289,8 @@ uni_to_bytes(pTHX_ const char **s, const char *end, const char *buf, int buf_len
     for (;buf_len > 0; buf_len--) {
        if (from >= end) return FALSE;
        val = utf8n_to_uvchr((U8 *) from, end-from, &retlen, flags);
     for (;buf_len > 0; buf_len--) {
        if (from >= end) return FALSE;
        val = utf8n_to_uvchr((U8 *) from, end-from, &retlen, flags);
-       if (retlen == (STRLEN) -1 || retlen == 0) {
-           from += UTF8SKIP(from);
+       if (retlen == (STRLEN) -1) {
+           from += UTF8_SAFE_SKIP(from, end);
            bad |= 1;
        } else from += retlen;
        if (val >= 0x100) {
            bad |= 1;
        } else from += retlen;
        if (val >= 0x100) {
@@ -316,7 +307,7 @@ uni_to_bytes(pTHX_ const char **s, const char *end, const char *buf, int buf_len
        if (bad & 1) {
            /* Rewalk the string fragment while warning */
            const char *ptr;
        if (bad & 1) {
            /* Rewalk the string fragment while warning */
            const char *ptr;
-           const int flags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
+           const U32 flags = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
            for (ptr = *s; ptr < from; ptr += UTF8SKIP(ptr)) {
                if (ptr >= end) break;
                utf8n_to_uvchr((U8 *) ptr, end-ptr, &retlen, flags);
            for (ptr = *s; ptr < from; ptr += UTF8SKIP(ptr)) {
                if (ptr >= end) break;
                utf8n_to_uvchr((U8 *) ptr, end-ptr, &retlen, flags);
@@ -334,24 +325,9 @@ uni_to_bytes(pTHX_ const char **s, const char *end, const char *buf, int buf_len
     return TRUE;
 }
 
     return TRUE;
 }
 
-STATIC bool
-next_uni_uu(pTHX_ const char **s, const char *end, I32 *out)
-{
-    STRLEN retlen;
-    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;
-       return FALSE;
-    }
-    *out = PL_uudmap[val] & 077;
-    *s += retlen;
-    return TRUE;
-}
-
 STATIC char *
 STATIC char *
-S_bytes_to_uni(const U8 *start, STRLEN len, char *dest, const bool needs_swap) {
-    PERL_ARGS_ASSERT_BYTES_TO_UNI;
+S_my_bytes_to_utf8(const U8 *start, STRLEN len, char *dest, const bool needs_swap) {
+    PERL_ARGS_ASSERT_MY_BYTES_TO_UTF8;
 
     if (UNLIKELY(needs_swap)) {
         const U8 *p = start + len;
 
     if (UNLIKELY(needs_swap)) {
         const U8 *p = start + len;
@@ -371,7 +347,7 @@ S_bytes_to_uni(const U8 *start, STRLEN len, char *dest, const bool needs_swap) {
 #define PUSH_BYTES(utf8, cur, buf, len, needs_swap)             \
 STMT_START {                                                   \
     if (UNLIKELY(utf8))                                                \
 #define PUSH_BYTES(utf8, cur, buf, len, needs_swap)             \
 STMT_START {                                                   \
     if (UNLIKELY(utf8))                                                \
-       (cur) = S_bytes_to_uni((U8 *) buf, len, (cur), needs_swap);       \
+       (cur) = my_bytes_to_utf8((U8 *) buf, len, (cur), needs_swap);       \
     else {                                                     \
         if (UNLIKELY(needs_swap))                               \
             S_reverse_copy((char *)(buf), cur, len);            \
     else {                                                     \
         if (UNLIKELY(needs_swap))                               \
             S_reverse_copy((char *)(buf), cur, len);            \
@@ -381,11 +357,28 @@ STMT_START {                                                      \
     }                                                          \
 } STMT_END
 
     }                                                          \
 } STMT_END
 
+#define SAFE_UTF8_EXPAND(var)  \
+STMT_START {                           \
+    if ((var) > SSize_t_MAX / UTF8_EXPAND) \
+        Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \
+    (var) = (var) * UTF8_EXPAND; \
+} STMT_END
+
+#define GROWING2(utf8, cat, start, cur, item_size, item_count) \
+STMT_START {                                                   \
+    if (SSize_t_MAX / (item_size) < (item_count))              \
+        Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \
+    GROWING((utf8), (cat), (start), (cur), (item_size) * (item_count)); \
+} STMT_END
+
 #define GROWING(utf8, cat, start, cur, in_len) \
 STMT_START {                                   \
     STRLEN glen = (in_len);                    \
 #define GROWING(utf8, cat, start, cur, in_len) \
 STMT_START {                                   \
     STRLEN glen = (in_len);                    \
-    if (utf8) glen *= UTF8_EXPAND;             \
-    if ((cur) + glen >= (start) + SvLEN(cat)) {        \
+    STRLEN catcur = (STRLEN)((cur) - (start)); \
+    if (utf8) SAFE_UTF8_EXPAND(glen);          \
+    if (SSize_t_MAX - glen < catcur)           \
+        Perl_croak(aTHX_ "%s", "Out of memory during pack()"); \
+    if (catcur + glen >= SvLEN(cat)) { \
        (start) = sv_exp_grow(cat, glen);       \
        (cur) = (start) + SvCUR(cat);           \
     }                                          \
        (start) = sv_exp_grow(cat, glen);       \
        (cur) = (start) + SvCUR(cat);           \
     }                                          \
@@ -395,7 +388,7 @@ STMT_START {                                        \
 STMT_START {                                   \
     const STRLEN glen = (in_len);              \
     STRLEN gl = glen;                          \
 STMT_START {                                   \
     const STRLEN glen = (in_len);              \
     STRLEN gl = glen;                          \
-    if (utf8) gl *= UTF8_EXPAND;               \
+    if (utf8) SAFE_UTF8_EXPAND(gl);            \
     if ((cur) + gl >= (start) + SvLEN(cat)) {  \
         *cur = '\0';                           \
         SvCUR_set((cat), (cur) - (start));     \
     if ((cur) + gl >= (start) + SvLEN(cat)) {  \
         *cur = '\0';                           \
         SvCUR_set((cat), (cur) - (start));     \
@@ -409,7 +402,7 @@ STMT_START {                                        \
 STMT_START {                                   \
     if (utf8) {                                        \
        const U8 au8 = (byte);                  \
 STMT_START {                                   \
     if (utf8) {                                        \
        const U8 au8 = (byte);                  \
-       (s) = S_bytes_to_uni(&au8, 1, (s), 0);  \
+       (s) = my_bytes_to_utf8(&au8, 1, (s), 0);\
     } else *(U8 *)(s)++ = (byte);              \
 } STMT_END
 
     } else *(U8 *)(s)++ = (byte);              \
 } STMT_END
 
@@ -419,7 +412,7 @@ STMT_START {                                                        \
     STRLEN retlen;                                             \
     if (str >= end) break;                                     \
     val = utf8n_to_uvchr((U8 *) str, end-str, &retlen, utf8_flags);    \
     STRLEN retlen;                                             \
     if (str >= end) break;                                     \
     val = utf8n_to_uvchr((U8 *) str, end-str, &retlen, utf8_flags);    \
-    if (retlen == (STRLEN) -1 || retlen == 0) {                        \
+    if (retlen == (STRLEN) -1) {                               \
        *cur = '\0';                                            \
        Perl_croak(aTHX_ "Malformed UTF-8 string in pack");     \
     }                                                          \
        *cur = '\0';                                            \
        Perl_croak(aTHX_ "Malformed UTF-8 string in pack");     \
     }                                                          \
@@ -432,16 +425,15 @@ static const char *_action( const tempsym_t* symptr )
 }
 
 /* Returns the sizeof() struct described by pat */
 }
 
 /* Returns the sizeof() struct described by pat */
-STATIC I32
+STATIC SSize_t
 S_measure_struct(pTHX_ tempsym_t* symptr)
 {
 S_measure_struct(pTHX_ tempsym_t* symptr)
 {
-    I32 total = 0;
+    SSize_t total = 0;
 
     PERL_ARGS_ASSERT_MEASURE_STRUCT;
 
     while (next_symbol(symptr)) {
 
     PERL_ARGS_ASSERT_MEASURE_STRUCT;
 
     while (next_symbol(symptr)) {
-       I32 len;
-       int size;
+       SSize_t len, size;
 
         switch (symptr->howlen) {
          case e_star:
 
         switch (symptr->howlen) {
          case e_star:
@@ -456,7 +448,7 @@ S_measure_struct(pTHX_ tempsym_t* symptr)
 
        size = packprops[TYPE_NO_ENDIANNESS(symptr->code)] & PACK_SIZE_MASK;
        if (!size) {
 
        size = packprops[TYPE_NO_ENDIANNESS(symptr->code)] & PACK_SIZE_MASK;
        if (!size) {
-            int star;
+            SSize_t star;
            /* endianness doesn't influence the size of a type */
            switch(TYPE_NO_ENDIANNESS(symptr->code)) {
            default:
            /* endianness doesn't influence the size of a type */
            switch(TYPE_NO_ENDIANNESS(symptr->code)) {
            default:
@@ -575,16 +567,17 @@ S_group_end(pTHX_ const char *patptr, const char *patend, char ender)
  * Advances char pointer to 1st non-digit char and returns number
  */
 STATIC const char *
  * Advances char pointer to 1st non-digit char and returns number
  */
 STATIC const char *
-S_get_num(pTHX_ const char *patptr, I32 *lenptr )
+S_get_num(pTHX_ const char *patptr, SSize_t *lenptr )
 {
 {
-  I32 len = *patptr++ - '0';
+  SSize_t len = *patptr++ - '0';
 
   PERL_ARGS_ASSERT_GET_NUM;
 
   while (isDIGIT(*patptr)) {
 
   PERL_ARGS_ASSERT_GET_NUM;
 
   while (isDIGIT(*patptr)) {
-    if (len >= 0x7FFFFFFF/10)
+    SSize_t nlen = (len * 10) + (*patptr++ - '0');
+    if (nlen < 0 || nlen/10 != len)
       Perl_croak(aTHX_ "pack/unpack repeat count overflow");
       Perl_croak(aTHX_ "pack/unpack repeat count overflow");
-    len = (len * 10) + (*patptr++ - '0');
+    len = nlen;
   }
   *lenptr = len;
   return patptr;
   }
   *lenptr = len;
   return patptr;
@@ -814,25 +807,25 @@ first_symbol(const char *pat, const char *patend) {
 
 =for apidoc unpackstring
 
 
 =for apidoc unpackstring
 
-The engine implementing the unpack() Perl function.
+The engine implementing the C<unpack()> Perl function.
 
 
-Using the template pat..patend, this function unpacks the string
-s..strend into a number of mortal SVs, which it pushes onto the perl
-argument (@_) stack (so you will need to issue a C<PUTBACK> before and
+Using the template C<pat..patend>, this function unpacks the string
+C<s..strend> into a number of mortal SVs, which it pushes onto the perl
+argument (C<@_>) stack (so you will need to issue a C<PUTBACK> before and
 C<SPAGAIN> after the call to this function).  It returns the number of
 pushed elements.
 
 C<SPAGAIN> after the call to this function).  It returns the number of
 pushed elements.
 
-The strend and patend pointers should point to the byte following the last
-character of each string.
+The C<strend> and C<patend> pointers should point to the byte following the
+last character of each string.
 
 Although this function returns its values on the perl argument stack, it
 doesn't take any parameters from that stack (and thus in particular
 
 Although this function returns its values on the perl argument stack, it
 doesn't take any parameters from that stack (and thus in particular
-there's no need to do a PUSHMARK before calling it, unlike L</call_pv> for
+there's no need to do a C<PUSHMARK> before calling it, unlike L</call_pv> for
 example).
 
 =cut */
 
 example).
 
 =cut */
 
-I32
+SSize_t
 Perl_unpackstring(pTHX_ const char *pat, const char *patend, const char *s, const char *strend, U32 flags)
 {
     tempsym_t sym;
 Perl_unpackstring(pTHX_ const char *pat, const char *patend, const char *s, const char *strend, U32 flags)
 {
     tempsym_t sym;
@@ -858,17 +851,17 @@ Perl_unpackstring(pTHX_ const char *pat, const char *patend, const char *s, cons
     return unpack_rec(&sym, s, s, strend, NULL );
 }
 
     return unpack_rec(&sym, s, s, strend, NULL );
 }
 
-STATIC I32
+STATIC SSize_t
 S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const char *strend, const char **new_s )
 {
     dSP;
     SV *sv = NULL;
 S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const char *strend, const char **new_s )
 {
     dSP;
     SV *sv = NULL;
-    const I32 start_sp_offset = SP - PL_stack_base;
+    const SSize_t start_sp_offset = SP - PL_stack_base;
     howlen_t howlen;
     howlen_t howlen;
-    I32 checksum = 0;
+    SSize_t checksum = 0;
     UV cuv = 0;
     NV cdouble = 0.0;
     UV cuv = 0;
     NV cdouble = 0.0;
-    const int bits_in_uv = CHAR_BIT * sizeof(cuv);
+    const SSize_t bits_in_uv = CHAR_BIT * sizeof(cuv);
     bool beyond = FALSE;
     bool explicit_length;
     const bool unpack_only_one = (symptr->flags & FLAG_UNPACK_ONLY_ONE) != 0;
     bool beyond = FALSE;
     bool explicit_length;
     const bool unpack_only_one = (symptr->flags & FLAG_UNPACK_ONLY_ONE) != 0;
@@ -880,7 +873,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 
     while (next_symbol(symptr)) {
        packprops_t props;
 
     while (next_symbol(symptr)) {
        packprops_t props;
-       I32 len;
+       SSize_t len;
         I32 datumtype = symptr->code;
         bool needs_swap;
        /* do first one only unless in list context
         I32 datumtype = symptr->code;
         bool needs_swap;
        /* do first one only unless in list context
@@ -908,8 +901,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
        props = packprops[TYPE_NO_ENDIANNESS(datumtype)];
        if (props) {
            /* props nonzero means we can process this letter. */
        props = packprops[TYPE_NO_ENDIANNESS(datumtype)];
        if (props) {
            /* props nonzero means we can process this letter. */
-            const long size = props & PACK_SIZE_MASK;
-            const long howmany = (strend - s) / size;
+            const SSize_t size = props & PACK_SIZE_MASK;
+            const SSize_t howmany = (strend - s) / size;
            if (len > howmany)
                len = howmany;
 
            if (len > howmany)
                len = howmany;
 
@@ -1000,7 +993,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                len = 1;
            if (utf8) {
                const char *hop, *last;
                len = 1;
            if (utf8) {
                const char *hop, *last;
-               I32 l = len;
+               SSize_t l = len;
                hop = last = strbeg;
                while (hop < s) {
                    hop += UTF8SKIP(hop);
                hop = last = strbeg;
                while (hop < s) {
                    hop += UTF8SKIP(hop);
@@ -1034,7 +1027,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
            }
            break;
        case 'x' | TYPE_IS_SHRIEKING: {
            }
            break;
        case 'x' | TYPE_IS_SHRIEKING: {
-            I32 ai32;
+            SSize_t ai32;
            if (!len)                   /* Avoid division by 0 */
                len = 1;
            if (utf8) ai32 = utf8_length((U8 *) strbeg, (U8 *) s) % len;
            if (!len)                   /* Avoid division by 0 */
                len = 1;
            if (utf8) ai32 = utf8_length((U8 *) strbeg, (U8 *) s) % len;
@@ -1069,7 +1062,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                goto W_checksum;
            }
            if (utf8) {
                goto W_checksum;
            }
            if (utf8) {
-               I32 l;
+               SSize_t l;
                const char *hop;
                for (l=len, hop=s; l>0; l--, hop += UTF8SKIP(hop)) {
                    if (hop >= strend) {
                const char *hop;
                for (l=len, hop=s; l>0; l--, hop += UTF8SKIP(hop)) {
                    if (hop >= strend) {
@@ -1096,9 +1089,14 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                /* 'A' strips both nulls and spaces */
                const char *ptr;
                if (utf8 && (symptr->flags & FLAG_WAS_UTF8)) {
                /* 'A' strips both nulls and spaces */
                const char *ptr;
                if (utf8 && (symptr->flags & FLAG_WAS_UTF8)) {
-                   for (ptr = s+len-1; ptr >= s; ptr--)
-                       if (*ptr != 0 && !UTF8_IS_CONTINUATION(*ptr) &&
-                           !isSPACE_utf8(ptr)) break;
+                    for (ptr = s+len-1; ptr >= s; ptr--) {
+                        if (   *ptr != 0
+                            && !UTF8_IS_CONTINUATION(*ptr)
+                            && !isSPACE_utf8_safe(ptr, strend))
+                        {
+                            break;
+                        }
+                    }
                    if (ptr >= s) ptr += UTF8SKIP(ptr);
                    else ptr++;
                    if (ptr > s+len)
                    if (ptr >= s) ptr += UTF8SKIP(ptr);
                    else ptr++;
                    if (ptr > s+len)
@@ -1128,7 +1126,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
            if (checksum) {
                if (utf8)
                    while (len >= 8 && s < strend) {
            if (checksum) {
                if (utf8)
                    while (len >= 8 && s < strend) {
-                       cuv += PL_bitcount[uni_to_byte(aTHX_ &s, strend, datumtype)];
+                       cuv += PL_bitcount[utf8_to_byte(aTHX_ &s, strend, datumtype)];
                        len -= 8;
                    }
                else
                        len -= 8;
                    }
                else
@@ -1158,23 +1156,23 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
            str = SvPVX(sv);
            if (datumtype == 'b') {
                U8 bits = 0;
            str = SvPVX(sv);
            if (datumtype == 'b') {
                U8 bits = 0;
-               const I32 ai32 = len;
+               const SSize_t ai32 = len;
                for (len = 0; len < ai32; len++) {
                    if (len & 7) bits >>= 1;
                    else if (utf8) {
                        if (s >= strend) break;
                for (len = 0; len < ai32; len++) {
                    if (len & 7) bits >>= 1;
                    else if (utf8) {
                        if (s >= strend) break;
-                       bits = uni_to_byte(aTHX_ &s, strend, datumtype);
+                       bits = utf8_to_byte(aTHX_ &s, strend, datumtype);
                    } else bits = *(U8 *) s++;
                    *str++ = bits & 1 ? '1' : '0';
                }
            } else {
                U8 bits = 0;
                    } else bits = *(U8 *) s++;
                    *str++ = bits & 1 ? '1' : '0';
                }
            } else {
                U8 bits = 0;
-               const I32 ai32 = len;
+               const SSize_t ai32 = len;
                for (len = 0; len < ai32; len++) {
                    if (len & 7) bits <<= 1;
                    else if (utf8) {
                        if (s >= strend) break;
                for (len = 0; len < ai32; len++) {
                    if (len & 7) bits <<= 1;
                    else if (utf8) {
                        if (s >= strend) break;
-                       bits = uni_to_byte(aTHX_ &s, strend, datumtype);
+                       bits = utf8_to_byte(aTHX_ &s, strend, datumtype);
                    } else bits = *(U8 *) s++;
                    *str++ = bits & 0x80 ? '1' : '0';
                }
                    } else bits = *(U8 *) s++;
                    *str++ = bits & 0x80 ? '1' : '0';
                }
@@ -1197,24 +1195,24 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
            }
            if (datumtype == 'h') {
                U8 bits = 0;
            }
            if (datumtype == 'h') {
                U8 bits = 0;
-               I32 ai32 = len;
+               SSize_t ai32 = len;
                for (len = 0; len < ai32; len++) {
                    if (len & 1) bits >>= 4;
                    else if (utf8) {
                        if (s >= strend) break;
                for (len = 0; len < ai32; len++) {
                    if (len & 1) bits >>= 4;
                    else if (utf8) {
                        if (s >= strend) break;
-                       bits = uni_to_byte(aTHX_ &s, strend, datumtype);
+                       bits = utf8_to_byte(aTHX_ &s, strend, datumtype);
                    } else bits = * (U8 *) s++;
                    if (!checksum)
                        *str++ = PL_hexdigit[bits & 15];
                }
            } else {
                U8 bits = 0;
                    } else bits = * (U8 *) s++;
                    if (!checksum)
                        *str++ = PL_hexdigit[bits & 15];
                }
            } else {
                U8 bits = 0;
-               const I32 ai32 = len;
+               const SSize_t ai32 = len;
                for (len = 0; len < ai32; len++) {
                    if (len & 1) bits <<= 4;
                    else if (utf8) {
                        if (s >= strend) break;
                for (len = 0; len < ai32; len++) {
                    if (len & 1) bits <<= 4;
                    else if (utf8) {
                        if (s >= strend) break;
-                       bits = uni_to_byte(aTHX_ &s, strend, datumtype);
+                       bits = utf8_to_byte(aTHX_ &s, strend, datumtype);
                    } else bits = *(U8 *) s++;
                    if (!checksum)
                        *str++ = PL_hexdigit[(bits >> 4) & 15];
                    } else bits = *(U8 *) s++;
                    if (!checksum)
                        *str++ = PL_hexdigit[(bits >> 4) & 15];
@@ -1243,7 +1241,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                    STRLEN retlen;
                    aint = utf8n_to_uvchr((U8 *) s, strend-s, &retlen,
                                 ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
                    STRLEN retlen;
                    aint = utf8n_to_uvchr((U8 *) s, strend-s, &retlen,
                                 ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
-                   if (retlen == (STRLEN) -1 || retlen == 0)
+                   if (retlen == (STRLEN) -1)
                        Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
                    s += retlen;
                  }
                        Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
                    s += retlen;
                  }
@@ -1266,7 +1264,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                    STRLEN retlen;
                    const UV val = utf8n_to_uvchr((U8 *) s, strend-s, &retlen,
                                         ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
                    STRLEN retlen;
                    const UV val = utf8n_to_uvchr((U8 *) s, strend-s, &retlen,
                                         ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY);
-                   if (retlen == (STRLEN) -1 || retlen == 0)
+                   if (retlen == (STRLEN) -1)
                        Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
                    s += retlen;
                    if (!checksum)
                        Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
                    s += retlen;
                    if (!checksum)
@@ -1307,16 +1305,16 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                STRLEN retlen;
                UV auv;
                if (utf8) {
                STRLEN retlen;
                UV auv;
                if (utf8) {
-                   U8 result[UTF8_MAXLEN];
+                   U8 result[UTF8_MAXLEN+1];
                    const char *ptr = s;
                    STRLEN len;
                    /* Bug: warns about bad utf8 even if we are short on bytes
                       and will break out of the loop */
                    const char *ptr = s;
                    STRLEN len;
                    /* Bug: warns about bad utf8 even if we are short on bytes
                       and will break out of the loop */
-                   if (!uni_to_bytes(aTHX_ &ptr, strend, (char *) result, 1,
+                   if (!S_utf8_to_bytes(aTHX_ &ptr, strend, (char *) result, 1,
                                      'U'))
                        break;
                    len = UTF8SKIP(result);
                                      'U'))
                        break;
                    len = UTF8SKIP(result);
-                   if (!uni_to_bytes(aTHX_ &ptr, strend,
+                   if (!S_utf8_to_bytes(aTHX_ &ptr, strend,
                                      (char *) &result[1], len-1, 'U')) break;
                    auv = NATIVE_TO_UNI(utf8n_to_uvchr(result,
                                                        len,
                                      (char *) &result[1], len-1, 'U')) break;
                    auv = NATIVE_TO_UNI(utf8n_to_uvchr(result,
                                                        len,
@@ -1328,7 +1326,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                                                        strend - s,
                                                        &retlen,
                                                        UTF8_ALLOW_DEFAULT));
                                                        strend - s,
                                                        &retlen,
                                                        UTF8_ALLOW_DEFAULT));
-                   if (retlen == (STRLEN) -1 || retlen == 0)
+                   if (retlen == (STRLEN) -1)
                        Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
                    s += retlen;
                }
                        Perl_croak(aTHX_ "Malformed UTF-8 string in unpack");
                    s += retlen;
                }
@@ -1380,8 +1378,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
 #if SHORTSIZE != SIZE16
            while (len-- > 0) {
                unsigned short aushort;
 #if SHORTSIZE != SIZE16
            while (len-- > 0) {
                unsigned short aushort;
-                SHIFT_VAR(utf8, s, strend, aushort, datumtype, needs_swap,
-                          needs_swap);
+               SHIFT_VAR(utf8, s, strend, aushort, datumtype, needs_swap);
                if (!checksum)
                    mPUSHu(aushort);
                else if (checksum > bits_in_uv)
                if (!checksum)
                    mPUSHu(aushort);
                else if (checksum > bits_in_uv)
@@ -1590,13 +1587,14 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
        case 'w':
            {
                UV auv = 0;
        case 'w':
            {
                UV auv = 0;
-               U32 bytes = 0;
+               size_t bytes = 0;
 
                while (len > 0 && s < strend) {
                    U8 ch;
                    ch = SHIFT_BYTE(utf8, s, strend, datumtype);
                    auv = (auv << 7) | (ch & 0x7f);
 
                while (len > 0 && s < strend) {
                    U8 ch;
                    ch = SHIFT_BYTE(utf8, s, strend, datumtype);
                    auv = (auv << 7) | (ch & 0x7f);
-                   /* UTF8_IS_XXXXX not right here - using constant 0x80 */
+                    /* UTF8_IS_XXXXX not right here because this is a BER, not
+                     * UTF-8 format - using constant 0x80 */
                    if (ch < 0x80) {
                        bytes = 0;
                        mPUSHu(auv);
                    if (ch < 0x80) {
                        bytes = 0;
                        mPUSHu(auv);
@@ -1607,7 +1605,8 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                    if (++bytes >= sizeof(UV)) {        /* promote to string */
                        const char *t;
 
                    if (++bytes >= sizeof(UV)) {        /* promote to string */
                        const char *t;
 
-                       sv = Perl_newSVpvf(aTHX_ "%.*"UVuf, (int)TYPE_DIGITS(UV), auv);
+                       sv = Perl_newSVpvf(aTHX_ "%.*" UVuf,
+                                                 (int)TYPE_DIGITS(UV), auv);
                        while (s < strend) {
                            ch = SHIFT_BYTE(utf8, s, strend, datumtype);
                            sv = mul128(sv, (U8)(ch & 0x7f));
                        while (s < strend) {
                            ch = SHIFT_BYTE(utf8, s, strend, datumtype);
                            sv = mul128(sv, (U8)(ch & 0x7f));
@@ -1727,74 +1726,53 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
            if (!checksum) {
                 const STRLEN l = (STRLEN) (strend - s) * 3 / 4;
                sv = sv_2mortal(newSV(l));
            if (!checksum) {
                 const STRLEN l = (STRLEN) (strend - s) * 3 / 4;
                sv = sv_2mortal(newSV(l));
-               if (l) SvPOK_on(sv);
-           }
-           if (utf8) {
-               while (next_uni_uu(aTHX_ &s, strend, &len)) {
-                   I32 a, b, c, d;
-                   char hunk[3];
-
-                   while (len > 0) {
-                       next_uni_uu(aTHX_ &s, strend, &a);
-                       next_uni_uu(aTHX_ &s, strend, &b);
-                       next_uni_uu(aTHX_ &s, strend, &c);
-                       next_uni_uu(aTHX_ &s, strend, &d);
-                       hunk[0] = (char)((a << 2) | (b >> 4));
-                       hunk[1] = (char)((b << 4) | (c >> 2));
-                       hunk[2] = (char)((c << 6) | d);
-                       if (!checksum)
-                           sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
-                       len -= 3;
-                   }
-                   if (s < strend) {
-                       if (*s == '\n') {
-                            s++;
-                        }
-                       else {
-                           /* possible checksum byte */
-                           const char *skip = s+UTF8SKIP(s);
-                           if (skip < strend && *skip == '\n')
-                                s = skip+1;
-                       }
-                   }
-               }
-           } else {
-               while (s < strend && *s > ' ' && ISUUCHAR(*s)) {
-                   I32 a, b, c, d;
-                   char hunk[3];
-
-                   len = PL_uudmap[*(U8*)s++] & 077;
-                   while (len > 0) {
-                       if (s < strend && ISUUCHAR(*s))
-                           a = PL_uudmap[*(U8*)s++] & 077;
-                       else
-                           a = 0;
-                       if (s < strend && ISUUCHAR(*s))
-                           b = PL_uudmap[*(U8*)s++] & 077;
-                       else
-                           b = 0;
-                       if (s < strend && ISUUCHAR(*s))
-                           c = PL_uudmap[*(U8*)s++] & 077;
-                       else
-                           c = 0;
-                       if (s < strend && ISUUCHAR(*s))
-                           d = PL_uudmap[*(U8*)s++] & 077;
-                       else
-                           d = 0;
-                       hunk[0] = (char)((a << 2) | (b >> 4));
-                       hunk[1] = (char)((b << 4) | (c >> 2));
-                       hunk[2] = (char)((c << 6) | d);
-                       if (!checksum)
-                           sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
-                       len -= 3;
-                   }
-                   if (*s == '\n')
-                       s++;
-                   else        /* possible checksum byte */
-                       if (s + 1 < strend && s[1] == '\n')
-                           s += 2;
-               }
-           }
+               if (l) {
+                    SvPOK_on(sv);
+                    *SvEND(sv) = '\0';
+                }
+           }
+
+            /* Note that all legal uuencoded strings are ASCII printables, so
+             * have the same representation under UTF-8 vs not.  This means we
+             * can ignore UTF8ness on legal input.  For illegal we stop at the
+             * first failure, and don't report where/what that is, so again we
+             * can ignore UTF8ness */
+
+            while (s < strend && *s != ' ' && ISUUCHAR(*s)) {
+                I32 a, b, c, d;
+                char hunk[3];
+
+                len = PL_uudmap[*(U8*)s++] & 077;
+                while (len > 0) {
+                    if (s < strend && ISUUCHAR(*s))
+                        a = PL_uudmap[*(U8*)s++] & 077;
+                    else
+                        a = 0;
+                    if (s < strend && ISUUCHAR(*s))
+                        b = PL_uudmap[*(U8*)s++] & 077;
+                    else
+                        b = 0;
+                    if (s < strend && ISUUCHAR(*s))
+                        c = PL_uudmap[*(U8*)s++] & 077;
+                    else
+                        c = 0;
+                    if (s < strend && ISUUCHAR(*s))
+                        d = PL_uudmap[*(U8*)s++] & 077;
+                    else
+                        d = 0;
+                    hunk[0] = (char)((a << 2) | (b >> 4));
+                    hunk[1] = (char)((b << 4) | (c >> 2));
+                    hunk[2] = (char)((c << 6) | d);
+                    if (!checksum)
+                        sv_catpvn(sv, hunk, (len > 3) ? 3 : len);
+                    len -= 3;
+                }
+                if (*s == '\n')
+                    s++;
+                else   /* possible checksum byte */
+                    if (s + 1 < strend && s[1] == '\n')
+                        s += 2;
+            }
            if (!checksum)
                XPUSHs(sv);
            break;
            if (!checksum)
                XPUSHs(sv);
            break;
@@ -1813,7 +1791,18 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
                }
                while (cdouble < 0.0)
                    cdouble += anv;
                }
                while (cdouble < 0.0)
                    cdouble += anv;
-               cdouble = Perl_modf(cdouble / anv, &trouble) * anv;
+               cdouble = Perl_modf(cdouble / anv, &trouble);
+#ifdef LONGDOUBLE_DOUBLEDOUBLE
+                /* Workaround for powerpc doubledouble modfl bug:
+                 * close to 1.0L and -1.0L cdouble is 0, and trouble
+                 * is cdouble / anv. */
+                if (trouble != Perl_ceil(trouble)) {
+                  cdouble = trouble;
+                  if (cdouble >  1.0L) cdouble -= 1.0L;
+                  if (cdouble < -1.0L) cdouble += 1.0L;
+                }
+#endif
+                cdouble *= anv;
                sv = newSVnv(cdouble);
            }
            else {
                sv = newSVnv(cdouble);
            }
            else {
@@ -1861,14 +1850,14 @@ PP(pp_unpack)
 {
     dSP;
     dPOPPOPssrl;
 {
     dSP;
     dPOPPOPssrl;
-    I32 gimme = GIMME_V;
+    U8 gimme = GIMME_V;
     STRLEN llen;
     STRLEN rlen;
     const char *pat = SvPV_const(left,  llen);
     const char *s   = SvPV_const(right, rlen);
     const char *strend = s + rlen;
     const char *patend = pat + llen;
     STRLEN llen;
     STRLEN rlen;
     const char *pat = SvPV_const(left,  llen);
     const char *s   = SvPV_const(right, rlen);
     const char *strend = s + rlen;
     const char *patend = pat + llen;
-    I32 cnt;
+    SSize_t cnt;
 
     PUTBACK;
     cnt = unpackstring(pat, patend, s, strend,
 
     PUTBACK;
     cnt = unpackstring(pat, patend, s, strend,
@@ -1882,7 +1871,7 @@ PP(pp_unpack)
 }
 
 STATIC U8 *
 }
 
 STATIC U8 *
-doencodes(U8 *h, const char *s, I32 len)
+doencodes(U8 *h, const U8 *s, SSize_t len)
 {
     *h++ = PL_uuemap[len];
     while (len > 2) {
 {
     *h++ = PL_uuemap[len];
     while (len > 2) {
@@ -1894,7 +1883,7 @@ doencodes(U8 *h, const char *s, I32 len)
        len -= 3;
     }
     if (len > 0) {
        len -= 3;
     }
     if (len > 0) {
-        const char r = (len > 1 ? s[1] : '\0');
+        const U8 r = (len > 1 ? s[1] : '\0');
        *h++ = PL_uuemap[(077 & (s[0] >> 2))];
        *h++ = PL_uuemap[(077 & (((s[0] << 4) & 060) | ((r >> 4) & 017)))];
        *h++ = PL_uuemap[(077 & ((r << 2) & 074))];
        *h++ = PL_uuemap[(077 & (s[0] >> 2))];
        *h++ = PL_uuemap[(077 & (((s[0] << 4) & 060) | ((r >> 4) & 017)))];
        *h++ = PL_uuemap[(077 & ((r << 2) & 074))];
@@ -1983,7 +1972,7 @@ S_div128(pTHX_ SV *pnum, bool *done)
 /*
 =for apidoc packlist
 
 /*
 =for apidoc packlist
 
-The engine implementing pack() Perl function.
+The engine implementing C<pack()> Perl function.
 
 =cut
 */
 
 =cut
 */
@@ -2098,9 +2087,9 @@ S_sv_check_infnan(pTHX_ SV *sv, I32 datumtype)
        const I32 c = TYPE_NO_MODIFIERS(datumtype);
        const NV nv = SvNV_nomg(sv);
        if (c == 'w')
        const I32 c = TYPE_NO_MODIFIERS(datumtype);
        const NV nv = SvNV_nomg(sv);
        if (c == 'w')
-           Perl_croak(aTHX_ "Cannot compress %"NVgf" in pack", nv);
+           Perl_croak(aTHX_ "Cannot compress %" NVgf " in pack", nv);
        else
        else
-           Perl_croak(aTHX_ "Cannot pack %"NVgf" with '%c'", nv, (int) c);
+           Perl_croak(aTHX_ "Cannot pack %" NVgf " with '%c'", nv, (int) c);
     }
     return sv;
 }
     }
     return sv;
 }
@@ -2115,7 +2104,7 @@ SV **
 S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 {
     tempsym_t lookahead;
 S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 {
     tempsym_t lookahead;
-    I32 items  = endlist - beglist;
+    SSize_t items  = endlist - beglist;
     bool found = next_symbol(symptr);
     bool utf8 = (symptr->flags & FLAG_PARSE_UTF8) ? 1 : 0;
     bool warn_utf8 = ckWARN(WARN_UTF8);
     bool found = next_symbol(symptr);
     bool utf8 = (symptr->flags & FLAG_PARSE_UTF8) ? 1 : 0;
     bool warn_utf8 = ckWARN(WARN_UTF8);
@@ -2133,7 +2122,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
     while (found) {
        SV *fromstr;
        STRLEN fromlen;
     while (found) {
        SV *fromstr;
        STRLEN fromlen;
-       I32 len;
+       SSize_t len;
        SV *lengthcode = NULL;
         I32 datumtype = symptr->code;
         howlen_t howlen = symptr->howlen;
        SV *lengthcode = NULL;
         I32 datumtype = symptr->code;
         howlen_t howlen = symptr->howlen;
@@ -2141,7 +2130,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
        char *cur   = start + SvCUR(cat);
         bool needs_swap;
 
        char *cur   = start + SvCUR(cat);
         bool needs_swap;
 
-#define NEXTFROM (lengthcode ? lengthcode : items-- > 0 ? *beglist++ : &PL_sv_no)
+#define NEXTFROM (lengthcode ? lengthcode : items > 0 ? (--items, *beglist++) : &PL_sv_no)
 #define PEEKFROM (lengthcode ? lengthcode : items > 0 ? *beglist : &PL_sv_no)
 
         switch (howlen) {
 #define PEEKFROM (lengthcode ? lengthcode : items > 0 ? *beglist : &PL_sv_no)
 
         switch (howlen) {
@@ -2161,7 +2150,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            if (props && !(props & PACK_SIZE_UNPREDICTABLE)) {
                /* We can process this letter. */
                STRLEN size = props & PACK_SIZE_MASK;
            if (props && !(props & PACK_SIZE_UNPREDICTABLE)) {
                /* We can process this letter. */
                STRLEN size = props & PACK_SIZE_MASK;
-               GROWING(utf8, cat, start, cur, (STRLEN) len * size);
+               GROWING2(utf8, cat, start, cur, size, (STRLEN)len);
            }
         }
 
            }
         }
 
@@ -2281,7 +2270,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                len = 1;
            if (utf8) {
                char *hop, *last;
                len = 1;
            if (utf8) {
                char *hop, *last;
-               I32 l = len;
+               SSize_t l = len;
                hop = last = start;
                while (hop < cur) {
                    hop += UTF8SKIP(hop);
                hop = last = start;
                while (hop < cur) {
                    hop += UTF8SKIP(hop);
@@ -2330,7 +2319,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            }
            break;
        case 'x' | TYPE_IS_SHRIEKING: {
            }
            break;
        case 'x' | TYPE_IS_SHRIEKING: {
-           I32 ai32;
+           SSize_t ai32;
            if (!len)                   /* Avoid division by 0 */
                len = 1;
            if (utf8) ai32 = utf8_length((U8 *) start, (U8 *) cur) % len;
            if (!len)                   /* Avoid division by 0 */
                len = 1;
            if (utf8) ai32 = utf8_length((U8 *) start, (U8 *) cur) % len;
@@ -2366,7 +2355,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                s = aptr;
                end = aptr + fromlen;
                fromlen = datumtype == 'Z' ? len-1 : len;
                s = aptr;
                end = aptr + fromlen;
                fromlen = datumtype == 'Z' ? len-1 : len;
-               while ((I32) fromlen > 0 && s < end) {
+               while ((SSize_t) fromlen > 0 && s < end) {
                    s += UTF8SKIP(s);
                    fromlen--;
                }
                    s += UTF8SKIP(s);
                    fromlen--;
                }
@@ -2387,11 +2376,11 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    if (datumtype == 'Z') len++;
                }
                GROWING(0, cat, start, cur, len);
                    if (datumtype == 'Z') len++;
                }
                GROWING(0, cat, start, cur, len);
-               if (!uni_to_bytes(aTHX_ &aptr, end, cur, fromlen,
+               if (!S_utf8_to_bytes(aTHX_ &aptr, end, cur, fromlen,
                                  datumtype | TYPE_IS_PACK))
                    Perl_croak(aTHX_ "panic: predicted utf8 length not available, "
                                  datumtype | TYPE_IS_PACK))
                    Perl_croak(aTHX_ "panic: predicted utf8 length not available, "
-                              "for '%c', aptr=%p end=%p cur=%p, fromlen=%"UVuf,
-                              (int)datumtype, aptr, end, cur, (UV)fromlen);
+                              "for '%c', aptr=%p end=%p cur=%p, fromlen=%zu",
+                              (int)datumtype, aptr, end, cur, fromlen);
                cur += fromlen;
                len -= fromlen;
            } else if (utf8) {
                cur += fromlen;
                len -= fromlen;
            } else if (utf8) {
@@ -2399,7 +2388,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    len = fromlen;
                    if (datumtype == 'Z') len++;
                }
                    len = fromlen;
                    if (datumtype == 'Z') len++;
                }
-               if (len <= (I32) fromlen) {
+               if (len <= (SSize_t) fromlen) {
                    fromlen = len;
                    if (datumtype == 'Z' && fromlen > 0) fromlen--;
                }
                    fromlen = len;
                    if (datumtype == 'Z' && fromlen > 0) fromlen--;
                }
@@ -2419,7 +2408,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    len = fromlen;
                    if (datumtype == 'Z') len++;
                }
                    len = fromlen;
                    if (datumtype == 'Z') len++;
                }
-               if (len <= (I32) fromlen) {
+               if (len <= (SSize_t) fromlen) {
                    fromlen = len;
                    if (datumtype == 'Z' && fromlen > 0) fromlen--;
                }
                    fromlen = len;
                    if (datumtype == 'Z' && fromlen > 0) fromlen--;
                }
@@ -2436,7 +2425,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
        case 'B':
        case 'b': {
            const char *str, *end;
        case 'B':
        case 'b': {
            const char *str, *end;
-           I32 l, field_len;
+           SSize_t l, field_len;
            U8 bits;
            bool utf8_source;
            U32 utf8_flags;
            U8 bits;
            bool utf8_source;
            U32 utf8_flags;
@@ -2454,7 +2443,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            if (howlen == e_star) len = fromlen;
            field_len = (len+7)/8;
            GROWING(utf8, cat, start, cur, field_len);
            if (howlen == e_star) len = fromlen;
            field_len = (len+7)/8;
            GROWING(utf8, cat, start, cur, field_len);
-           if (len > (I32)fromlen) len = fromlen;
+           if (len > (SSize_t)fromlen) len = fromlen;
            bits = 0;
            l = 0;
            if (datumtype == 'B')
            bits = 0;
            l = 0;
            if (datumtype == 'B')
@@ -2505,7 +2494,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
        case 'H':
        case 'h': {
            const char *str, *end;
        case 'H':
        case 'h': {
            const char *str, *end;
-           I32 l, field_len;
+           SSize_t l, field_len;
            U8 bits;
            bool utf8_source;
            U32 utf8_flags;
            U8 bits;
            bool utf8_source;
            U32 utf8_flags;
@@ -2523,7 +2512,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            if (howlen == e_star) len = fromlen;
            field_len = (len+1)/2;
            GROWING(utf8, cat, start, cur, field_len);
            if (howlen == e_star) len = fromlen;
            field_len = (len+1)/2;
            GROWING(utf8, cat, start, cur, field_len);
-           if (!utf8 && len > (I32)fromlen) len = fromlen;
+           if (!utf8_source && len > (SSize_t)fromlen) len = fromlen;
            bits = 0;
            l = 0;
            if (datumtype == 'H')
            bits = 0;
            l = 0;
            if (datumtype == 'H')
@@ -2616,17 +2605,14 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                if (in_bytes) auv = auv % 0x100;
                if (utf8) {
                  W_utf8:
                if (in_bytes) auv = auv % 0x100;
                if (utf8) {
                  W_utf8:
-                   if (cur > end) {
+                   if (cur >= end) {
                        *cur = '\0';
                        SvCUR_set(cat, cur - start);
 
                        GROWING(0, cat, start, cur, len+UTF8_MAXLEN);
                        end = start+SvLEN(cat)-UTF8_MAXLEN;
                    }
                        *cur = '\0';
                        SvCUR_set(cat, cur - start);
 
                        GROWING(0, cat, start, cur, len+UTF8_MAXLEN);
                        end = start+SvLEN(cat)-UTF8_MAXLEN;
                    }
-                   cur = (char *) uvchr_to_utf8_flags((U8 *) cur,
-                                                      auv,
-                                                      warn_utf8 ?
-                                                      0 : UNICODE_ALLOW_ANY);
+                   cur = (char *) uvchr_to_utf8_flags((U8 *) cur, auv, 0);
                } else {
                    if (auv >= 0x100) {
                        if (!SvUTF8(cat)) {
                } else {
                    if (auv >= 0x100) {
                        if (!SvUTF8(cat)) {
@@ -2676,10 +2662,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                fromstr = NEXTFROM;
                auv = SvUV_no_inf(fromstr, datumtype);
                if (utf8) {
                fromstr = NEXTFROM;
                auv = SvUV_no_inf(fromstr, datumtype);
                if (utf8) {
-                   U8 buffer[UTF8_MAXLEN], *endb;
-                   endb = uvchr_to_utf8_flags(buffer, UNI_TO_NATIVE(auv),
-                                              warn_utf8 ?
-                                              0 : UNICODE_ALLOW_ANY);
+                   U8 buffer[UTF8_MAXLEN+1], *endb;
+                   endb = uvchr_to_utf8_flags(buffer, UNI_TO_NATIVE(auv), 0);
                    if (cur+(endb-buffer)*UTF8_EXPAND >= end) {
                        *cur = '\0';
                        SvCUR_set(cat, cur - start);
                    if (cur+(endb-buffer)*UTF8_EXPAND >= end) {
                        *cur = '\0';
                        SvCUR_set(cat, cur - start);
@@ -2687,7 +2671,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                                len+(endb-buffer)*UTF8_EXPAND);
                        end = start+SvLEN(cat);
                    }
                                len+(endb-buffer)*UTF8_EXPAND);
                        end = start+SvLEN(cat);
                    }
-                    cur = S_bytes_to_uni(buffer, endb-buffer, cur, 0);
+                    cur = my_bytes_to_utf8(buffer, endb-buffer, cur, 0);
                } else {
                    if (cur >= end) {
                        *cur = '\0';
                } else {
                    if (cur >= end) {
                        *cur = '\0';
@@ -2695,9 +2679,9 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                        GROWING(0, cat, start, cur, len+UTF8_MAXLEN);
                        end = start+SvLEN(cat)-UTF8_MAXLEN;
                    }
                        GROWING(0, cat, start, cur, len+UTF8_MAXLEN);
                        end = start+SvLEN(cat)-UTF8_MAXLEN;
                    }
-                   cur = (char *) uvchr_to_utf8_flags((U8 *) cur, UNI_TO_NATIVE(auv),
-                                                      warn_utf8 ?
-                                                      0 : UNICODE_ALLOW_ANY);
+                   cur = (char *) uvchr_to_utf8_flags((U8 *) cur,
+                                                       UNI_TO_NATIVE(auv),
+                                                      0);
                }
            }
            break;
                }
            }
            break;
@@ -2709,7 +2693,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                NV anv;
                fromstr = NEXTFROM;
                anv = SvNV(fromstr);
                NV anv;
                fromstr = NEXTFROM;
                anv = SvNV(fromstr);
-# if defined(VMS) && !defined(_IEEE_FP)
+# if (defined(VMS) && !defined(_IEEE_FP)) || defined(DOUBLE_IS_VAX_FLOAT)
                /* IEEE fp overflow shenanigans are unavailable on VAX and optional
                 * on Alpha; fake it if we don't have them.
                 */
                /* IEEE fp overflow shenanigans are unavailable on VAX and optional
                 * on Alpha; fake it if we don't have them.
                 */
@@ -2719,10 +2703,17 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    afloat = -FLT_MAX;
                else afloat = (float)anv;
 # else
                    afloat = -FLT_MAX;
                else afloat = (float)anv;
 # else
+#  if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+               if(Perl_isnan(anv))
+                   afloat = (float)NV_NAN;
+               else
+#  endif
+#  ifdef NV_INF
                 /* a simple cast to float is undefined if outside
                  * the range of values that can be represented */
                afloat = (float)(anv >  FLT_MAX ?  NV_INF :
                                  anv < -FLT_MAX ? -NV_INF : anv);
                 /* a simple cast to float is undefined if outside
                  * the range of values that can be represented */
                afloat = (float)(anv >  FLT_MAX ?  NV_INF :
                                  anv < -FLT_MAX ? -NV_INF : anv);
+#  endif
 # endif
                 PUSH_VAR(utf8, cur, afloat, needs_swap);
            }
 # endif
                 PUSH_VAR(utf8, cur, afloat, needs_swap);
            }
@@ -2733,7 +2724,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                NV anv;
                fromstr = NEXTFROM;
                anv = SvNV(fromstr);
                NV anv;
                fromstr = NEXTFROM;
                anv = SvNV(fromstr);
-# if defined(VMS) && !defined(_IEEE_FP)
+# if (defined(VMS) && !defined(_IEEE_FP)) || defined(DOUBLE_IS_VAX_FLOAT)
                /* IEEE fp overflow shenanigans are unavailable on VAX and optional
                 * on Alpha; fake it if we don't have them.
                 */
                /* IEEE fp overflow shenanigans are unavailable on VAX and optional
                 * on Alpha; fake it if we don't have them.
                 */
@@ -2756,6 +2747,12 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 #ifdef __GNUC__
                /* to work round a gcc/x86 bug; don't use SvNV */
                anv.nv = sv_2nv(fromstr);
 #ifdef __GNUC__
                /* to work round a gcc/x86 bug; don't use SvNV */
                anv.nv = sv_2nv(fromstr);
+#    if defined(LONGDOUBLE_X86_80_BIT) && defined(USE_LONG_DOUBLE) \
+         && LONG_DOUBLESIZE > 10
+                /* GCC sometimes overwrites the padding in the
+                   assignment above */
+                Zero(anv.bytes+10, sizeof(anv.bytes) - 10, U8);
+#    endif
 #else
                anv.nv = SvNV(fromstr);
 #endif
 #else
                anv.nv = SvNV(fromstr);
 #endif
@@ -2773,6 +2770,11 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
 #  ifdef __GNUC__
                /* to work round a gcc/x86 bug; don't use SvNV */
                aldouble.ld = (long double)sv_2nv(fromstr);
 #  ifdef __GNUC__
                /* to work round a gcc/x86 bug; don't use SvNV */
                aldouble.ld = (long double)sv_2nv(fromstr);
+#    if defined(LONGDOUBLE_X86_80_BIT) && LONG_DOUBLESIZE > 10
+                /* GCC sometimes overwrites the padding in the
+                   assignment above */
+                Zero(aldouble.bytes+10, sizeof(aldouble.bytes) - 10, U8);
+#    endif
 #  else
                aldouble.ld = (long double)SvNV(fromstr);
 #  endif
 #  else
                aldouble.ld = (long double)SvNV(fromstr);
 #  endif
@@ -3059,7 +3061,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                     * of pack() (and all copies of the result) are
                     * gone.
                     */
                     * of pack() (and all copies of the result) are
                     * gone.
                     */
-                   if ((SvTEMP(fromstr) || (SvPADTMP(fromstr) &&
+                   if (((SvTEMP(fromstr) && SvREFCNT(fromstr) == 1)
+                        || (SvPADTMP(fromstr) &&
                             !SvREADONLY(fromstr)))) {
                        Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
                                       "Attempt to pack pointer to temporary value");
                             !SvREADONLY(fromstr)))) {
                        Perl_ck_warner(aTHX_ packWARN(WARN_PACK),
                                       "Attempt to pack pointer to temporary value");
@@ -3093,26 +3096,26 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            GROWING(utf8, cat, start, cur, (fromlen+2) / 3 * 4 + (fromlen+len-1)/len * 2);
            while (fromlen > 0) {
                U8 *end;
            GROWING(utf8, cat, start, cur, (fromlen+2) / 3 * 4 + (fromlen+len-1)/len * 2);
            while (fromlen > 0) {
                U8 *end;
-               I32 todo;
+               SSize_t todo;
                U8 hunk[1+63/3*4+1];
 
                U8 hunk[1+63/3*4+1];
 
-               if ((I32)fromlen > len)
+               if ((SSize_t)fromlen > len)
                    todo = len;
                else
                    todo = fromlen;
                if (from_utf8) {
                    char buffer[64];
                    todo = len;
                else
                    todo = fromlen;
                if (from_utf8) {
                    char buffer[64];
-                   if (!uni_to_bytes(aTHX_ &aptr, aend, buffer, todo,
+                   if (!S_utf8_to_bytes(aTHX_ &aptr, aend, buffer, todo,
                                      'u' | TYPE_IS_PACK)) {
                        *cur = '\0';
                        SvCUR_set(cat, cur - start);
                        Perl_croak(aTHX_ "panic: string is shorter than advertised, "
                                      'u' | TYPE_IS_PACK)) {
                        *cur = '\0';
                        SvCUR_set(cat, cur - start);
                        Perl_croak(aTHX_ "panic: string is shorter than advertised, "
-                                  "aptr=%p, aend=%p, buffer=%p, todo=%ld",
-                                  aptr, aend, buffer, (long) todo);
+                                  "aptr=%p, aend=%p, buffer=%p, todo=%zd",
+                                  aptr, aend, buffer, todo);
                    }
                    }
-                   end = doencodes(hunk, buffer, todo);
+                   end = doencodes(hunk, (const U8 *)buffer, todo);
                } else {
                } else {
-                   end = doencodes(hunk, aptr, todo);
+                   end = doencodes(hunk, (const U8 *)aptr, todo);
                    aptr += todo;
                }
                PUSH_BYTES(utf8, cur, hunk, end-hunk, 0);
                    aptr += todo;
                }
                PUSH_BYTES(utf8, cur, hunk, end-hunk, 0);
@@ -3141,11 +3144,26 @@ PP(pp_pack)
     const char *patend = pat + fromlen;
 
     MARK++;
     const char *patend = pat + fromlen;
 
     MARK++;
-    sv_setpvs(cat, "");
+    SvPVCLEAR(cat);
     SvUTF8_off(cat);
 
     packlist(cat, pat, patend, MARK, SP + 1);
 
     SvUTF8_off(cat);
 
     packlist(cat, pat, patend, MARK, SP + 1);
 
+    if (SvUTF8(cat)) {
+        STRLEN result_len;
+        const char * result = SvPV_nomg(cat, result_len);
+        const U8 * error_pos;
+
+        if (! is_utf8_string_loc((U8 *) result, result_len, &error_pos)) {
+            _force_out_malformed_utf8_message(error_pos,
+                                              (U8 *) result + result_len,
+                                              0, /* no flags */
+                                              1 /* Die */
+                                            );
+            NOT_REACHED; /* NOTREACHED */
+        }
+    }
+
     SvSETMAGIC(cat);
     SP = ORIGMARK;
     PUSHs(cat);
     SvSETMAGIC(cat);
     SP = ORIGMARK;
     PUSHs(cat);
@@ -3153,11 +3171,5 @@ PP(pp_pack)
 }
 
 /*
 }
 
 /*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
  * ex: set ts=8 sts=4 sw=4 et:
  */
  * ex: set ts=8 sts=4 sw=4 et:
  */
Unnamed repository; edit this file 'description' to name the repository.